GNU Octave  9.1.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
dSparse.cc
Go to the documentation of this file.
1 ////////////////////////////////////////////////////////////////////////
2 //
3 // Copyright (C) 1998-2024 The Octave Project Developers
4 //
5 // See the file COPYRIGHT.md in the top-level directory of this
6 // distribution or <https://octave.org/copyright/>.
7 //
8 // This file is part of Octave.
9 //
10 // Octave is free software: you can redistribute it and/or modify it
11 // under the terms of the GNU General Public License as published by
12 // the Free Software Foundation, either version 3 of the License, or
13 // (at your option) any later version.
14 //
15 // Octave is distributed in the hope that it will be useful, but
16 // WITHOUT ANY WARRANTY; without even the implied warranty of
17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 // GNU General Public License for more details.
19 //
20 // You should have received a copy of the GNU General Public License
21 // along with Octave; see the file COPYING. If not, see
22 // <https://www.gnu.org/licenses/>.
23 //
24 ////////////////////////////////////////////////////////////////////////
25 
26 #if defined (HAVE_CONFIG_H)
27 # include "config.h"
28 #endif
29 
30 #include <istream>
31 #include <ostream>
32 
33 #include "quit.h"
34 #include "lo-ieee.h"
35 #include "lo-lapack-proto.h"
36 #include "lo-mappers.h"
37 #include "dRowVector.h"
38 #include "oct-locbuf.h"
39 
40 #include "dDiagMatrix.h"
41 #include "CSparse.h"
42 #include "boolSparse.h"
43 #include "dSparse.h"
44 #include "oct-spparms.h"
45 #include "sparse-lu.h"
46 #include "MatrixType.h"
47 #include "oct-sparse.h"
48 #include "sparse-util.h"
49 #include "sparse-chol.h"
50 #include "sparse-qr.h"
51 
52 #include "Sparse-op-defs.h"
53 
54 #include "Sparse-diag-op-defs.h"
55 
56 #include "Sparse-perm-op-defs.h"
57 
58 // Define whether to use a basic QR solver or one that uses a Dulmange
59 // Mendelsohn factorization to separate the problem into under-determined,
60 // well-determined and over-determined parts and solves them separately
61 #if ! defined (USE_QRSOLVE)
62 # include "sparse-dmsolve.h"
63 #endif
64 
65 SparseMatrix::SparseMatrix (const SparseBoolMatrix& a)
66  : MSparse<double> (a.rows (), a.cols (), a.nnz ())
67 {
68  octave_idx_type nc = cols ();
69  octave_idx_type nz = a.nnz ();
70 
71  for (octave_idx_type i = 0; i < nc + 1; i++)
72  cidx (i) = a.cidx (i);
73 
74  for (octave_idx_type i = 0; i < nz; i++)
75  {
76  data (i) = a.data (i);
77  ridx (i) = a.ridx (i);
78  }
79 }
80 
81 SparseMatrix::SparseMatrix (const DiagMatrix& a)
82  : MSparse<double> (a.rows (), a.cols (), a.length ())
83 {
84  octave_idx_type j = 0;
85  octave_idx_type l = a.length ();
86  for (octave_idx_type i = 0; i < l; i++)
87  {
88  cidx (i) = j;
89  if (a(i, i) != 0.0)
90  {
91  data (j) = a(i, i);
92  ridx (j) = i;
93  j++;
94  }
95  }
96  for (octave_idx_type i = l; i <= a.cols (); i++)
97  cidx (i) = j;
98 }
99 
100 bool
101 SparseMatrix::operator == (const SparseMatrix& a) const
102 {
103  octave_idx_type nr = rows ();
104  octave_idx_type nc = cols ();
105  octave_idx_type nz = nnz ();
106  octave_idx_type nr_a = a.rows ();
107  octave_idx_type nc_a = a.cols ();
108  octave_idx_type nz_a = a.nnz ();
109 
110  if (nr != nr_a || nc != nc_a || nz != nz_a)
111  return false;
112 
113  for (octave_idx_type i = 0; i < nc + 1; i++)
114  if (cidx (i) != a.cidx (i))
115  return false;
116 
117  for (octave_idx_type i = 0; i < nz; i++)
118  if (data (i) != a.data (i) || ridx (i) != a.ridx (i))
119  return false;
120 
121  return true;
122 }
123 
124 bool
125 SparseMatrix::operator != (const SparseMatrix& a) const
126 {
127  return !(*this == a);
128 }
129 
130 bool
131 SparseMatrix::issymmetric () const
132 {
133  octave_idx_type nr = rows ();
134  octave_idx_type nc = cols ();
135 
136  if (nr == nc && nr > 0)
137  {
138  for (octave_idx_type j = 0; j < nc; j++)
139  {
140  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
141  {
142  octave_idx_type ri = ridx (i);
143 
144  if (ri != j)
145  {
146  bool found = false;
147 
148  for (octave_idx_type k = cidx (ri); k < cidx (ri+1); k++)
149  {
150  if (ridx (k) == j)
151  {
152  if (data (i) == data (k))
153  found = true;
154  break;
155  }
156  }
157 
158  if (! found)
159  return false;
160  }
161  }
162  }
163 
164  return true;
165  }
166 
167  return false;
168 }
169 
170 SparseMatrix&
171 SparseMatrix::insert (const SparseMatrix& a,
172  octave_idx_type r, octave_idx_type c)
173 {
174  MSparse<double>::insert (a, r, c);
175  return *this;
176 }
177 
178 SparseMatrix&
179 SparseMatrix::insert (const SparseMatrix& a, const Array<octave_idx_type>& indx)
180 {
181  MSparse<double>::insert (a, indx);
182  return *this;
183 }
184 
185 SparseMatrix
186 SparseMatrix::max (int dim) const
187 {
188  Array<octave_idx_type> dummy_idx;
189  return max (dummy_idx, dim);
190 }
191 
192 SparseMatrix
193 SparseMatrix::max (Array<octave_idx_type>& idx_arg, int dim) const
194 {
195  SparseMatrix result;
196  dim_vector dv = dims ();
197  octave_idx_type nr = dv(0);
198  octave_idx_type nc = dv(1);
199 
200  if (dim >= dv.ndims ())
201  {
202  idx_arg.resize (dim_vector (nr, nc), 0);
203  return *this;
204  }
205 
206  if (dim < 0)
207  dim = dv.first_non_singleton ();
208 
209  if (dim == 0)
210  {
211  idx_arg.resize (dim_vector (nr == 0 ? 0 : 1, nc), 0);
212 
213  if (nr == 0 || nc == 0 || dim >= dv.ndims ())
214  return SparseMatrix (nr == 0 ? 0 : 1, nc);
215 
216  octave_idx_type nel = 0;
217  for (octave_idx_type j = 0; j < nc; j++)
218  {
219  double tmp_max = octave::numeric_limits<double>::NaN ();
220  octave_idx_type idx_j = 0;
221  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
222  {
223  if (ridx (i) != idx_j)
224  break;
225  else
226  idx_j++;
227  }
228 
229  if (idx_j != nr)
230  tmp_max = 0.;
231 
232  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
233  {
234  double tmp = data (i);
235 
236  if (octave::math::isnan (tmp))
237  continue;
238  else if (octave::math::isnan (tmp_max) || tmp > tmp_max)
239  {
240  idx_j = ridx (i);
241  tmp_max = tmp;
242  }
243 
244  }
245 
246  idx_arg.elem (j) = (octave::math::isnan (tmp_max) ? 0 : idx_j);
247  if (tmp_max != 0.)
248  nel++;
249  }
250 
251  result = SparseMatrix (1, nc, nel);
252 
253  octave_idx_type ii = 0;
254  result.xcidx (0) = 0;
255  for (octave_idx_type j = 0; j < nc; j++)
256  {
257  double tmp = elem (idx_arg(j), j);
258  if (tmp != 0.)
259  {
260  result.xdata (ii) = tmp;
261  result.xridx (ii++) = 0;
262  }
263  result.xcidx (j+1) = ii;
264 
265  }
266  }
267  else
268  {
269  idx_arg.resize (dim_vector (nr, nc == 0 ? 0 : 1), 0);
270 
271  if (nr == 0 || nc == 0 || dim >= dv.ndims ())
272  return SparseMatrix (nr, nc == 0 ? 0 : 1);
273 
274  OCTAVE_LOCAL_BUFFER (octave_idx_type, found, nr);
275 
276  for (octave_idx_type i = 0; i < nr; i++)
277  found[i] = 0;
278 
279  for (octave_idx_type j = 0; j < nc; j++)
280  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
281  if (found[ridx (i)] == -j)
282  found[ridx (i)] = -j - 1;
283 
284  for (octave_idx_type i = 0; i < nr; i++)
285  if (found[i] > -nc && found[i] < 0)
286  idx_arg.elem (i) = -found[i];
287 
288  for (octave_idx_type j = 0; j < nc; j++)
289  {
290  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
291  {
292  octave_idx_type ir = ridx (i);
293  octave_idx_type ix = idx_arg.elem (ir);
294  double tmp = data (i);
295 
296  if (octave::math::isnan (tmp))
297  continue;
298  else if (ix == -1 || tmp > elem (ir, ix))
299  idx_arg.elem (ir) = j;
300  }
301  }
302 
303  octave_idx_type nel = 0;
304  for (octave_idx_type j = 0; j < nr; j++)
305  if (idx_arg.elem (j) == -1 || elem (j, idx_arg.elem (j)) != 0.)
306  nel++;
307 
308  result = SparseMatrix (nr, 1, nel);
309 
310  octave_idx_type ii = 0;
311  result.xcidx (0) = 0;
312  result.xcidx (1) = nel;
313  for (octave_idx_type j = 0; j < nr; j++)
314  {
315  if (idx_arg(j) == -1)
316  {
317  idx_arg(j) = 0;
318  result.xdata (ii) = octave::numeric_limits<double>::NaN ();
319  result.xridx (ii++) = j;
320  }
321  else
322  {
323  double tmp = elem (j, idx_arg(j));
324  if (tmp != 0.)
325  {
326  result.xdata (ii) = tmp;
327  result.xridx (ii++) = j;
328  }
329  }
330  }
331  }
332 
333  return result;
334 }
335 
336 SparseMatrix
337 SparseMatrix::min (int dim) const
338 {
339  Array<octave_idx_type> dummy_idx;
340  return min (dummy_idx, dim);
341 }
342 
343 SparseMatrix
344 SparseMatrix::min (Array<octave_idx_type>& idx_arg, int dim) const
345 {
346  SparseMatrix result;
347  dim_vector dv = dims ();
348  octave_idx_type nr = dv(0);
349  octave_idx_type nc = dv(1);
350 
351  if (dim >= dv.ndims ())
352  {
353  idx_arg.resize (dim_vector (nr, nc), 0);
354  return *this;
355  }
356 
357  if (dim < 0)
358  dim = dv.first_non_singleton ();
359 
360  if (dim == 0)
361  {
362  idx_arg.resize (dim_vector (nr == 0 ? 0 : 1, nc), 0);
363 
364  if (nr == 0 || nc == 0 || dim >= dv.ndims ())
365  return SparseMatrix (nr == 0 ? 0 : 1, nc);
366 
367  octave_idx_type nel = 0;
368  for (octave_idx_type j = 0; j < nc; j++)
369  {
370  double tmp_min = octave::numeric_limits<double>::NaN ();
371  octave_idx_type idx_j = 0;
372  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
373  {
374  if (ridx (i) != idx_j)
375  break;
376  else
377  idx_j++;
378  }
379 
380  if (idx_j != nr)
381  tmp_min = 0.;
382 
383  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
384  {
385  double tmp = data (i);
386 
387  if (octave::math::isnan (tmp))
388  continue;
389  else if (octave::math::isnan (tmp_min) || tmp < tmp_min)
390  {
391  idx_j = ridx (i);
392  tmp_min = tmp;
393  }
394 
395  }
396 
397  idx_arg.elem (j) = (octave::math::isnan (tmp_min) ? 0 : idx_j);
398  if (tmp_min != 0.)
399  nel++;
400  }
401 
402  result = SparseMatrix (1, nc, nel);
403 
404  octave_idx_type ii = 0;
405  result.xcidx (0) = 0;
406  for (octave_idx_type j = 0; j < nc; j++)
407  {
408  double tmp = elem (idx_arg(j), j);
409  if (tmp != 0.)
410  {
411  result.xdata (ii) = tmp;
412  result.xridx (ii++) = 0;
413  }
414  result.xcidx (j+1) = ii;
415 
416  }
417  }
418  else
419  {
420  idx_arg.resize (dim_vector (nr, nc == 0 ? 0 : 1), 0);
421 
422  if (nr == 0 || nc == 0 || dim >= dv.ndims ())
423  return SparseMatrix (nr, nc == 0 ? 0 : 1);
424 
425  OCTAVE_LOCAL_BUFFER (octave_idx_type, found, nr);
426 
427  for (octave_idx_type i = 0; i < nr; i++)
428  found[i] = 0;
429 
430  for (octave_idx_type j = 0; j < nc; j++)
431  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
432  if (found[ridx (i)] == -j)
433  found[ridx (i)] = -j - 1;
434 
435  for (octave_idx_type i = 0; i < nr; i++)
436  if (found[i] > -nc && found[i] < 0)
437  idx_arg.elem (i) = -found[i];
438 
439  for (octave_idx_type j = 0; j < nc; j++)
440  {
441  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
442  {
443  octave_idx_type ir = ridx (i);
444  octave_idx_type ix = idx_arg.elem (ir);
445  double tmp = data (i);
446 
447  if (octave::math::isnan (tmp))
448  continue;
449  else if (ix == -1 || tmp < elem (ir, ix))
450  idx_arg.elem (ir) = j;
451  }
452  }
453 
454  octave_idx_type nel = 0;
455  for (octave_idx_type j = 0; j < nr; j++)
456  if (idx_arg.elem (j) == -1 || elem (j, idx_arg.elem (j)) != 0.)
457  nel++;
458 
459  result = SparseMatrix (nr, 1, nel);
460 
461  octave_idx_type ii = 0;
462  result.xcidx (0) = 0;
463  result.xcidx (1) = nel;
464  for (octave_idx_type j = 0; j < nr; j++)
465  {
466  if (idx_arg(j) == -1)
467  {
468  idx_arg(j) = 0;
469  result.xdata (ii) = octave::numeric_limits<double>::NaN ();
470  result.xridx (ii++) = j;
471  }
472  else
473  {
474  double tmp = elem (j, idx_arg(j));
475  if (tmp != 0.)
476  {
477  result.xdata (ii) = tmp;
478  result.xridx (ii++) = j;
479  }
480  }
481  }
482  }
483 
484  return result;
485 }
486 
487 /*
488 
489 %!assert (max (max (speye (65536))), sparse (1))
490 %!assert (min (min (speye (65536))), sparse (0))
491 %!assert (size (max (sparse (8, 0), [], 1)), [1, 0])
492 %!assert (size (max (sparse (8, 0), [], 2)), [8, 0])
493 %!assert (size (max (sparse (0, 8), [], 1)), [0, 8])
494 %!assert (size (max (sparse (0, 8), [], 2)), [0, 1])
495 %!assert (size (min (sparse (8, 0), [], 1)), [1, 0])
496 %!assert (size (min (sparse (8, 0), [], 2)), [8, 0])
497 %!assert (size (min (sparse (0, 8), [], 1)), [0, 8])
498 %!assert (size (min (sparse (0, 8), [], 2)), [0, 1])
499 
500 */
501 
502 RowVector
503 SparseMatrix::row (octave_idx_type i) const
504 {
505  octave_idx_type nc = columns ();
506  RowVector retval (nc, 0);
507 
508  for (octave_idx_type j = 0; j < nc; j++)
509  for (octave_idx_type k = cidx (j); k < cidx (j+1); k++)
510  {
511  if (ridx (k) == i)
512  {
513  retval(j) = data (k);
514  break;
515  }
516  }
517 
518  return retval;
519 }
520 
521 ColumnVector
522 SparseMatrix::column (octave_idx_type i) const
523 {
524  octave_idx_type nr = rows ();
525  ColumnVector retval (nr, 0);
526 
527  for (octave_idx_type k = cidx (i); k < cidx (i+1); k++)
528  retval(ridx (k)) = data (k);
529 
530  return retval;
531 }
532 
533 SparseMatrix
534 SparseMatrix::concat (const SparseMatrix& rb,
535  const Array<octave_idx_type>& ra_idx)
536 {
537  // Don't use numel to avoid all possibility of an overflow
538  if (rb.rows () > 0 && rb.cols () > 0)
539  insert (rb, ra_idx(0), ra_idx(1));
540  return *this;
541 }
542 
543 SparseComplexMatrix
544 SparseMatrix::concat (const SparseComplexMatrix& rb,
545  const Array<octave_idx_type>& ra_idx)
546 {
547  SparseComplexMatrix retval (*this);
548  if (rb.rows () > 0 && rb.cols () > 0)
549  retval.insert (rb, ra_idx(0), ra_idx(1));
550  return retval;
551 }
552 
553 SparseMatrix
554 real (const SparseComplexMatrix& a)
555 {
556  octave_idx_type nr = a.rows ();
557  octave_idx_type nc = a.cols ();
558  octave_idx_type nz = a.nnz ();
559  SparseMatrix r (nr, nc, nz);
560 
561  for (octave_idx_type i = 0; i < nc +1; i++)
562  r.cidx (i) = a.cidx (i);
563 
564  for (octave_idx_type i = 0; i < nz; i++)
565  {
566  r.data (i) = std::real (a.data (i));
567  r.ridx (i) = a.ridx (i);
568  }
569 
570  r.maybe_compress (true);
571  return r;
572 }
573 
574 SparseMatrix
575 imag (const SparseComplexMatrix& a)
576 {
577  octave_idx_type nr = a.rows ();
578  octave_idx_type nc = a.cols ();
579  octave_idx_type nz = a.nnz ();
580  SparseMatrix r (nr, nc, nz);
581 
582  for (octave_idx_type i = 0; i < nc +1; i++)
583  r.cidx (i) = a.cidx (i);
584 
585  for (octave_idx_type i = 0; i < nz; i++)
586  {
587  r.data (i) = std::imag (a.data (i));
588  r.ridx (i) = a.ridx (i);
589  }
590 
591  r.maybe_compress (true);
592  return r;
593 }
594 
595 /*
596 
597 %!assert (nnz (real (sparse ([1i,1]))), 1)
598 %!assert (nnz (real (sparse ([1i,1]))), 1)
599 
600 */
601 
602 SparseMatrix
603 SparseMatrix::inverse () const
604 {
605  octave_idx_type info;
606  double rcond;
607  MatrixType mattype (*this);
608  return inverse (mattype, info, rcond, 0, 0);
609 }
610 
611 SparseMatrix
612 SparseMatrix::inverse (MatrixType& mattype) const
613 {
614  octave_idx_type info;
615  double rcond;
616  return inverse (mattype, info, rcond, 0, 0);
617 }
618 
619 SparseMatrix
620 SparseMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const
621 {
622  double rcond;
623  return inverse (mattype, info, rcond, 0, 0);
624 }
625 
626 SparseMatrix
627 SparseMatrix::dinverse (MatrixType& mattype, octave_idx_type& info,
628  double& rcond, const bool,
629  const bool calccond) const
630 {
631  SparseMatrix retval;
632 
633  octave_idx_type nr = rows ();
634  octave_idx_type nc = cols ();
635  info = 0;
636 
637  if (nr == 0 || nc == 0 || nr != nc)
638  (*current_liboctave_error_handler) ("inverse requires square matrix");
639 
640  // Print spparms("spumoni") info if requested
641  int typ = mattype.type ();
642  mattype.info ();
643 
644  if (typ != MatrixType::Diagonal && typ != MatrixType::Permuted_Diagonal)
645  (*current_liboctave_error_handler) ("incorrect matrix type");
646 
647  if (typ == MatrixType::Permuted_Diagonal)
648  retval = transpose ();
649  else
650  retval = *this;
651 
652  // Force make_unique to be called
653  double *v = retval.data ();
654 
655  if (calccond)
656  {
657  double dmax = 0.;
658  double dmin = octave::numeric_limits<double>::Inf ();
659  for (octave_idx_type i = 0; i < nr; i++)
660  {
661  double tmp = fabs (v[i]);
662  if (tmp > dmax)
663  dmax = tmp;
664  if (tmp < dmin)
665  dmin = tmp;
666  }
667  rcond = dmin / dmax;
668  }
669 
670  for (octave_idx_type i = 0; i < nr; i++)
671  v[i] = 1.0 / v[i];
672 
673  return retval;
674 }
675 
676 SparseMatrix
677 SparseMatrix::tinverse (MatrixType& mattype, octave_idx_type& info,
678  double& rcond, const bool,
679  const bool calccond) const
680 {
681  SparseMatrix retval;
682 
683  octave_idx_type nr = rows ();
684  octave_idx_type nc = cols ();
685  info = 0;
686 
687  if (nr == 0 || nc == 0 || nr != nc)
688  (*current_liboctave_error_handler) ("inverse requires square matrix");
689 
690  // Print spparms("spumoni") info if requested
691  int typ = mattype.type ();
692  mattype.info ();
693 
694  if (typ != MatrixType::Upper && typ != MatrixType::Permuted_Upper
695  && typ != MatrixType::Lower && typ != MatrixType::Permuted_Lower)
696  (*current_liboctave_error_handler) ("incorrect matrix type");
697 
698  double anorm = 0.;
699  double ainvnorm = 0.;
700 
701  if (calccond)
702  {
703  // Calculate the 1-norm of matrix for rcond calculation
704  for (octave_idx_type j = 0; j < nr; j++)
705  {
706  double atmp = 0.;
707  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
708  atmp += fabs (data (i));
709  if (atmp > anorm)
710  anorm = atmp;
711  }
712  }
713 
714  if (typ == MatrixType::Upper || typ == MatrixType::Lower)
715  {
716  octave_idx_type nz = nnz ();
717  octave_idx_type cx = 0;
718  octave_idx_type nz2 = nz;
719  retval = SparseMatrix (nr, nc, nz2);
720 
721  for (octave_idx_type i = 0; i < nr; i++)
722  {
723  octave_quit ();
724  // place the 1 in the identity position
725  octave_idx_type cx_colstart = cx;
726 
727  if (cx == nz2)
728  {
729  nz2 *= 2;
730  retval.change_capacity (nz2);
731  }
732 
733  retval.xcidx (i) = cx;
734  retval.xridx (cx) = i;
735  retval.xdata (cx) = 1.0;
736  cx++;
737 
738  // iterate across columns of input matrix
739  for (octave_idx_type j = i+1; j < nr; j++)
740  {
741  double v = 0.;
742  // iterate to calculate sum
743  octave_idx_type colXp = retval.xcidx (i);
744  octave_idx_type colUp = cidx (j);
745  octave_idx_type rpX, rpU;
746 
747  if (cidx (j) == cidx (j+1))
748  (*current_liboctave_error_handler) ("division by zero");
749 
750  do
751  {
752  octave_quit ();
753  rpX = retval.xridx (colXp);
754  rpU = ridx (colUp);
755 
756  if (rpX < rpU)
757  colXp++;
758  else if (rpX > rpU)
759  colUp++;
760  else
761  {
762  v -= retval.xdata (colXp) * data (colUp);
763  colXp++;
764  colUp++;
765  }
766  }
767  while (rpX < j && rpU < j && colXp < cx && colUp < nz);
768 
769  // get A(m,m)
770  if (typ == MatrixType::Upper)
771  colUp = cidx (j+1) - 1;
772  else
773  colUp = cidx (j);
774  double pivot = data (colUp);
775  if (pivot == 0. || ridx (colUp) != j)
776  (*current_liboctave_error_handler) ("division by zero");
777 
778  if (v != 0.)
779  {
780  if (cx == nz2)
781  {
782  nz2 *= 2;
783  retval.change_capacity (nz2);
784  }
785 
786  retval.xridx (cx) = j;
787  retval.xdata (cx) = v / pivot;
788  cx++;
789  }
790  }
791 
792  // get A(m,m)
793  octave_idx_type colUp;
794  if (typ == MatrixType::Upper)
795  colUp = cidx (i+1) - 1;
796  else
797  colUp = cidx (i);
798  double pivot = data (colUp);
799  if (pivot == 0. || ridx (colUp) != i)
800  (*current_liboctave_error_handler) ("division by zero");
801 
802  if (pivot != 1.0)
803  for (octave_idx_type j = cx_colstart; j < cx; j++)
804  retval.xdata (j) /= pivot;
805  }
806  retval.xcidx (nr) = cx;
807  retval.maybe_compress ();
808  }
809  else
810  {
811  octave_idx_type nz = nnz ();
812  octave_idx_type cx = 0;
813  octave_idx_type nz2 = nz;
814  retval = SparseMatrix (nr, nc, nz2);
815 
816  OCTAVE_LOCAL_BUFFER (double, work, nr);
817  OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr);
818 
819  octave_idx_type *perm = mattype.triangular_perm ();
820  if (typ == MatrixType::Permuted_Upper)
821  {
822  for (octave_idx_type i = 0; i < nr; i++)
823  rperm[perm[i]] = i;
824  }
825  else
826  {
827  for (octave_idx_type i = 0; i < nr; i++)
828  rperm[i] = perm[i];
829  for (octave_idx_type i = 0; i < nr; i++)
830  perm[rperm[i]] = i;
831  }
832 
833  for (octave_idx_type i = 0; i < nr; i++)
834  {
835  octave_quit ();
836  octave_idx_type iidx = rperm[i];
837 
838  for (octave_idx_type j = 0; j < nr; j++)
839  work[j] = 0.;
840 
841  // place the 1 in the identity position
842  work[iidx] = 1.0;
843 
844  // iterate across columns of input matrix
845  for (octave_idx_type j = iidx+1; j < nr; j++)
846  {
847  double v = 0.;
848  octave_idx_type jidx = perm[j];
849  // iterate to calculate sum
850  for (octave_idx_type k = cidx (jidx);
851  k < cidx (jidx+1); k++)
852  {
853  octave_quit ();
854  v -= work[ridx (k)] * data (k);
855  }
856 
857  // get A(m,m)
858  double pivot;
859  if (typ == MatrixType::Permuted_Upper)
860  pivot = data (cidx (jidx+1) - 1);
861  else
862  pivot = data (cidx (jidx));
863  if (pivot == 0.)
864  (*current_liboctave_error_handler) ("division by zero");
865 
866  work[j] = v / pivot;
867  }
868 
869  // get A(m,m)
870  octave_idx_type colUp;
871  if (typ == MatrixType::Permuted_Upper)
872  colUp = cidx (perm[iidx]+1) - 1;
873  else
874  colUp = cidx (perm[iidx]);
875 
876  double pivot = data (colUp);
877  if (pivot == 0.)
878  (*current_liboctave_error_handler) ("division by zero");
879 
880  octave_idx_type new_cx = cx;
881  for (octave_idx_type j = iidx; j < nr; j++)
882  if (work[j] != 0.0)
883  {
884  new_cx++;
885  if (pivot != 1.0)
886  work[j] /= pivot;
887  }
888 
889  if (cx < new_cx)
890  {
891  nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2);
892  retval.change_capacity (nz2);
893  }
894 
895  retval.xcidx (i) = cx;
896  for (octave_idx_type j = iidx; j < nr; j++)
897  if (work[j] != 0.)
898  {
899  retval.xridx (cx) = j;
900  retval.xdata (cx++) = work[j];
901  }
902  }
903 
904  retval.xcidx (nr) = cx;
905  retval.maybe_compress ();
906  }
907 
908  if (calccond)
909  {
910  // Calculate the 1-norm of inverse matrix for rcond calculation
911  for (octave_idx_type j = 0; j < nr; j++)
912  {
913  double atmp = 0.;
914  for (octave_idx_type i = retval.cidx (j);
915  i < retval.cidx (j+1); i++)
916  atmp += fabs (retval.data (i));
917  if (atmp > ainvnorm)
918  ainvnorm = atmp;
919  }
920 
921  rcond = 1. / ainvnorm / anorm;
922  }
923 
924  return retval;
925 }
926 
927 SparseMatrix
928 SparseMatrix::inverse (MatrixType& mattype, octave_idx_type& info,
929  double& rcond, bool, bool calc_cond) const
930 {
931  if (nnz () == 0)
932  {
933  (*current_liboctave_error_handler)
934  ("inverse of the null matrix not defined");
935  }
936 
937  int typ = mattype.type (false);
938  SparseMatrix ret;
939 
940  if (typ == MatrixType::Unknown)
941  typ = mattype.type (*this);
942 
943  if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
944  ret = dinverse (mattype, info, rcond, true, calc_cond);
945  else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
946  ret = tinverse (mattype, info, rcond, true, calc_cond).transpose ();
947  else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
948  {
949  MatrixType newtype = mattype.transpose ();
950  ret = transpose ().tinverse (newtype, info, rcond, true, calc_cond);
951  }
952  else
953  {
954  if (mattype.ishermitian ())
955  {
956  MatrixType tmp_typ (MatrixType::Upper);
957  octave::math::sparse_chol<SparseMatrix> fact (*this, info, false);
958  rcond = fact.rcond ();
959  if (info == 0)
960  {
961  double rcond2;
962  SparseMatrix Q = fact.Q ();
963  SparseMatrix InvL = fact.L ().transpose ().tinverse (tmp_typ,
964  info, rcond2, true, false);
965  ret = Q * InvL.transpose () * InvL * Q.transpose ();
966  }
967  else
968  {
969  // Matrix is either singular or not positive definite
970  mattype.mark_as_unsymmetric ();
971  }
972  }
973 
974  if (! mattype.ishermitian ())
975  {
976  octave_idx_type n = rows ();
977  ColumnVector Qinit(n);
978  for (octave_idx_type i = 0; i < n; i++)
979  Qinit(i) = i;
980 
981  MatrixType tmp_typ (MatrixType::Upper);
982  octave::math::sparse_lu<SparseMatrix> fact (*this,
983  Qinit, Matrix (),
984  false, false);
985  rcond = fact.rcond ();
986  if (rcond == 0.0)
987  {
988  // Return all Inf matrix with sparsity pattern of input.
989  octave_idx_type nz = nnz ();
990  ret = SparseMatrix (rows (), cols (), nz);
991  std::fill (ret.xdata (), ret.xdata () + nz,
992  octave::numeric_limits<double>::Inf ());
993  std::copy_n (ridx (), nz, ret.xridx ());
994  std::copy_n (cidx (), cols () + 1, ret.xcidx ());
995 
996  return ret;
997  }
998 
999  double rcond2;
1000  SparseMatrix InvL = fact.L ().transpose ().tinverse (tmp_typ,
1001  info, rcond2, true, false);
1002  SparseMatrix InvU = fact.U ().tinverse (tmp_typ, info, rcond2,
1003  true, false).transpose ();
1004  ret = fact.Pc ().transpose () * InvU * InvL * fact.Pr ();
1005  }
1006  }
1007 
1008  return ret;
1009 }
1010 
1011 DET
1012 SparseMatrix::determinant () const
1013 {
1014  octave_idx_type info;
1015  double rcond;
1016  return determinant (info, rcond, 0);
1017 }
1018 
1019 DET
1020 SparseMatrix::determinant (octave_idx_type& info) const
1021 {
1022  double rcond;
1023  return determinant (info, rcond, 0);
1024 }
1025 
1026 DET
1027 SparseMatrix::determinant (octave_idx_type& err, double& rcond, bool) const
1028 {
1029  DET retval;
1030 
1031 #if defined (HAVE_UMFPACK)
1032 
1033  octave_idx_type nr = rows ();
1034  octave_idx_type nc = cols ();
1035 
1036  if (nr == 0 || nc == 0 || nr != nc)
1037  {
1038  retval = DET (1.0);
1039  }
1040  else
1041  {
1042  err = 0;
1043 
1044  // Setup the control parameters
1045  Matrix Control (UMFPACK_CONTROL, 1);
1046  double *control = Control.fortran_vec ();
1047  UMFPACK_DNAME (defaults) (control);
1048 
1049  double tmp = octave::sparse_params::get_key ("spumoni");
1050  if (! octave::math::isnan (tmp))
1051  Control (UMFPACK_PRL) = tmp;
1052 
1053  tmp = octave::sparse_params::get_key ("piv_tol");
1054  if (! octave::math::isnan (tmp))
1055  {
1056  Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
1057  Control (UMFPACK_PIVOT_TOLERANCE) = tmp;
1058  }
1059 
1060  // Set whether we are allowed to modify Q or not
1061  tmp = octave::sparse_params::get_key ("autoamd");
1062  if (! octave::math::isnan (tmp))
1063  Control (UMFPACK_FIXQ) = tmp;
1064 
1065  // Turn-off UMFPACK scaling for LU
1066  Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE;
1067 
1068  UMFPACK_DNAME (report_control) (control);
1069 
1070  const octave_idx_type *Ap = cidx ();
1071  const octave_idx_type *Ai = ridx ();
1072  const double *Ax = data ();
1073 
1074  UMFPACK_DNAME (report_matrix) (nr, nc,
1075  octave::to_suitesparse_intptr (Ap),
1076  octave::to_suitesparse_intptr (Ai),
1077  Ax, 1, control);
1078 
1079  void *Symbolic;
1080  Matrix Info (1, UMFPACK_INFO);
1081  double *info = Info.fortran_vec ();
1082  int status = UMFPACK_DNAME (qsymbolic) (nr, nc,
1083  octave::to_suitesparse_intptr (Ap),
1084  octave::to_suitesparse_intptr (Ai),
1085  Ax, nullptr, &Symbolic, control, info);
1086 
1087  if (status < 0)
1088  {
1089  UMFPACK_DNAME (report_status) (control, status);
1090  UMFPACK_DNAME (report_info) (control, info);
1091 
1092  UMFPACK_DNAME (free_symbolic) (&Symbolic);
1093 
1094  (*current_liboctave_error_handler)
1095  ("SparseMatrix::determinant symbolic factorization failed");
1096  }
1097  else
1098  {
1099  UMFPACK_DNAME (report_symbolic) (Symbolic, control);
1100 
1101  void *Numeric;
1102  status = UMFPACK_DNAME (numeric) (octave::to_suitesparse_intptr (Ap),
1103  octave::to_suitesparse_intptr (Ai),
1104  Ax, Symbolic,
1105  &Numeric, control, info);
1106  UMFPACK_DNAME (free_symbolic) (&Symbolic);
1107 
1108  rcond = Info (UMFPACK_RCOND);
1109 
1110  if (status < 0)
1111  {
1112  UMFPACK_DNAME (report_status) (control, status);
1113  UMFPACK_DNAME (report_info) (control, info);
1114 
1115  UMFPACK_DNAME (free_numeric) (&Numeric);
1116  (*current_liboctave_error_handler)
1117  ("SparseMatrix::determinant numeric factorization failed");
1118  }
1119  else
1120  {
1121  UMFPACK_DNAME (report_numeric) (Numeric, control);
1122 
1123  double c10, e10;
1124 
1125  status = UMFPACK_DNAME (get_determinant) (&c10, &e10, Numeric,
1126  info);
1127 
1128  if (status < 0)
1129  {
1130  UMFPACK_DNAME (report_status) (control, status);
1131  UMFPACK_DNAME (report_info) (control, info);
1132 
1133  (*current_liboctave_error_handler)
1134  ("SparseMatrix::determinant error calculating determinant");
1135  }
1136  else
1137  retval = DET (c10, e10, 10);
1138 
1139  UMFPACK_DNAME (free_numeric) (&Numeric);
1140  }
1141  }
1142  }
1143 
1144 #else
1145 
1146  octave_unused_parameter (err);
1147  octave_unused_parameter (rcond);
1148 
1149  (*current_liboctave_error_handler)
1150  ("support for UMFPACK was unavailable or disabled "
1151  "when liboctave was built");
1152 
1153 #endif
1154 
1155  return retval;
1156 }
1157 
1158 Matrix
1159 SparseMatrix::dsolve (MatrixType& mattype, const Matrix& b,
1160  octave_idx_type& err,
1161  double& rcond, solve_singularity_handler,
1162  bool calc_cond) const
1163 {
1164  Matrix retval;
1165 
1166  octave_idx_type nr = rows ();
1167  octave_idx_type nc = cols ();
1168  octave_idx_type nm = (nc < nr ? nc : nr);
1169  err = 0;
1170 
1171  if (nr != b.rows ())
1172  (*current_liboctave_error_handler)
1173  ("matrix dimension mismatch solution of linear equations");
1174 
1175  if (nr == 0 || nc == 0 || b.cols () == 0)
1176  retval = Matrix (nc, b.cols (), 0.0);
1177  else
1178  {
1179  // Print spparms("spumoni") info if requested
1180  int typ = mattype.type ();
1181  mattype.info ();
1182 
1183  if (typ != MatrixType::Diagonal && typ != MatrixType::Permuted_Diagonal)
1184  (*current_liboctave_error_handler) ("incorrect matrix type");
1185 
1186  retval.resize (nc, b.cols (), 0.);
1187  if (typ == MatrixType::Diagonal)
1188  for (octave_idx_type j = 0; j < b.cols (); j++)
1189  for (octave_idx_type i = 0; i < nm; i++)
1190  retval(i, j) = b(i, j) / data (i);
1191  else
1192  for (octave_idx_type j = 0; j < b.cols (); j++)
1193  for (octave_idx_type k = 0; k < nc; k++)
1194  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
1195  retval(k, j) = b(ridx (i), j) / data (i);
1196 
1197  if (calc_cond)
1198  {
1199  double dmax = 0.;
1200  double dmin = octave::numeric_limits<double>::Inf ();
1201  for (octave_idx_type i = 0; i < nm; i++)
1202  {
1203  double tmp = fabs (data (i));
1204  if (tmp > dmax)
1205  dmax = tmp;
1206  if (tmp < dmin)
1207  dmin = tmp;
1208  }
1209  rcond = dmin / dmax;
1210  }
1211  else
1212  rcond = 1.;
1213  }
1214 
1215  return retval;
1216 }
1217 
1218 SparseMatrix
1219 SparseMatrix::dsolve (MatrixType& mattype, const SparseMatrix& b,
1220  octave_idx_type& err, double& rcond,
1221  solve_singularity_handler, bool calc_cond) const
1222 {
1223  SparseMatrix retval;
1224 
1225  octave_idx_type nr = rows ();
1226  octave_idx_type nc = cols ();
1227  octave_idx_type nm = (nc < nr ? nc : nr);
1228  err = 0;
1229 
1230  if (nr != b.rows ())
1231  (*current_liboctave_error_handler)
1232  ("matrix dimension mismatch solution of linear equations");
1233 
1234  if (nr == 0 || nc == 0 || b.cols () == 0)
1235  retval = SparseMatrix (nc, b.cols ());
1236  else
1237  {
1238  // Print spparms("spumoni") info if requested
1239  int typ = mattype.type ();
1240  mattype.info ();
1241 
1242  if (typ != MatrixType::Diagonal && typ != MatrixType::Permuted_Diagonal)
1243  (*current_liboctave_error_handler) ("incorrect matrix type");
1244 
1245  octave_idx_type b_nc = b.cols ();
1246  octave_idx_type b_nz = b.nnz ();
1247  retval = SparseMatrix (nc, b_nc, b_nz);
1248 
1249  retval.xcidx (0) = 0;
1250  octave_idx_type ii = 0;
1251  if (typ == MatrixType::Diagonal)
1252  for (octave_idx_type j = 0; j < b_nc; j++)
1253  {
1254  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
1255  {
1256  if (b.ridx (i) >= nm)
1257  break;
1258  retval.xridx (ii) = b.ridx (i);
1259  retval.xdata (ii++) = b.data (i) / data (b.ridx (i));
1260  }
1261  retval.xcidx (j+1) = ii;
1262  }
1263  else
1264  for (octave_idx_type j = 0; j < b_nc; j++)
1265  {
1266  for (octave_idx_type l = 0; l < nc; l++)
1267  for (octave_idx_type i = cidx (l); i < cidx (l+1); i++)
1268  {
1269  bool found = false;
1270  octave_idx_type k;
1271  for (k = b.cidx (j); k < b.cidx (j+1); k++)
1272  if (ridx (i) == b.ridx (k))
1273  {
1274  found = true;
1275  break;
1276  }
1277  if (found)
1278  {
1279  retval.xridx (ii) = l;
1280  retval.xdata (ii++) = b.data (k) / data (i);
1281  }
1282  }
1283  retval.xcidx (j+1) = ii;
1284  }
1285 
1286  if (calc_cond)
1287  {
1288  double dmax = 0.;
1289  double dmin = octave::numeric_limits<double>::Inf ();
1290  for (octave_idx_type i = 0; i < nm; i++)
1291  {
1292  double tmp = fabs (data (i));
1293  if (tmp > dmax)
1294  dmax = tmp;
1295  if (tmp < dmin)
1296  dmin = tmp;
1297  }
1298  rcond = dmin / dmax;
1299  }
1300  else
1301  rcond = 1.;
1302  }
1303 
1304  return retval;
1305 }
1306 
1307 ComplexMatrix
1308 SparseMatrix::dsolve (MatrixType& mattype, const ComplexMatrix& b,
1309  octave_idx_type& err, double& rcond,
1310  solve_singularity_handler, bool calc_cond) const
1311 {
1312  ComplexMatrix retval;
1313 
1314  octave_idx_type nr = rows ();
1315  octave_idx_type nc = cols ();
1316  octave_idx_type nm = (nc < nr ? nc : nr);
1317  err = 0;
1318 
1319  if (nr != b.rows ())
1320  (*current_liboctave_error_handler)
1321  ("matrix dimension mismatch solution of linear equations");
1322 
1323  if (nr == 0 || nc == 0 || b.cols () == 0)
1324  retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
1325  else
1326  {
1327  // Print spparms("spumoni") info if requested
1328  int typ = mattype.type ();
1329  mattype.info ();
1330 
1331  if (typ != MatrixType::Diagonal && typ != MatrixType::Permuted_Diagonal)
1332  (*current_liboctave_error_handler) ("incorrect matrix type");
1333 
1334  retval.resize (nc, b.cols (), 0);
1335  if (typ == MatrixType::Diagonal)
1336  for (octave_idx_type j = 0; j < b.cols (); j++)
1337  for (octave_idx_type i = 0; i < nm; i++)
1338  retval(i, j) = b(i, j) / data (i);
1339  else
1340  for (octave_idx_type j = 0; j < b.cols (); j++)
1341  for (octave_idx_type k = 0; k < nc; k++)
1342  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
1343  retval(k, j) = b(ridx (i), j) / data (i);
1344 
1345  if (calc_cond)
1346  {
1347  double dmax = 0.;
1348  double dmin = octave::numeric_limits<double>::Inf ();
1349  for (octave_idx_type i = 0; i < nm; i++)
1350  {
1351  double tmp = fabs (data (i));
1352  if (tmp > dmax)
1353  dmax = tmp;
1354  if (tmp < dmin)
1355  dmin = tmp;
1356  }
1357  rcond = dmin / dmax;
1358  }
1359  else
1360  rcond = 1.;
1361  }
1362 
1363  return retval;
1364 }
1365 
1366 SparseComplexMatrix
1367 SparseMatrix::dsolve (MatrixType& mattype, const SparseComplexMatrix& b,
1368  octave_idx_type& err, double& rcond,
1369  solve_singularity_handler, bool calc_cond) const
1370 {
1371  SparseComplexMatrix retval;
1372 
1373  octave_idx_type nr = rows ();
1374  octave_idx_type nc = cols ();
1375  octave_idx_type nm = (nc < nr ? nc : nr);
1376  err = 0;
1377 
1378  if (nr != b.rows ())
1379  (*current_liboctave_error_handler)
1380  ("matrix dimension mismatch solution of linear equations");
1381 
1382  if (nr == 0 || nc == 0 || b.cols () == 0)
1383  retval = SparseComplexMatrix (nc, b.cols ());
1384  else
1385  {
1386  // Print spparms("spumoni") info if requested
1387  int typ = mattype.type ();
1388  mattype.info ();
1389 
1390  if (typ != MatrixType::Diagonal && typ != MatrixType::Permuted_Diagonal)
1391  (*current_liboctave_error_handler) ("incorrect matrix type");
1392 
1393  octave_idx_type b_nc = b.cols ();
1394  octave_idx_type b_nz = b.nnz ();
1395  retval = SparseComplexMatrix (nc, b_nc, b_nz);
1396 
1397  retval.xcidx (0) = 0;
1398  octave_idx_type ii = 0;
1399  if (typ == MatrixType::Diagonal)
1400  for (octave_idx_type j = 0; j < b.cols (); j++)
1401  {
1402  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
1403  {
1404  if (b.ridx (i) >= nm)
1405  break;
1406  retval.xridx (ii) = b.ridx (i);
1407  retval.xdata (ii++) = b.data (i) / data (b.ridx (i));
1408  }
1409  retval.xcidx (j+1) = ii;
1410  }
1411  else
1412  for (octave_idx_type j = 0; j < b.cols (); j++)
1413  {
1414  for (octave_idx_type l = 0; l < nc; l++)
1415  for (octave_idx_type i = cidx (l); i < cidx (l+1); i++)
1416  {
1417  bool found = false;
1418  octave_idx_type k;
1419  for (k = b.cidx (j); k < b.cidx (j+1); k++)
1420  if (ridx (i) == b.ridx (k))
1421  {
1422  found = true;
1423  break;
1424  }
1425  if (found)
1426  {
1427  retval.xridx (ii) = l;
1428  retval.xdata (ii++) = b.data (k) / data (i);
1429  }
1430  }
1431  retval.xcidx (j+1) = ii;
1432  }
1433 
1434  if (calc_cond)
1435  {
1436  double dmax = 0.;
1437  double dmin = octave::numeric_limits<double>::Inf ();
1438  for (octave_idx_type i = 0; i < nm; i++)
1439  {
1440  double tmp = fabs (data (i));
1441  if (tmp > dmax)
1442  dmax = tmp;
1443  if (tmp < dmin)
1444  dmin = tmp;
1445  }
1446  rcond = dmin / dmax;
1447  }
1448  else
1449  rcond = 1.;
1450  }
1451 
1452  return retval;
1453 }
1454 
1455 Matrix
1456 SparseMatrix::utsolve (MatrixType& mattype, const Matrix& b,
1457  octave_idx_type& err, double& rcond,
1458  solve_singularity_handler sing_handler,
1459  bool calc_cond) const
1460 {
1461  Matrix retval;
1462 
1463  octave_idx_type nr = rows ();
1464  octave_idx_type nc = cols ();
1465  octave_idx_type nm = (nc > nr ? nc : nr);
1466  err = 0;
1467 
1468  if (nr != b.rows ())
1469  (*current_liboctave_error_handler)
1470  ("matrix dimension mismatch solution of linear equations");
1471 
1472  if (nr == 0 || nc == 0 || b.cols () == 0)
1473  retval = Matrix (nc, b.cols (), 0.0);
1474  else
1475  {
1476  // Print spparms("spumoni") info if requested
1477  int typ = mattype.type ();
1478  mattype.info ();
1479 
1480  if (typ != MatrixType::Permuted_Upper && typ != MatrixType::Upper)
1481  (*current_liboctave_error_handler) ("incorrect matrix type");
1482 
1483  double anorm = 0.;
1484  double ainvnorm = 0.;
1485  octave_idx_type b_nc = b.cols ();
1486  rcond = 1.;
1487 
1488  if (calc_cond)
1489  {
1490  // Calculate the 1-norm of matrix for rcond calculation
1491  for (octave_idx_type j = 0; j < nc; j++)
1492  {
1493  double atmp = 0.;
1494  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
1495  atmp += fabs (data (i));
1496  if (atmp > anorm)
1497  anorm = atmp;
1498  }
1499  }
1500 
1501  if (typ == MatrixType::Permuted_Upper)
1502  {
1503  retval.resize (nc, b_nc);
1504  octave_idx_type *perm = mattype.triangular_perm ();
1505  OCTAVE_LOCAL_BUFFER (double, work, nm);
1506 
1507  for (octave_idx_type j = 0; j < b_nc; j++)
1508  {
1509  for (octave_idx_type i = 0; i < nr; i++)
1510  work[i] = b(i, j);
1511  for (octave_idx_type i = nr; i < nc; i++)
1512  work[i] = 0.;
1513 
1514  for (octave_idx_type k = nc-1; k >= 0; k--)
1515  {
1516  octave_idx_type kidx = perm[k];
1517 
1518  if (work[k] != 0.)
1519  {
1520  if (ridx (cidx (kidx+1)-1) != k
1521  || data (cidx (kidx+1)-1) == 0.)
1522  {
1523  err = -2;
1524  goto triangular_error;
1525  }
1526 
1527  double tmp = work[k] / data (cidx (kidx+1)-1);
1528  work[k] = tmp;
1529  for (octave_idx_type i = cidx (kidx);
1530  i < cidx (kidx+1)-1; i++)
1531  {
1532  octave_idx_type iidx = ridx (i);
1533  work[iidx] = work[iidx] - tmp * data (i);
1534  }
1535  }
1536  }
1537 
1538  for (octave_idx_type i = 0; i < nc; i++)
1539  retval.xelem (perm[i], j) = work[i];
1540  }
1541 
1542  if (calc_cond)
1543  {
1544  // Calculation of 1-norm of inv(*this)
1545  for (octave_idx_type i = 0; i < nm; i++)
1546  work[i] = 0.;
1547 
1548  for (octave_idx_type j = 0; j < nr; j++)
1549  {
1550  work[j] = 1.;
1551 
1552  for (octave_idx_type k = j; k >= 0; k--)
1553  {
1554  octave_idx_type iidx = perm[k];
1555 
1556  if (work[k] != 0.)
1557  {
1558  double tmp = work[k] / data (cidx (iidx+1)-1);
1559  work[k] = tmp;
1560  for (octave_idx_type i = cidx (iidx);
1561  i < cidx (iidx+1)-1; i++)
1562  {
1563  octave_idx_type idx2 = ridx (i);
1564  work[idx2] = work[idx2] - tmp * data (i);
1565  }
1566  }
1567  }
1568  double atmp = 0;
1569  for (octave_idx_type i = 0; i < j+1; i++)
1570  {
1571  atmp += fabs (work[i]);
1572  work[i] = 0.;
1573  }
1574  if (atmp > ainvnorm)
1575  ainvnorm = atmp;
1576  }
1577  rcond = 1. / ainvnorm / anorm;
1578  }
1579  }
1580  else
1581  {
1582  OCTAVE_LOCAL_BUFFER (double, work, nm);
1583  retval.resize (nc, b_nc);
1584 
1585  for (octave_idx_type j = 0; j < b_nc; j++)
1586  {
1587  for (octave_idx_type i = 0; i < nr; i++)
1588  work[i] = b(i, j);
1589  for (octave_idx_type i = nr; i < nc; i++)
1590  work[i] = 0.;
1591 
1592  for (octave_idx_type k = nc-1; k >= 0; k--)
1593  {
1594  if (work[k] != 0.)
1595  {
1596  if (ridx (cidx (k+1)-1) != k
1597  || data (cidx (k+1)-1) == 0.)
1598  {
1599  err = -2;
1600  goto triangular_error;
1601  }
1602 
1603  double tmp = work[k] / data (cidx (k+1)-1);
1604  work[k] = tmp;
1605  for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
1606  {
1607  octave_idx_type iidx = ridx (i);
1608  work[iidx] = work[iidx] - tmp * data (i);
1609  }
1610  }
1611  }
1612 
1613  for (octave_idx_type i = 0; i < nc; i++)
1614  retval.xelem (i, j) = work[i];
1615  }
1616 
1617  if (calc_cond)
1618  {
1619  // Calculation of 1-norm of inv(*this)
1620  for (octave_idx_type i = 0; i < nm; i++)
1621  work[i] = 0.;
1622 
1623  for (octave_idx_type j = 0; j < nr; j++)
1624  {
1625  work[j] = 1.;
1626 
1627  for (octave_idx_type k = j; k >= 0; k--)
1628  {
1629  if (work[k] != 0.)
1630  {
1631  double tmp = work[k] / data (cidx (k+1)-1);
1632  work[k] = tmp;
1633  for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
1634  {
1635  octave_idx_type iidx = ridx (i);
1636  work[iidx] = work[iidx] - tmp * data (i);
1637  }
1638  }
1639  }
1640  double atmp = 0;
1641  for (octave_idx_type i = 0; i < j+1; i++)
1642  {
1643  atmp += fabs (work[i]);
1644  work[i] = 0.;
1645  }
1646  if (atmp > ainvnorm)
1647  ainvnorm = atmp;
1648  }
1649  rcond = 1. / ainvnorm / anorm;
1650  }
1651  }
1652 
1653  triangular_error:
1654  if (err != 0)
1655  {
1656  if (sing_handler)
1657  {
1658  sing_handler (rcond);
1659  mattype.mark_as_rectangular ();
1660  }
1661  else
1662  octave::warn_singular_matrix (rcond);
1663  }
1664 
1665  volatile double rcond_plus_one = rcond + 1.0;
1666 
1667  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
1668  {
1669  err = -2;
1670 
1671  if (sing_handler)
1672  {
1673  sing_handler (rcond);
1674  mattype.mark_as_rectangular ();
1675  }
1676  else
1677  octave::warn_singular_matrix (rcond);
1678  }
1679  }
1680 
1681  return retval;
1682 }
1683 
1684 SparseMatrix
1685 SparseMatrix::utsolve (MatrixType& mattype, const SparseMatrix& b,
1686  octave_idx_type& err, double& rcond,
1687  solve_singularity_handler sing_handler,
1688  bool calc_cond) const
1689 {
1690  SparseMatrix retval;
1691 
1692  octave_idx_type nr = rows ();
1693  octave_idx_type nc = cols ();
1694  octave_idx_type nm = (nc > nr ? nc : nr);
1695  err = 0;
1696 
1697  if (nr != b.rows ())
1698  (*current_liboctave_error_handler)
1699  ("matrix dimension mismatch solution of linear equations");
1700 
1701  if (nr == 0 || nc == 0 || b.cols () == 0)
1702  retval = SparseMatrix (nc, b.cols ());
1703  else
1704  {
1705  // Print spparms("spumoni") info if requested
1706  int typ = mattype.type ();
1707  mattype.info ();
1708 
1709  if (typ != MatrixType::Permuted_Upper && typ != MatrixType::Upper)
1710  (*current_liboctave_error_handler) ("incorrect matrix type");
1711 
1712  double anorm = 0.;
1713  double ainvnorm = 0.;
1714  rcond = 1.;
1715 
1716  if (calc_cond)
1717  {
1718  // Calculate the 1-norm of matrix for rcond calculation
1719  for (octave_idx_type j = 0; j < nc; j++)
1720  {
1721  double atmp = 0.;
1722  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
1723  atmp += fabs (data (i));
1724  if (atmp > anorm)
1725  anorm = atmp;
1726  }
1727  }
1728 
1729  octave_idx_type b_nc = b.cols ();
1730  octave_idx_type b_nz = b.nnz ();
1731  retval = SparseMatrix (nc, b_nc, b_nz);
1732  retval.xcidx (0) = 0;
1733  octave_idx_type ii = 0;
1734  octave_idx_type x_nz = b_nz;
1735 
1736  if (typ == MatrixType::Permuted_Upper)
1737  {
1738  octave_idx_type *perm = mattype.triangular_perm ();
1739  OCTAVE_LOCAL_BUFFER (double, work, nm);
1740 
1741  OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc);
1742  for (octave_idx_type i = 0; i < nc; i++)
1743  rperm[perm[i]] = i;
1744 
1745  for (octave_idx_type j = 0; j < b_nc; j++)
1746  {
1747  for (octave_idx_type i = 0; i < nm; i++)
1748  work[i] = 0.;
1749  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
1750  work[b.ridx (i)] = b.data (i);
1751 
1752  for (octave_idx_type k = nc-1; k >= 0; k--)
1753  {
1754  octave_idx_type kidx = perm[k];
1755 
1756  if (work[k] != 0.)
1757  {
1758  if (ridx (cidx (kidx+1)-1) != k
1759  || data (cidx (kidx+1)-1) == 0.)
1760  {
1761  err = -2;
1762  goto triangular_error;
1763  }
1764 
1765  double tmp = work[k] / data (cidx (kidx+1)-1);
1766  work[k] = tmp;
1767  for (octave_idx_type i = cidx (kidx);
1768  i < cidx (kidx+1)-1; i++)
1769  {
1770  octave_idx_type iidx = ridx (i);
1771  work[iidx] = work[iidx] - tmp * data (i);
1772  }
1773  }
1774  }
1775 
1776  // Count nonzeros in work vector and adjust space in
1777  // retval if needed
1778  octave_idx_type new_nnz = 0;
1779  for (octave_idx_type i = 0; i < nc; i++)
1780  if (work[i] != 0.)
1781  new_nnz++;
1782 
1783  if (ii + new_nnz > x_nz)
1784  {
1785  // Resize the sparse matrix
1786  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
1787  retval.change_capacity (sz);
1788  x_nz = sz;
1789  }
1790 
1791  for (octave_idx_type i = 0; i < nc; i++)
1792  if (work[rperm[i]] != 0.)
1793  {
1794  retval.xridx (ii) = i;
1795  retval.xdata (ii++) = work[rperm[i]];
1796  }
1797  retval.xcidx (j+1) = ii;
1798  }
1799 
1800  retval.maybe_compress ();
1801 
1802  if (calc_cond)
1803  {
1804  // Calculation of 1-norm of inv(*this)
1805  for (octave_idx_type i = 0; i < nm; i++)
1806  work[i] = 0.;
1807 
1808  for (octave_idx_type j = 0; j < nr; j++)
1809  {
1810  work[j] = 1.;
1811 
1812  for (octave_idx_type k = j; k >= 0; k--)
1813  {
1814  octave_idx_type iidx = perm[k];
1815 
1816  if (work[k] != 0.)
1817  {
1818  double tmp = work[k] / data (cidx (iidx+1)-1);
1819  work[k] = tmp;
1820  for (octave_idx_type i = cidx (iidx);
1821  i < cidx (iidx+1)-1; i++)
1822  {
1823  octave_idx_type idx2 = ridx (i);
1824  work[idx2] = work[idx2] - tmp * data (i);
1825  }
1826  }
1827  }
1828  double atmp = 0;
1829  for (octave_idx_type i = 0; i < j+1; i++)
1830  {
1831  atmp += fabs (work[i]);
1832  work[i] = 0.;
1833  }
1834  if (atmp > ainvnorm)
1835  ainvnorm = atmp;
1836  }
1837  rcond = 1. / ainvnorm / anorm;
1838  }
1839  }
1840  else
1841  {
1842  OCTAVE_LOCAL_BUFFER (double, work, nm);
1843 
1844  for (octave_idx_type j = 0; j < b_nc; j++)
1845  {
1846  for (octave_idx_type i = 0; i < nm; i++)
1847  work[i] = 0.;
1848  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
1849  work[b.ridx (i)] = b.data (i);
1850 
1851  for (octave_idx_type k = nc-1; k >= 0; k--)
1852  {
1853  if (work[k] != 0.)
1854  {
1855  if (ridx (cidx (k+1)-1) != k
1856  || data (cidx (k+1)-1) == 0.)
1857  {
1858  err = -2;
1859  goto triangular_error;
1860  }
1861 
1862  double tmp = work[k] / data (cidx (k+1)-1);
1863  work[k] = tmp;
1864  for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
1865  {
1866  octave_idx_type iidx = ridx (i);
1867  work[iidx] = work[iidx] - tmp * data (i);
1868  }
1869  }
1870  }
1871 
1872  // Count nonzeros in work vector and adjust space in
1873  // retval if needed
1874  octave_idx_type new_nnz = 0;
1875  for (octave_idx_type i = 0; i < nc; i++)
1876  if (work[i] != 0.)
1877  new_nnz++;
1878 
1879  if (ii + new_nnz > x_nz)
1880  {
1881  // Resize the sparse matrix
1882  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
1883  retval.change_capacity (sz);
1884  x_nz = sz;
1885  }
1886 
1887  for (octave_idx_type i = 0; i < nc; i++)
1888  if (work[i] != 0.)
1889  {
1890  retval.xridx (ii) = i;
1891  retval.xdata (ii++) = work[i];
1892  }
1893  retval.xcidx (j+1) = ii;
1894  }
1895 
1896  retval.maybe_compress ();
1897 
1898  if (calc_cond)
1899  {
1900  // Calculation of 1-norm of inv(*this)
1901  for (octave_idx_type i = 0; i < nm; i++)
1902  work[i] = 0.;
1903 
1904  for (octave_idx_type j = 0; j < nr; j++)
1905  {
1906  work[j] = 1.;
1907 
1908  for (octave_idx_type k = j; k >= 0; k--)
1909  {
1910  if (work[k] != 0.)
1911  {
1912  double tmp = work[k] / data (cidx (k+1)-1);
1913  work[k] = tmp;
1914  for (octave_idx_type i = cidx (k);
1915  i < cidx (k+1)-1; i++)
1916  {
1917  octave_idx_type iidx = ridx (i);
1918  work[iidx] = work[iidx] - tmp * data (i);
1919  }
1920  }
1921  }
1922  double atmp = 0;
1923  for (octave_idx_type i = 0; i < j+1; i++)
1924  {
1925  atmp += fabs (work[i]);
1926  work[i] = 0.;
1927  }
1928  if (atmp > ainvnorm)
1929  ainvnorm = atmp;
1930  }
1931  rcond = 1. / ainvnorm / anorm;
1932  }
1933  }
1934 
1935  triangular_error:
1936  if (err != 0)
1937  {
1938  if (sing_handler)
1939  {
1940  sing_handler (rcond);
1941  mattype.mark_as_rectangular ();
1942  }
1943  else
1944  octave::warn_singular_matrix (rcond);
1945  }
1946 
1947  volatile double rcond_plus_one = rcond + 1.0;
1948 
1949  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
1950  {
1951  err = -2;
1952 
1953  if (sing_handler)
1954  {
1955  sing_handler (rcond);
1956  mattype.mark_as_rectangular ();
1957  }
1958  else
1959  octave::warn_singular_matrix (rcond);
1960  }
1961  }
1962  return retval;
1963 }
1964 
1965 ComplexMatrix
1966 SparseMatrix::utsolve (MatrixType& mattype, const ComplexMatrix& b,
1967  octave_idx_type& err, double& rcond,
1968  solve_singularity_handler sing_handler,
1969  bool calc_cond) const
1970 {
1971  ComplexMatrix retval;
1972 
1973  octave_idx_type nr = rows ();
1974  octave_idx_type nc = cols ();
1975  octave_idx_type nm = (nc > nr ? nc : nr);
1976  err = 0;
1977 
1978  if (nr != b.rows ())
1979  (*current_liboctave_error_handler)
1980  ("matrix dimension mismatch solution of linear equations");
1981 
1982  if (nr == 0 || nc == 0 || b.cols () == 0)
1983  retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
1984  else
1985  {
1986  // Print spparms("spumoni") info if requested
1987  int typ = mattype.type ();
1988  mattype.info ();
1989 
1990  if (typ != MatrixType::Permuted_Upper && typ != MatrixType::Upper)
1991  (*current_liboctave_error_handler) ("incorrect matrix type");
1992 
1993  double anorm = 0.;
1994  double ainvnorm = 0.;
1995  octave_idx_type b_nc = b.cols ();
1996  rcond = 1.;
1997 
1998  if (calc_cond)
1999  {
2000  // Calculate the 1-norm of matrix for rcond calculation
2001  for (octave_idx_type j = 0; j < nc; j++)
2002  {
2003  double atmp = 0.;
2004  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2005  atmp += fabs (data (i));
2006  if (atmp > anorm)
2007  anorm = atmp;
2008  }
2009  }
2010 
2011  if (typ == MatrixType::Permuted_Upper)
2012  {
2013  retval.resize (nc, b_nc);
2014  octave_idx_type *perm = mattype.triangular_perm ();
2015  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2016 
2017  for (octave_idx_type j = 0; j < b_nc; j++)
2018  {
2019  for (octave_idx_type i = 0; i < nr; i++)
2020  cwork[i] = b(i, j);
2021  for (octave_idx_type i = nr; i < nc; i++)
2022  cwork[i] = 0.;
2023 
2024  for (octave_idx_type k = nc-1; k >= 0; k--)
2025  {
2026  octave_idx_type kidx = perm[k];
2027 
2028  if (cwork[k] != 0.)
2029  {
2030  if (ridx (cidx (kidx+1)-1) != k
2031  || data (cidx (kidx+1)-1) == 0.)
2032  {
2033  err = -2;
2034  goto triangular_error;
2035  }
2036 
2037  Complex tmp = cwork[k] / data (cidx (kidx+1)-1);
2038  cwork[k] = tmp;
2039  for (octave_idx_type i = cidx (kidx);
2040  i < cidx (kidx+1)-1; i++)
2041  {
2042  octave_idx_type iidx = ridx (i);
2043  cwork[iidx] = cwork[iidx] - tmp * data (i);
2044  }
2045  }
2046  }
2047 
2048  for (octave_idx_type i = 0; i < nc; i++)
2049  retval.xelem (perm[i], j) = cwork[i];
2050  }
2051 
2052  if (calc_cond)
2053  {
2054  // Calculation of 1-norm of inv(*this)
2055  OCTAVE_LOCAL_BUFFER (double, work, nm);
2056  for (octave_idx_type i = 0; i < nm; i++)
2057  work[i] = 0.;
2058 
2059  for (octave_idx_type j = 0; j < nr; j++)
2060  {
2061  work[j] = 1.;
2062 
2063  for (octave_idx_type k = j; k >= 0; k--)
2064  {
2065  octave_idx_type iidx = perm[k];
2066 
2067  if (work[k] != 0.)
2068  {
2069  double tmp = work[k] / data (cidx (iidx+1)-1);
2070  work[k] = tmp;
2071  for (octave_idx_type i = cidx (iidx);
2072  i < cidx (iidx+1)-1; i++)
2073  {
2074  octave_idx_type idx2 = ridx (i);
2075  work[idx2] = work[idx2] - tmp * data (i);
2076  }
2077  }
2078  }
2079  double atmp = 0;
2080  for (octave_idx_type i = 0; i < j+1; i++)
2081  {
2082  atmp += fabs (work[i]);
2083  work[i] = 0.;
2084  }
2085  if (atmp > ainvnorm)
2086  ainvnorm = atmp;
2087  }
2088  rcond = 1. / ainvnorm / anorm;
2089  }
2090  }
2091  else
2092  {
2093  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2094  retval.resize (nc, b_nc);
2095 
2096  for (octave_idx_type j = 0; j < b_nc; j++)
2097  {
2098  for (octave_idx_type i = 0; i < nr; i++)
2099  cwork[i] = b(i, j);
2100  for (octave_idx_type i = nr; i < nc; i++)
2101  cwork[i] = 0.;
2102 
2103  for (octave_idx_type k = nc-1; k >= 0; k--)
2104  {
2105  if (cwork[k] != 0.)
2106  {
2107  if (ridx (cidx (k+1)-1) != k
2108  || data (cidx (k+1)-1) == 0.)
2109  {
2110  err = -2;
2111  goto triangular_error;
2112  }
2113 
2114  Complex tmp = cwork[k] / data (cidx (k+1)-1);
2115  cwork[k] = tmp;
2116  for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
2117  {
2118  octave_idx_type iidx = ridx (i);
2119  cwork[iidx] = cwork[iidx] - tmp * data (i);
2120  }
2121  }
2122  }
2123 
2124  for (octave_idx_type i = 0; i < nc; i++)
2125  retval.xelem (i, j) = cwork[i];
2126  }
2127 
2128  if (calc_cond)
2129  {
2130  // Calculation of 1-norm of inv(*this)
2131  OCTAVE_LOCAL_BUFFER (double, work, nm);
2132  for (octave_idx_type i = 0; i < nm; i++)
2133  work[i] = 0.;
2134 
2135  for (octave_idx_type j = 0; j < nr; j++)
2136  {
2137  work[j] = 1.;
2138 
2139  for (octave_idx_type k = j; k >= 0; k--)
2140  {
2141  if (work[k] != 0.)
2142  {
2143  double tmp = work[k] / data (cidx (k+1)-1);
2144  work[k] = tmp;
2145  for (octave_idx_type i = cidx (k);
2146  i < cidx (k+1)-1; i++)
2147  {
2148  octave_idx_type iidx = ridx (i);
2149  work[iidx] = work[iidx] - tmp * data (i);
2150  }
2151  }
2152  }
2153  double atmp = 0;
2154  for (octave_idx_type i = 0; i < j+1; i++)
2155  {
2156  atmp += fabs (work[i]);
2157  work[i] = 0.;
2158  }
2159  if (atmp > ainvnorm)
2160  ainvnorm = atmp;
2161  }
2162  rcond = 1. / ainvnorm / anorm;
2163  }
2164  }
2165 
2166  triangular_error:
2167  if (err != 0)
2168  {
2169  if (sing_handler)
2170  {
2171  sing_handler (rcond);
2172  mattype.mark_as_rectangular ();
2173  }
2174  else
2175  octave::warn_singular_matrix (rcond);
2176  }
2177 
2178  volatile double rcond_plus_one = rcond + 1.0;
2179 
2180  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
2181  {
2182  err = -2;
2183 
2184  if (sing_handler)
2185  {
2186  sing_handler (rcond);
2187  mattype.mark_as_rectangular ();
2188  }
2189  else
2190  octave::warn_singular_matrix (rcond);
2191  }
2192  }
2193 
2194  return retval;
2195 }
2196 
2197 SparseComplexMatrix
2198 SparseMatrix::utsolve (MatrixType& mattype, const SparseComplexMatrix& b,
2199  octave_idx_type& err, double& rcond,
2200  solve_singularity_handler sing_handler,
2201  bool calc_cond) const
2202 {
2203  SparseComplexMatrix retval;
2204 
2205  octave_idx_type nr = rows ();
2206  octave_idx_type nc = cols ();
2207  octave_idx_type nm = (nc > nr ? nc : nr);
2208  err = 0;
2209 
2210  if (nr != b.rows ())
2211  (*current_liboctave_error_handler)
2212  ("matrix dimension mismatch solution of linear equations");
2213 
2214  if (nr == 0 || nc == 0 || b.cols () == 0)
2215  retval = SparseComplexMatrix (nc, b.cols ());
2216  else
2217  {
2218  // Print spparms("spumoni") info if requested
2219  int typ = mattype.type ();
2220  mattype.info ();
2221 
2222  if (typ != MatrixType::Permuted_Upper && typ != MatrixType::Upper)
2223  (*current_liboctave_error_handler) ("incorrect matrix type");
2224 
2225  double anorm = 0.;
2226  double ainvnorm = 0.;
2227  rcond = 1.;
2228 
2229  if (calc_cond)
2230  {
2231  // Calculate the 1-norm of matrix for rcond calculation
2232  for (octave_idx_type j = 0; j < nc; j++)
2233  {
2234  double atmp = 0.;
2235  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2236  atmp += fabs (data (i));
2237  if (atmp > anorm)
2238  anorm = atmp;
2239  }
2240  }
2241 
2242  octave_idx_type b_nc = b.cols ();
2243  octave_idx_type b_nz = b.nnz ();
2244  retval = SparseComplexMatrix (nc, b_nc, b_nz);
2245  retval.xcidx (0) = 0;
2246  octave_idx_type ii = 0;
2247  octave_idx_type x_nz = b_nz;
2248 
2249  if (typ == MatrixType::Permuted_Upper)
2250  {
2251  octave_idx_type *perm = mattype.triangular_perm ();
2252  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2253 
2254  OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc);
2255  for (octave_idx_type i = 0; i < nc; i++)
2256  rperm[perm[i]] = i;
2257 
2258  for (octave_idx_type j = 0; j < b_nc; j++)
2259  {
2260  for (octave_idx_type i = 0; i < nm; i++)
2261  cwork[i] = 0.;
2262  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
2263  cwork[b.ridx (i)] = b.data (i);
2264 
2265  for (octave_idx_type k = nc-1; k >= 0; k--)
2266  {
2267  octave_idx_type kidx = perm[k];
2268 
2269  if (cwork[k] != 0.)
2270  {
2271  if (ridx (cidx (kidx+1)-1) != k
2272  || data (cidx (kidx+1)-1) == 0.)
2273  {
2274  err = -2;
2275  goto triangular_error;
2276  }
2277 
2278  Complex tmp = cwork[k] / data (cidx (kidx+1)-1);
2279  cwork[k] = tmp;
2280  for (octave_idx_type i = cidx (kidx);
2281  i < cidx (kidx+1)-1; i++)
2282  {
2283  octave_idx_type iidx = ridx (i);
2284  cwork[iidx] = cwork[iidx] - tmp * data (i);
2285  }
2286  }
2287  }
2288 
2289  // Count nonzeros in work vector and adjust space in
2290  // retval if needed
2291  octave_idx_type new_nnz = 0;
2292  for (octave_idx_type i = 0; i < nc; i++)
2293  if (cwork[i] != 0.)
2294  new_nnz++;
2295 
2296  if (ii + new_nnz > x_nz)
2297  {
2298  // Resize the sparse matrix
2299  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
2300  retval.change_capacity (sz);
2301  x_nz = sz;
2302  }
2303 
2304  for (octave_idx_type i = 0; i < nc; i++)
2305  if (cwork[rperm[i]] != 0.)
2306  {
2307  retval.xridx (ii) = i;
2308  retval.xdata (ii++) = cwork[rperm[i]];
2309  }
2310  retval.xcidx (j+1) = ii;
2311  }
2312 
2313  retval.maybe_compress ();
2314 
2315  if (calc_cond)
2316  {
2317  // Calculation of 1-norm of inv(*this)
2318  OCTAVE_LOCAL_BUFFER (double, work, nm);
2319  for (octave_idx_type i = 0; i < nm; i++)
2320  work[i] = 0.;
2321 
2322  for (octave_idx_type j = 0; j < nr; j++)
2323  {
2324  work[j] = 1.;
2325 
2326  for (octave_idx_type k = j; k >= 0; k--)
2327  {
2328  octave_idx_type iidx = perm[k];
2329 
2330  if (work[k] != 0.)
2331  {
2332  double tmp = work[k] / data (cidx (iidx+1)-1);
2333  work[k] = tmp;
2334  for (octave_idx_type i = cidx (iidx);
2335  i < cidx (iidx+1)-1; i++)
2336  {
2337  octave_idx_type idx2 = ridx (i);
2338  work[idx2] = work[idx2] - tmp * data (i);
2339  }
2340  }
2341  }
2342  double atmp = 0;
2343  for (octave_idx_type i = 0; i < j+1; i++)
2344  {
2345  atmp += fabs (work[i]);
2346  work[i] = 0.;
2347  }
2348  if (atmp > ainvnorm)
2349  ainvnorm = atmp;
2350  }
2351  rcond = 1. / ainvnorm / anorm;
2352  }
2353  }
2354  else
2355  {
2356  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
2357 
2358  for (octave_idx_type j = 0; j < b_nc; j++)
2359  {
2360  for (octave_idx_type i = 0; i < nm; i++)
2361  cwork[i] = 0.;
2362  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
2363  cwork[b.ridx (i)] = b.data (i);
2364 
2365  for (octave_idx_type k = nc-1; k >= 0; k--)
2366  {
2367  if (cwork[k] != 0.)
2368  {
2369  if (ridx (cidx (k+1)-1) != k
2370  || data (cidx (k+1)-1) == 0.)
2371  {
2372  err = -2;
2373  goto triangular_error;
2374  }
2375 
2376  Complex tmp = cwork[k] / data (cidx (k+1)-1);
2377  cwork[k] = tmp;
2378  for (octave_idx_type i = cidx (k); i < cidx (k+1)-1; i++)
2379  {
2380  octave_idx_type iidx = ridx (i);
2381  cwork[iidx] = cwork[iidx] - tmp * data (i);
2382  }
2383  }
2384  }
2385 
2386  // Count nonzeros in work vector and adjust space in
2387  // retval if needed
2388  octave_idx_type new_nnz = 0;
2389  for (octave_idx_type i = 0; i < nc; i++)
2390  if (cwork[i] != 0.)
2391  new_nnz++;
2392 
2393  if (ii + new_nnz > x_nz)
2394  {
2395  // Resize the sparse matrix
2396  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
2397  retval.change_capacity (sz);
2398  x_nz = sz;
2399  }
2400 
2401  for (octave_idx_type i = 0; i < nc; i++)
2402  if (cwork[i] != 0.)
2403  {
2404  retval.xridx (ii) = i;
2405  retval.xdata (ii++) = cwork[i];
2406  }
2407  retval.xcidx (j+1) = ii;
2408  }
2409 
2410  retval.maybe_compress ();
2411 
2412  if (calc_cond)
2413  {
2414  // Calculation of 1-norm of inv(*this)
2415  OCTAVE_LOCAL_BUFFER (double, work, nm);
2416  for (octave_idx_type i = 0; i < nm; i++)
2417  work[i] = 0.;
2418 
2419  for (octave_idx_type j = 0; j < nr; j++)
2420  {
2421  work[j] = 1.;
2422 
2423  for (octave_idx_type k = j; k >= 0; k--)
2424  {
2425  if (work[k] != 0.)
2426  {
2427  double tmp = work[k] / data (cidx (k+1)-1);
2428  work[k] = tmp;
2429  for (octave_idx_type i = cidx (k);
2430  i < cidx (k+1)-1; i++)
2431  {
2432  octave_idx_type iidx = ridx (i);
2433  work[iidx] = work[iidx] - tmp * data (i);
2434  }
2435  }
2436  }
2437  double atmp = 0;
2438  for (octave_idx_type i = 0; i < j+1; i++)
2439  {
2440  atmp += fabs (work[i]);
2441  work[i] = 0.;
2442  }
2443  if (atmp > ainvnorm)
2444  ainvnorm = atmp;
2445  }
2446  rcond = 1. / ainvnorm / anorm;
2447  }
2448  }
2449 
2450  triangular_error:
2451  if (err != 0)
2452  {
2453  if (sing_handler)
2454  {
2455  sing_handler (rcond);
2456  mattype.mark_as_rectangular ();
2457  }
2458  else
2459  octave::warn_singular_matrix (rcond);
2460  }
2461 
2462  volatile double rcond_plus_one = rcond + 1.0;
2463 
2464  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
2465  {
2466  err = -2;
2467 
2468  if (sing_handler)
2469  {
2470  sing_handler (rcond);
2471  mattype.mark_as_rectangular ();
2472  }
2473  else
2474  octave::warn_singular_matrix (rcond);
2475  }
2476  }
2477 
2478  return retval;
2479 }
2480 
2481 Matrix
2482 SparseMatrix::ltsolve (MatrixType& mattype, const Matrix& b,
2483  octave_idx_type& err, double& rcond,
2484  solve_singularity_handler sing_handler,
2485  bool calc_cond) const
2486 {
2487  Matrix retval;
2488 
2489  octave_idx_type nr = rows ();
2490  octave_idx_type nc = cols ();
2491  octave_idx_type nm = (nc > nr ? nc : nr);
2492  err = 0;
2493 
2494  if (nr != b.rows ())
2495  (*current_liboctave_error_handler)
2496  ("matrix dimension mismatch solution of linear equations");
2497 
2498  if (nr == 0 || nc == 0 || b.cols () == 0)
2499  retval = Matrix (nc, b.cols (), 0.0);
2500  else
2501  {
2502  // Print spparms("spumoni") info if requested
2503  int typ = mattype.type ();
2504  mattype.info ();
2505 
2506  if (typ != MatrixType::Permuted_Lower && typ != MatrixType::Lower)
2507  (*current_liboctave_error_handler) ("incorrect matrix type");
2508 
2509  double anorm = 0.;
2510  double ainvnorm = 0.;
2511  octave_idx_type b_nc = b.cols ();
2512  rcond = 1.;
2513 
2514  if (calc_cond)
2515  {
2516  // Calculate the 1-norm of matrix for rcond calculation
2517  for (octave_idx_type j = 0; j < nc; j++)
2518  {
2519  double atmp = 0.;
2520  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2521  atmp += fabs (data (i));
2522  if (atmp > anorm)
2523  anorm = atmp;
2524  }
2525  }
2526 
2527  if (typ == MatrixType::Permuted_Lower)
2528  {
2529  retval.resize (nc, b_nc);
2530  OCTAVE_LOCAL_BUFFER (double, work, nm);
2531  octave_idx_type *perm = mattype.triangular_perm ();
2532 
2533  for (octave_idx_type j = 0; j < b_nc; j++)
2534  {
2535  if (nc > nr)
2536  for (octave_idx_type i = 0; i < nm; i++)
2537  work[i] = 0.;
2538  for (octave_idx_type i = 0; i < nr; i++)
2539  work[perm[i]] = b(i, j);
2540 
2541  for (octave_idx_type k = 0; k < nc; k++)
2542  {
2543  if (work[k] != 0.)
2544  {
2545  octave_idx_type minr = nr;
2546  octave_idx_type mini = 0;
2547 
2548  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
2549  if (perm[ridx (i)] < minr)
2550  {
2551  minr = perm[ridx (i)];
2552  mini = i;
2553  }
2554 
2555  if (minr != k || data (mini) == 0)
2556  {
2557  err = -2;
2558  goto triangular_error;
2559  }
2560 
2561  double tmp = work[k] / data (mini);
2562  work[k] = tmp;
2563  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
2564  {
2565  if (i == mini)
2566  continue;
2567 
2568  octave_idx_type iidx = perm[ridx (i)];
2569  work[iidx] = work[iidx] - tmp * data (i);
2570  }
2571  }
2572  }
2573 
2574  for (octave_idx_type i = 0; i < nc; i++)
2575  retval(i, j) = work[i];
2576  }
2577 
2578  if (calc_cond)
2579  {
2580  // Calculation of 1-norm of inv(*this)
2581  for (octave_idx_type i = 0; i < nm; i++)
2582  work[i] = 0.;
2583 
2584  for (octave_idx_type j = 0; j < nr; j++)
2585  {
2586  work[j] = 1.;
2587 
2588  for (octave_idx_type k = 0; k < nc; k++)
2589  {
2590  if (work[k] != 0.)
2591  {
2592  octave_idx_type minr = nr;
2593  octave_idx_type mini = 0;
2594 
2595  for (octave_idx_type i = cidx (k);
2596  i < cidx (k+1); i++)
2597  if (perm[ridx (i)] < minr)
2598  {
2599  minr = perm[ridx (i)];
2600  mini = i;
2601  }
2602 
2603  double tmp = work[k] / data (mini);
2604  work[k] = tmp;
2605  for (octave_idx_type i = cidx (k);
2606  i < cidx (k+1); i++)
2607  {
2608  if (i == mini)
2609  continue;
2610 
2611  octave_idx_type iidx = perm[ridx (i)];
2612  work[iidx] = work[iidx] - tmp * data (i);
2613  }
2614  }
2615  }
2616 
2617  double atmp = 0;
2618  for (octave_idx_type i = j; i < nc; i++)
2619  {
2620  atmp += fabs (work[i]);
2621  work[i] = 0.;
2622  }
2623  if (atmp > ainvnorm)
2624  ainvnorm = atmp;
2625  }
2626  rcond = 1. / ainvnorm / anorm;
2627  }
2628  }
2629  else
2630  {
2631  OCTAVE_LOCAL_BUFFER (double, work, nm);
2632  retval.resize (nc, b_nc, 0.);
2633 
2634  for (octave_idx_type j = 0; j < b_nc; j++)
2635  {
2636  for (octave_idx_type i = 0; i < nr; i++)
2637  work[i] = b(i, j);
2638  for (octave_idx_type i = nr; i < nc; i++)
2639  work[i] = 0.;
2640  for (octave_idx_type k = 0; k < nc; k++)
2641  {
2642  if (work[k] != 0.)
2643  {
2644  if (ridx (cidx (k)) != k || data (cidx (k)) == 0.)
2645  {
2646  err = -2;
2647  goto triangular_error;
2648  }
2649 
2650  double tmp = work[k] / data (cidx (k));
2651  work[k] = tmp;
2652  for (octave_idx_type i = cidx (k)+1;
2653  i < cidx (k+1); i++)
2654  {
2655  octave_idx_type iidx = ridx (i);
2656  work[iidx] = work[iidx] - tmp * data (i);
2657  }
2658  }
2659  }
2660 
2661  for (octave_idx_type i = 0; i < nc; i++)
2662  retval.xelem (i, j) = work[i];
2663  }
2664 
2665  if (calc_cond)
2666  {
2667  // Calculation of 1-norm of inv(*this)
2668  for (octave_idx_type i = 0; i < nm; i++)
2669  work[i] = 0.;
2670 
2671  for (octave_idx_type j = 0; j < nr; j++)
2672  {
2673  work[j] = 1.;
2674 
2675  for (octave_idx_type k = j; k < nc; k++)
2676  {
2677 
2678  if (work[k] != 0.)
2679  {
2680  double tmp = work[k] / data (cidx (k));
2681  work[k] = tmp;
2682  for (octave_idx_type i = cidx (k)+1;
2683  i < cidx (k+1); i++)
2684  {
2685  octave_idx_type iidx = ridx (i);
2686  work[iidx] = work[iidx] - tmp * data (i);
2687  }
2688  }
2689  }
2690  double atmp = 0;
2691  for (octave_idx_type i = j; i < nc; i++)
2692  {
2693  atmp += fabs (work[i]);
2694  work[i] = 0.;
2695  }
2696  if (atmp > ainvnorm)
2697  ainvnorm = atmp;
2698  }
2699  rcond = 1. / ainvnorm / anorm;
2700  }
2701  }
2702 
2703  triangular_error:
2704  if (err != 0)
2705  {
2706  if (sing_handler)
2707  {
2708  sing_handler (rcond);
2709  mattype.mark_as_rectangular ();
2710  }
2711  else
2712  octave::warn_singular_matrix (rcond);
2713  }
2714 
2715  volatile double rcond_plus_one = rcond + 1.0;
2716 
2717  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
2718  {
2719  err = -2;
2720 
2721  if (sing_handler)
2722  {
2723  sing_handler (rcond);
2724  mattype.mark_as_rectangular ();
2725  }
2726  else
2727  octave::warn_singular_matrix (rcond);
2728  }
2729  }
2730 
2731  return retval;
2732 }
2733 
2734 SparseMatrix
2735 SparseMatrix::ltsolve (MatrixType& mattype, const SparseMatrix& b,
2736  octave_idx_type& err, double& rcond,
2737  solve_singularity_handler sing_handler,
2738  bool calc_cond) const
2739 {
2740  SparseMatrix retval;
2741 
2742  octave_idx_type nr = rows ();
2743  octave_idx_type nc = cols ();
2744  octave_idx_type nm = (nc > nr ? nc : nr);
2745  err = 0;
2746 
2747  if (nr != b.rows ())
2748  (*current_liboctave_error_handler)
2749  ("matrix dimension mismatch solution of linear equations");
2750 
2751  if (nr == 0 || nc == 0 || b.cols () == 0)
2752  retval = SparseMatrix (nc, b.cols ());
2753  else
2754  {
2755  // Print spparms("spumoni") info if requested
2756  int typ = mattype.type ();
2757  mattype.info ();
2758 
2759  if (typ != MatrixType::Permuted_Lower && typ != MatrixType::Lower)
2760  (*current_liboctave_error_handler) ("incorrect matrix type");
2761 
2762  double anorm = 0.;
2763  double ainvnorm = 0.;
2764  rcond = 1.;
2765 
2766  if (calc_cond)
2767  {
2768  // Calculate the 1-norm of matrix for rcond calculation
2769  for (octave_idx_type j = 0; j < nc; j++)
2770  {
2771  double atmp = 0.;
2772  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
2773  atmp += fabs (data (i));
2774  if (atmp > anorm)
2775  anorm = atmp;
2776  }
2777  }
2778 
2779  octave_idx_type b_nc = b.cols ();
2780  octave_idx_type b_nz = b.nnz ();
2781  retval = SparseMatrix (nc, b_nc, b_nz);
2782  retval.xcidx (0) = 0;
2783  octave_idx_type ii = 0;
2784  octave_idx_type x_nz = b_nz;
2785 
2786  if (typ == MatrixType::Permuted_Lower)
2787  {
2788  OCTAVE_LOCAL_BUFFER (double, work, nm);
2789  octave_idx_type *perm = mattype.triangular_perm ();
2790 
2791  for (octave_idx_type j = 0; j < b_nc; j++)
2792  {
2793  for (octave_idx_type i = 0; i < nm; i++)
2794  work[i] = 0.;
2795  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
2796  work[perm[b.ridx (i)]] = b.data (i);
2797 
2798  for (octave_idx_type k = 0; k < nc; k++)
2799  {
2800  if (work[k] != 0.)
2801  {
2802  octave_idx_type minr = nr;
2803  octave_idx_type mini = 0;
2804 
2805  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
2806  if (perm[ridx (i)] < minr)
2807  {
2808  minr = perm[ridx (i)];
2809  mini = i;
2810  }
2811 
2812  if (minr != k || data (mini) == 0)
2813  {
2814  err = -2;
2815  goto triangular_error;
2816  }
2817 
2818  double tmp = work[k] / data (mini);
2819  work[k] = tmp;
2820  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
2821  {
2822  if (i == mini)
2823  continue;
2824 
2825  octave_idx_type iidx = perm[ridx (i)];
2826  work[iidx] = work[iidx] - tmp * data (i);
2827  }
2828  }
2829  }
2830 
2831  // Count nonzeros in work vector and adjust space in
2832  // retval if needed
2833  octave_idx_type new_nnz = 0;
2834  for (octave_idx_type i = 0; i < nc; i++)
2835  if (work[i] != 0.)
2836  new_nnz++;
2837 
2838  if (ii + new_nnz > x_nz)
2839  {
2840  // Resize the sparse matrix
2841  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
2842  retval.change_capacity (sz);
2843  x_nz = sz;
2844  }
2845 
2846  for (octave_idx_type i = 0; i < nc; i++)
2847  if (work[i] != 0.)
2848  {
2849  retval.xridx (ii) = i;
2850  retval.xdata (ii++) = work[i];
2851  }
2852  retval.xcidx (j+1) = ii;
2853  }
2854 
2855  retval.maybe_compress ();
2856 
2857  if (calc_cond)
2858  {
2859  // Calculation of 1-norm of inv(*this)
2860  for (octave_idx_type i = 0; i < nm; i++)
2861  work[i] = 0.;
2862 
2863  for (octave_idx_type j = 0; j < nr; j++)
2864  {
2865  work[j] = 1.;
2866 
2867  for (octave_idx_type k = 0; k < nc; k++)
2868  {
2869  if (work[k] != 0.)
2870  {
2871  octave_idx_type minr = nr;
2872  octave_idx_type mini = 0;
2873 
2874  for (octave_idx_type i = cidx (k);
2875  i < cidx (k+1); i++)
2876  if (perm[ridx (i)] < minr)
2877  {
2878  minr = perm[ridx (i)];
2879  mini = i;
2880  }
2881 
2882  double tmp = work[k] / data (mini);
2883  work[k] = tmp;
2884  for (octave_idx_type i = cidx (k);
2885  i < cidx (k+1); i++)
2886  {
2887  if (i == mini)
2888  continue;
2889 
2890  octave_idx_type iidx = perm[ridx (i)];
2891  work[iidx] = work[iidx] - tmp * data (i);
2892  }
2893  }
2894  }
2895 
2896  double atmp = 0;
2897  for (octave_idx_type i = j; i < nr; i++)
2898  {
2899  atmp += fabs (work[i]);
2900  work[i] = 0.;
2901  }
2902  if (atmp > ainvnorm)
2903  ainvnorm = atmp;
2904  }
2905  rcond = 1. / ainvnorm / anorm;
2906  }
2907  }
2908  else
2909  {
2910  OCTAVE_LOCAL_BUFFER (double, work, nm);
2911 
2912  for (octave_idx_type j = 0; j < b_nc; j++)
2913  {
2914  for (octave_idx_type i = 0; i < nm; i++)
2915  work[i] = 0.;
2916  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
2917  work[b.ridx (i)] = b.data (i);
2918 
2919  for (octave_idx_type k = 0; k < nc; k++)
2920  {
2921  if (work[k] != 0.)
2922  {
2923  if (ridx (cidx (k)) != k || data (cidx (k)) == 0.)
2924  {
2925  err = -2;
2926  goto triangular_error;
2927  }
2928 
2929  double tmp = work[k] / data (cidx (k));
2930  work[k] = tmp;
2931  for (octave_idx_type i = cidx (k)+1; i < cidx (k+1); i++)
2932  {
2933  octave_idx_type iidx = ridx (i);
2934  work[iidx] = work[iidx] - tmp * data (i);
2935  }
2936  }
2937  }
2938 
2939  // Count nonzeros in work vector and adjust space in
2940  // retval if needed
2941  octave_idx_type new_nnz = 0;
2942  for (octave_idx_type i = 0; i < nc; i++)
2943  if (work[i] != 0.)
2944  new_nnz++;
2945 
2946  if (ii + new_nnz > x_nz)
2947  {
2948  // Resize the sparse matrix
2949  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
2950  retval.change_capacity (sz);
2951  x_nz = sz;
2952  }
2953 
2954  for (octave_idx_type i = 0; i < nc; i++)
2955  if (work[i] != 0.)
2956  {
2957  retval.xridx (ii) = i;
2958  retval.xdata (ii++) = work[i];
2959  }
2960  retval.xcidx (j+1) = ii;
2961  }
2962 
2963  retval.maybe_compress ();
2964 
2965  if (calc_cond)
2966  {
2967  // Calculation of 1-norm of inv(*this)
2968  for (octave_idx_type i = 0; i < nm; i++)
2969  work[i] = 0.;
2970 
2971  for (octave_idx_type j = 0; j < nr; j++)
2972  {
2973  work[j] = 1.;
2974 
2975  for (octave_idx_type k = j; k < nc; k++)
2976  {
2977 
2978  if (work[k] != 0.)
2979  {
2980  double tmp = work[k] / data (cidx (k));
2981  work[k] = tmp;
2982  for (octave_idx_type i = cidx (k)+1;
2983  i < cidx (k+1); i++)
2984  {
2985  octave_idx_type iidx = ridx (i);
2986  work[iidx] = work[iidx] - tmp * data (i);
2987  }
2988  }
2989  }
2990  double atmp = 0;
2991  for (octave_idx_type i = j; i < nc; i++)
2992  {
2993  atmp += fabs (work[i]);
2994  work[i] = 0.;
2995  }
2996  if (atmp > ainvnorm)
2997  ainvnorm = atmp;
2998  }
2999  rcond = 1. / ainvnorm / anorm;
3000  }
3001  }
3002 
3003  triangular_error:
3004  if (err != 0)
3005  {
3006  if (sing_handler)
3007  {
3008  sing_handler (rcond);
3009  mattype.mark_as_rectangular ();
3010  }
3011  else
3012  octave::warn_singular_matrix (rcond);
3013  }
3014 
3015  volatile double rcond_plus_one = rcond + 1.0;
3016 
3017  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
3018  {
3019  err = -2;
3020 
3021  if (sing_handler)
3022  {
3023  sing_handler (rcond);
3024  mattype.mark_as_rectangular ();
3025  }
3026  else
3027  octave::warn_singular_matrix (rcond);
3028  }
3029  }
3030 
3031  return retval;
3032 }
3033 
3034 ComplexMatrix
3035 SparseMatrix::ltsolve (MatrixType& mattype, const ComplexMatrix& b,
3036  octave_idx_type& err, double& rcond,
3037  solve_singularity_handler sing_handler,
3038  bool calc_cond) const
3039 {
3040  ComplexMatrix retval;
3041 
3042  octave_idx_type nr = rows ();
3043  octave_idx_type nc = cols ();
3044  octave_idx_type nm = (nc > nr ? nc : nr);
3045  err = 0;
3046 
3047  if (nr != b.rows ())
3048  (*current_liboctave_error_handler)
3049  ("matrix dimension mismatch solution of linear equations");
3050 
3051  if (nr == 0 || nc == 0 || b.cols () == 0)
3052  retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
3053  else
3054  {
3055  // Print spparms("spumoni") info if requested
3056  int typ = mattype.type ();
3057  mattype.info ();
3058 
3059  if (typ != MatrixType::Permuted_Lower && typ != MatrixType::Lower)
3060  (*current_liboctave_error_handler) ("incorrect matrix type");
3061 
3062  double anorm = 0.;
3063  double ainvnorm = 0.;
3064  octave_idx_type b_nc = b.cols ();
3065  rcond = 1.;
3066 
3067  if (calc_cond)
3068  {
3069  // Calculate the 1-norm of matrix for rcond calculation
3070  for (octave_idx_type j = 0; j < nc; j++)
3071  {
3072  double atmp = 0.;
3073  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3074  atmp += fabs (data (i));
3075  if (atmp > anorm)
3076  anorm = atmp;
3077  }
3078  }
3079 
3080  if (typ == MatrixType::Permuted_Lower)
3081  {
3082  retval.resize (nc, b_nc);
3083  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3084  octave_idx_type *perm = mattype.triangular_perm ();
3085 
3086  for (octave_idx_type j = 0; j < b_nc; j++)
3087  {
3088  for (octave_idx_type i = 0; i < nm; i++)
3089  cwork[i] = 0.;
3090  for (octave_idx_type i = 0; i < nr; i++)
3091  cwork[perm[i]] = b(i, j);
3092 
3093  for (octave_idx_type k = 0; k < nc; k++)
3094  {
3095  if (cwork[k] != 0.)
3096  {
3097  octave_idx_type minr = nr;
3098  octave_idx_type mini = 0;
3099 
3100  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3101  if (perm[ridx (i)] < minr)
3102  {
3103  minr = perm[ridx (i)];
3104  mini = i;
3105  }
3106 
3107  if (minr != k || data (mini) == 0)
3108  {
3109  err = -2;
3110  goto triangular_error;
3111  }
3112 
3113  Complex tmp = cwork[k] / data (mini);
3114  cwork[k] = tmp;
3115  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3116  {
3117  if (i == mini)
3118  continue;
3119 
3120  octave_idx_type iidx = perm[ridx (i)];
3121  cwork[iidx] = cwork[iidx] - tmp * data (i);
3122  }
3123  }
3124  }
3125 
3126  for (octave_idx_type i = 0; i < nc; i++)
3127  retval(i, j) = cwork[i];
3128  }
3129 
3130  if (calc_cond)
3131  {
3132  // Calculation of 1-norm of inv(*this)
3133  OCTAVE_LOCAL_BUFFER (double, work, nm);
3134  for (octave_idx_type i = 0; i < nm; i++)
3135  work[i] = 0.;
3136 
3137  for (octave_idx_type j = 0; j < nr; j++)
3138  {
3139  work[j] = 1.;
3140 
3141  for (octave_idx_type k = 0; k < nc; k++)
3142  {
3143  if (work[k] != 0.)
3144  {
3145  octave_idx_type minr = nr;
3146  octave_idx_type mini = 0;
3147 
3148  for (octave_idx_type i = cidx (k);
3149  i < cidx (k+1); i++)
3150  if (perm[ridx (i)] < minr)
3151  {
3152  minr = perm[ridx (i)];
3153  mini = i;
3154  }
3155 
3156  double tmp = work[k] / data (mini);
3157  work[k] = tmp;
3158  for (octave_idx_type i = cidx (k);
3159  i < cidx (k+1); i++)
3160  {
3161  if (i == mini)
3162  continue;
3163 
3164  octave_idx_type iidx = perm[ridx (i)];
3165  work[iidx] = work[iidx] - tmp * data (i);
3166  }
3167  }
3168  }
3169 
3170  double atmp = 0;
3171  for (octave_idx_type i = j; i < nc; i++)
3172  {
3173  atmp += fabs (work[i]);
3174  work[i] = 0.;
3175  }
3176  if (atmp > ainvnorm)
3177  ainvnorm = atmp;
3178  }
3179  rcond = 1. / ainvnorm / anorm;
3180  }
3181  }
3182  else
3183  {
3184  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3185  retval.resize (nc, b_nc, 0.);
3186 
3187  for (octave_idx_type j = 0; j < b_nc; j++)
3188  {
3189  for (octave_idx_type i = 0; i < nr; i++)
3190  cwork[i] = b(i, j);
3191  for (octave_idx_type i = nr; i < nc; i++)
3192  cwork[i] = 0.;
3193 
3194  for (octave_idx_type k = 0; k < nc; k++)
3195  {
3196  if (cwork[k] != 0.)
3197  {
3198  if (ridx (cidx (k)) != k || data (cidx (k)) == 0.)
3199  {
3200  err = -2;
3201  goto triangular_error;
3202  }
3203 
3204  Complex tmp = cwork[k] / data (cidx (k));
3205  cwork[k] = tmp;
3206  for (octave_idx_type i = cidx (k)+1; i < cidx (k+1); i++)
3207  {
3208  octave_idx_type iidx = ridx (i);
3209  cwork[iidx] = cwork[iidx] - tmp * data (i);
3210  }
3211  }
3212  }
3213 
3214  for (octave_idx_type i = 0; i < nc; i++)
3215  retval.xelem (i, j) = cwork[i];
3216  }
3217 
3218  if (calc_cond)
3219  {
3220  // Calculation of 1-norm of inv(*this)
3221  OCTAVE_LOCAL_BUFFER (double, work, nm);
3222  for (octave_idx_type i = 0; i < nm; i++)
3223  work[i] = 0.;
3224 
3225  for (octave_idx_type j = 0; j < nr; j++)
3226  {
3227  work[j] = 1.;
3228 
3229  for (octave_idx_type k = j; k < nc; k++)
3230  {
3231 
3232  if (work[k] != 0.)
3233  {
3234  double tmp = work[k] / data (cidx (k));
3235  work[k] = tmp;
3236  for (octave_idx_type i = cidx (k)+1;
3237  i < cidx (k+1); i++)
3238  {
3239  octave_idx_type iidx = ridx (i);
3240  work[iidx] = work[iidx] - tmp * data (i);
3241  }
3242  }
3243  }
3244  double atmp = 0;
3245  for (octave_idx_type i = j; i < nc; i++)
3246  {
3247  atmp += fabs (work[i]);
3248  work[i] = 0.;
3249  }
3250  if (atmp > ainvnorm)
3251  ainvnorm = atmp;
3252  }
3253  rcond = 1. / ainvnorm / anorm;
3254  }
3255  }
3256 
3257  triangular_error:
3258  if (err != 0)
3259  {
3260  if (sing_handler)
3261  {
3262  sing_handler (rcond);
3263  mattype.mark_as_rectangular ();
3264  }
3265  else
3266  octave::warn_singular_matrix (rcond);
3267  }
3268 
3269  volatile double rcond_plus_one = rcond + 1.0;
3270 
3271  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
3272  {
3273  err = -2;
3274 
3275  if (sing_handler)
3276  {
3277  sing_handler (rcond);
3278  mattype.mark_as_rectangular ();
3279  }
3280  else
3281  octave::warn_singular_matrix (rcond);
3282  }
3283  }
3284 
3285  return retval;
3286 }
3287 
3288 SparseComplexMatrix
3289 SparseMatrix::ltsolve (MatrixType& mattype, const SparseComplexMatrix& b,
3290  octave_idx_type& err, double& rcond,
3291  solve_singularity_handler sing_handler,
3292  bool calc_cond) const
3293 {
3294  SparseComplexMatrix retval;
3295 
3296  octave_idx_type nr = rows ();
3297  octave_idx_type nc = cols ();
3298  octave_idx_type nm = (nc > nr ? nc : nr);
3299  err = 0;
3300 
3301  if (nr != b.rows ())
3302  (*current_liboctave_error_handler)
3303  ("matrix dimension mismatch solution of linear equations");
3304 
3305  if (nr == 0 || nc == 0 || b.cols () == 0)
3306  retval = SparseComplexMatrix (nc, b.cols ());
3307  else
3308  {
3309  // Print spparms("spumoni") info if requested
3310  int typ = mattype.type ();
3311  mattype.info ();
3312 
3313  if (typ != MatrixType::Permuted_Lower && typ != MatrixType::Lower)
3314  (*current_liboctave_error_handler) ("incorrect matrix type");
3315 
3316  double anorm = 0.;
3317  double ainvnorm = 0.;
3318  rcond = 1.;
3319 
3320  if (calc_cond)
3321  {
3322  // Calculate the 1-norm of matrix for rcond calculation
3323  for (octave_idx_type j = 0; j < nc; j++)
3324  {
3325  double atmp = 0.;
3326  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3327  atmp += fabs (data (i));
3328  if (atmp > anorm)
3329  anorm = atmp;
3330  }
3331  }
3332 
3333  octave_idx_type b_nc = b.cols ();
3334  octave_idx_type b_nz = b.nnz ();
3335  retval = SparseComplexMatrix (nc, b_nc, b_nz);
3336  retval.xcidx (0) = 0;
3337  octave_idx_type ii = 0;
3338  octave_idx_type x_nz = b_nz;
3339 
3340  if (typ == MatrixType::Permuted_Lower)
3341  {
3342  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3343  octave_idx_type *perm = mattype.triangular_perm ();
3344 
3345  for (octave_idx_type j = 0; j < b_nc; j++)
3346  {
3347  for (octave_idx_type i = 0; i < nm; i++)
3348  cwork[i] = 0.;
3349  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
3350  cwork[perm[b.ridx (i)]] = b.data (i);
3351 
3352  for (octave_idx_type k = 0; k < nc; k++)
3353  {
3354  if (cwork[k] != 0.)
3355  {
3356  octave_idx_type minr = nr;
3357  octave_idx_type mini = 0;
3358 
3359  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3360  if (perm[ridx (i)] < minr)
3361  {
3362  minr = perm[ridx (i)];
3363  mini = i;
3364  }
3365 
3366  if (minr != k || data (mini) == 0)
3367  {
3368  err = -2;
3369  goto triangular_error;
3370  }
3371 
3372  Complex tmp = cwork[k] / data (mini);
3373  cwork[k] = tmp;
3374  for (octave_idx_type i = cidx (k); i < cidx (k+1); i++)
3375  {
3376  if (i == mini)
3377  continue;
3378 
3379  octave_idx_type iidx = perm[ridx (i)];
3380  cwork[iidx] = cwork[iidx] - tmp * data (i);
3381  }
3382  }
3383  }
3384 
3385  // Count nonzeros in work vector and adjust space in
3386  // retval if needed
3387  octave_idx_type new_nnz = 0;
3388  for (octave_idx_type i = 0; i < nc; i++)
3389  if (cwork[i] != 0.)
3390  new_nnz++;
3391 
3392  if (ii + new_nnz > x_nz)
3393  {
3394  // Resize the sparse matrix
3395  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
3396  retval.change_capacity (sz);
3397  x_nz = sz;
3398  }
3399 
3400  for (octave_idx_type i = 0; i < nc; i++)
3401  if (cwork[i] != 0.)
3402  {
3403  retval.xridx (ii) = i;
3404  retval.xdata (ii++) = cwork[i];
3405  }
3406  retval.xcidx (j+1) = ii;
3407  }
3408 
3409  retval.maybe_compress ();
3410 
3411  if (calc_cond)
3412  {
3413  // Calculation of 1-norm of inv(*this)
3414  OCTAVE_LOCAL_BUFFER (double, work, nm);
3415  for (octave_idx_type i = 0; i < nm; i++)
3416  work[i] = 0.;
3417 
3418  for (octave_idx_type j = 0; j < nr; j++)
3419  {
3420  work[j] = 1.;
3421 
3422  for (octave_idx_type k = 0; k < nc; k++)
3423  {
3424  if (work[k] != 0.)
3425  {
3426  octave_idx_type minr = nr;
3427  octave_idx_type mini = 0;
3428 
3429  for (octave_idx_type i = cidx (k);
3430  i < cidx (k+1); i++)
3431  if (perm[ridx (i)] < minr)
3432  {
3433  minr = perm[ridx (i)];
3434  mini = i;
3435  }
3436 
3437  double tmp = work[k] / data (mini);
3438  work[k] = tmp;
3439  for (octave_idx_type i = cidx (k);
3440  i < cidx (k+1); i++)
3441  {
3442  if (i == mini)
3443  continue;
3444 
3445  octave_idx_type iidx = perm[ridx (i)];
3446  work[iidx] = work[iidx] - tmp * data (i);
3447  }
3448  }
3449  }
3450 
3451  double atmp = 0;
3452  for (octave_idx_type i = j; i < nc; i++)
3453  {
3454  atmp += fabs (work[i]);
3455  work[i] = 0.;
3456  }
3457  if (atmp > ainvnorm)
3458  ainvnorm = atmp;
3459  }
3460  rcond = 1. / ainvnorm / anorm;
3461  }
3462  }
3463  else
3464  {
3465  OCTAVE_LOCAL_BUFFER (Complex, cwork, nm);
3466 
3467  for (octave_idx_type j = 0; j < b_nc; j++)
3468  {
3469  for (octave_idx_type i = 0; i < nm; i++)
3470  cwork[i] = 0.;
3471  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
3472  cwork[b.ridx (i)] = b.data (i);
3473 
3474  for (octave_idx_type k = 0; k < nc; k++)
3475  {
3476  if (cwork[k] != 0.)
3477  {
3478  if (ridx (cidx (k)) != k || data (cidx (k)) == 0.)
3479  {
3480  err = -2;
3481  goto triangular_error;
3482  }
3483 
3484  Complex tmp = cwork[k] / data (cidx (k));
3485  cwork[k] = tmp;
3486  for (octave_idx_type i = cidx (k)+1; i < cidx (k+1); i++)
3487  {
3488  octave_idx_type iidx = ridx (i);
3489  cwork[iidx] = cwork[iidx] - tmp * data (i);
3490  }
3491  }
3492  }
3493 
3494  // Count nonzeros in work vector and adjust space in
3495  // retval if needed
3496  octave_idx_type new_nnz = 0;
3497  for (octave_idx_type i = 0; i < nc; i++)
3498  if (cwork[i] != 0.)
3499  new_nnz++;
3500 
3501  if (ii + new_nnz > x_nz)
3502  {
3503  // Resize the sparse matrix
3504  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
3505  retval.change_capacity (sz);
3506  x_nz = sz;
3507  }
3508 
3509  for (octave_idx_type i = 0; i < nc; i++)
3510  if (cwork[i] != 0.)
3511  {
3512  retval.xridx (ii) = i;
3513  retval.xdata (ii++) = cwork[i];
3514  }
3515  retval.xcidx (j+1) = ii;
3516  }
3517 
3518  retval.maybe_compress ();
3519 
3520  if (calc_cond)
3521  {
3522  // Calculation of 1-norm of inv(*this)
3523  OCTAVE_LOCAL_BUFFER (double, work, nm);
3524  for (octave_idx_type i = 0; i < nm; i++)
3525  work[i] = 0.;
3526 
3527  for (octave_idx_type j = 0; j < nr; j++)
3528  {
3529  work[j] = 1.;
3530 
3531  for (octave_idx_type k = j; k < nc; k++)
3532  {
3533 
3534  if (work[k] != 0.)
3535  {
3536  double tmp = work[k] / data (cidx (k));
3537  work[k] = tmp;
3538  for (octave_idx_type i = cidx (k)+1;
3539  i < cidx (k+1); i++)
3540  {
3541  octave_idx_type iidx = ridx (i);
3542  work[iidx] = work[iidx] - tmp * data (i);
3543  }
3544  }
3545  }
3546  double atmp = 0;
3547  for (octave_idx_type i = j; i < nc; i++)
3548  {
3549  atmp += fabs (work[i]);
3550  work[i] = 0.;
3551  }
3552  if (atmp > ainvnorm)
3553  ainvnorm = atmp;
3554  }
3555  rcond = 1. / ainvnorm / anorm;
3556  }
3557  }
3558 
3559  triangular_error:
3560  if (err != 0)
3561  {
3562  if (sing_handler)
3563  {
3564  sing_handler (rcond);
3565  mattype.mark_as_rectangular ();
3566  }
3567  else
3568  octave::warn_singular_matrix (rcond);
3569  }
3570 
3571  volatile double rcond_plus_one = rcond + 1.0;
3572 
3573  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
3574  {
3575  err = -2;
3576 
3577  if (sing_handler)
3578  {
3579  sing_handler (rcond);
3580  mattype.mark_as_rectangular ();
3581  }
3582  else
3583  octave::warn_singular_matrix (rcond);
3584  }
3585  }
3586 
3587  return retval;
3588 }
3589 
3590 Matrix
3591 SparseMatrix::trisolve (MatrixType& mattype, const Matrix& b,
3592  octave_idx_type& err, double& rcond,
3593  solve_singularity_handler sing_handler,
3594  bool calc_cond) const
3595 {
3596  Matrix retval;
3597 
3598  octave_idx_type nr = rows ();
3599  octave_idx_type nc = cols ();
3600  err = 0;
3601 
3602  if (nr != nc || nr != b.rows ())
3603  (*current_liboctave_error_handler)
3604  ("matrix dimension mismatch solution of linear equations");
3605 
3606  if (nr == 0 || b.cols () == 0)
3607  retval = Matrix (nc, b.cols (), 0.0);
3608  else if (calc_cond)
3609  (*current_liboctave_error_handler)
3610  ("calculation of condition number not implemented");
3611  else
3612  {
3613  // Print spparms("spumoni") info if requested
3614  volatile int typ = mattype.type ();
3615  mattype.info ();
3616 
3617  if (typ == MatrixType::Tridiagonal_Hermitian)
3618  {
3619  OCTAVE_LOCAL_BUFFER (double, D, nr);
3620  OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
3621 
3622  if (mattype.is_dense ())
3623  {
3624  octave_idx_type ii = 0;
3625 
3626  for (octave_idx_type j = 0; j < nc-1; j++)
3627  {
3628  D[j] = data (ii++);
3629  DL[j] = data (ii);
3630  ii += 2;
3631  }
3632  D[nc-1] = data (ii);
3633  }
3634  else
3635  {
3636  D[0] = 0.;
3637  for (octave_idx_type i = 0; i < nr - 1; i++)
3638  {
3639  D[i+1] = 0.;
3640  DL[i] = 0.;
3641  }
3642 
3643  for (octave_idx_type j = 0; j < nc; j++)
3644  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3645  {
3646  if (ridx (i) == j)
3647  D[j] = data (i);
3648  else if (ridx (i) == j + 1)
3649  DL[j] = data (i);
3650  }
3651  }
3652 
3653  F77_INT tmp_nr = octave::to_f77_int (nr);
3654 
3655  F77_INT b_nr = octave::to_f77_int (b.rows ());
3656  F77_INT b_nc = octave::to_f77_int (b.cols ());
3657 
3658  retval = b;
3659  double *result = retval.fortran_vec ();
3660 
3661  F77_INT tmp_err = 0;
3662 
3663  F77_XFCN (dptsv, DPTSV, (tmp_nr, b_nc, D, DL, result,
3664  b_nr, tmp_err));
3665 
3666  err = tmp_err;
3667 
3668  if (err != 0)
3669  {
3670  err = 0;
3671  mattype.mark_as_unsymmetric ();
3672  typ = MatrixType::Tridiagonal;
3673  }
3674  else
3675  rcond = 1.;
3676  }
3677 
3678  if (typ == MatrixType::Tridiagonal)
3679  {
3680  OCTAVE_LOCAL_BUFFER (double, DU, nr - 1);
3681  OCTAVE_LOCAL_BUFFER (double, D, nr);
3682  OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
3683 
3684  if (mattype.is_dense ())
3685  {
3686  octave_idx_type ii = 0;
3687 
3688  for (octave_idx_type j = 0; j < nc-1; j++)
3689  {
3690  D[j] = data (ii++);
3691  DL[j] = data (ii++);
3692  DU[j] = data (ii++);
3693  }
3694  D[nc-1] = data (ii);
3695  }
3696  else
3697  {
3698  D[0] = 0.;
3699  for (octave_idx_type i = 0; i < nr - 1; i++)
3700  {
3701  D[i+1] = 0.;
3702  DL[i] = 0.;
3703  DU[i] = 0.;
3704  }
3705 
3706  for (octave_idx_type j = 0; j < nc; j++)
3707  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3708  {
3709  if (ridx (i) == j)
3710  D[j] = data (i);
3711  else if (ridx (i) == j + 1)
3712  DL[j] = data (i);
3713  else if (ridx (i) == j - 1)
3714  DU[j-1] = data (i);
3715  }
3716  }
3717 
3718  F77_INT tmp_nr = octave::to_f77_int (nr);
3719 
3720  F77_INT b_nr = octave::to_f77_int (b.rows ());
3721  F77_INT b_nc = octave::to_f77_int (b.cols ());
3722 
3723  retval = b;
3724  double *result = retval.fortran_vec ();
3725 
3726  F77_INT tmp_err = 0;
3727 
3728  F77_XFCN (dgtsv, DGTSV, (tmp_nr, b_nc, DL, D, DU, result,
3729  b_nr, tmp_err));
3730 
3731  err = tmp_err;
3732 
3733  if (err != 0)
3734  {
3735  rcond = 0.;
3736  err = -2;
3737 
3738  if (sing_handler)
3739  {
3740  sing_handler (rcond);
3741  mattype.mark_as_rectangular ();
3742  }
3743  else
3744  octave::warn_singular_matrix ();
3745  }
3746  else
3747  rcond = 1.;
3748  }
3749  else if (typ != MatrixType::Tridiagonal_Hermitian)
3750  (*current_liboctave_error_handler) ("incorrect matrix type");
3751  }
3752 
3753  return retval;
3754 }
3755 
3756 SparseMatrix
3757 SparseMatrix::trisolve (MatrixType& mattype, const SparseMatrix& b,
3758  octave_idx_type& err, double& rcond,
3759  solve_singularity_handler sing_handler,
3760  bool calc_cond) const
3761 {
3762  SparseMatrix retval;
3763 
3764  octave_idx_type nr = rows ();
3765  octave_idx_type nc = cols ();
3766  err = 0;
3767 
3768  if (nr != nc || nr != b.rows ())
3769  (*current_liboctave_error_handler)
3770  ("matrix dimension mismatch solution of linear equations");
3771 
3772  if (nr == 0 || b.cols () == 0)
3773  retval = SparseMatrix (nc, b.cols ());
3774  else if (calc_cond)
3775  (*current_liboctave_error_handler)
3776  ("calculation of condition number not implemented");
3777  else
3778  {
3779  // Print spparms("spumoni") info if requested
3780  int typ = mattype.type ();
3781  mattype.info ();
3782 
3783  // Note can't treat symmetric case as there is no dpttrf function
3784  if (typ == MatrixType::Tridiagonal
3785  || typ == MatrixType::Tridiagonal_Hermitian)
3786  {
3787  OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2);
3788  OCTAVE_LOCAL_BUFFER (double, DU, nr - 1);
3789  OCTAVE_LOCAL_BUFFER (double, D, nr);
3790  OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
3791  Array<F77_INT> ipvt (dim_vector (nr, 1));
3792  F77_INT *pipvt = ipvt.fortran_vec ();
3793 
3794  if (mattype.is_dense ())
3795  {
3796  octave_idx_type ii = 0;
3797 
3798  for (octave_idx_type j = 0; j < nc-1; j++)
3799  {
3800  D[j] = data (ii++);
3801  DL[j] = data (ii++);
3802  DU[j] = data (ii++);
3803  }
3804  D[nc-1] = data (ii);
3805  }
3806  else
3807  {
3808  D[0] = 0.;
3809  for (octave_idx_type i = 0; i < nr - 1; i++)
3810  {
3811  D[i+1] = 0.;
3812  DL[i] = 0.;
3813  DU[i] = 0.;
3814  }
3815 
3816  for (octave_idx_type j = 0; j < nc; j++)
3817  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3818  {
3819  if (ridx (i) == j)
3820  D[j] = data (i);
3821  else if (ridx (i) == j + 1)
3822  DL[j] = data (i);
3823  else if (ridx (i) == j - 1)
3824  DU[j-1] = data (i);
3825  }
3826  }
3827 
3828  F77_INT tmp_nr = octave::to_f77_int (nr);
3829 
3830  F77_INT tmp_err = 0;
3831 
3832  F77_XFCN (dgttrf, DGTTRF, (tmp_nr, DL, D, DU, DU2, pipvt, tmp_err));
3833 
3834  if (err != 0)
3835  {
3836  rcond = 0.0;
3837  err = -2;
3838 
3839  if (sing_handler)
3840  {
3841  sing_handler (rcond);
3842  mattype.mark_as_rectangular ();
3843  }
3844  else
3845  octave::warn_singular_matrix ();
3846  }
3847  else
3848  {
3849  rcond = 1.0;
3850  char job = 'N';
3851  volatile octave_idx_type x_nz = b.nnz ();
3852  octave_idx_type b_nc = b.cols ();
3853  retval = SparseMatrix (nr, b_nc, x_nz);
3854  retval.xcidx (0) = 0;
3855  volatile octave_idx_type ii = 0;
3856 
3857  OCTAVE_LOCAL_BUFFER (double, work, nr);
3858 
3859  for (volatile octave_idx_type j = 0; j < b_nc; j++)
3860  {
3861  for (octave_idx_type i = 0; i < nr; i++)
3862  work[i] = 0.;
3863  for (octave_idx_type i = b.cidx (j); i < b.cidx (j+1); i++)
3864  work[b.ridx (i)] = b.data (i);
3865 
3866  F77_INT b_nr = octave::to_f77_int (b.rows ());
3867 
3868  F77_XFCN (dgttrs, DGTTRS,
3869  (F77_CONST_CHAR_ARG2 (&job, 1),
3870  tmp_nr, 1, DL, D, DU, DU2, pipvt,
3871  work, b_nr, tmp_err
3872  F77_CHAR_ARG_LEN (1)));
3873 
3874  err = tmp_err;
3875 
3876  // Count nonzeros in work vector and adjust
3877  // space in retval if needed
3878  octave_idx_type new_nnz = 0;
3879  for (octave_idx_type i = 0; i < nr; i++)
3880  if (work[i] != 0.)
3881  new_nnz++;
3882 
3883  if (ii + new_nnz > x_nz)
3884  {
3885  // Resize the sparse matrix
3886  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
3887  retval.change_capacity (sz);
3888  x_nz = sz;
3889  }
3890 
3891  for (octave_idx_type i = 0; i < nr; i++)
3892  if (work[i] != 0.)
3893  {
3894  retval.xridx (ii) = i;
3895  retval.xdata (ii++) = work[i];
3896  }
3897  retval.xcidx (j+1) = ii;
3898  }
3899 
3900  retval.maybe_compress ();
3901  }
3902  }
3903  else if (typ != MatrixType::Tridiagonal_Hermitian)
3904  (*current_liboctave_error_handler) ("incorrect matrix type");
3905  }
3906 
3907  return retval;
3908 }
3909 
3910 ComplexMatrix
3911 SparseMatrix::trisolve (MatrixType& mattype, const ComplexMatrix& b,
3912  octave_idx_type& err, double& rcond,
3913  solve_singularity_handler sing_handler,
3914  bool calc_cond) const
3915 {
3916  ComplexMatrix retval;
3917 
3918  octave_idx_type nr = rows ();
3919  octave_idx_type nc = cols ();
3920  err = 0;
3921 
3922  if (nr != nc || nr != b.rows ())
3923  (*current_liboctave_error_handler)
3924  ("matrix dimension mismatch solution of linear equations");
3925 
3926  if (nr == 0 || b.cols () == 0)
3927  retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
3928  else if (calc_cond)
3929  (*current_liboctave_error_handler)
3930  ("calculation of condition number not implemented");
3931  else
3932  {
3933  // Print spparms("spumoni") info if requested
3934  volatile int typ = mattype.type ();
3935  mattype.info ();
3936 
3937  if (typ == MatrixType::Tridiagonal_Hermitian)
3938  {
3939  OCTAVE_LOCAL_BUFFER (double, D, nr);
3940  OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1);
3941 
3942  if (mattype.is_dense ())
3943  {
3944  octave_idx_type ii = 0;
3945 
3946  for (octave_idx_type j = 0; j < nc-1; j++)
3947  {
3948  D[j] = data (ii++);
3949  DL[j] = data (ii);
3950  ii += 2;
3951  }
3952  D[nc-1] = data (ii);
3953  }
3954  else
3955  {
3956  D[0] = 0.;
3957  for (octave_idx_type i = 0; i < nr - 1; i++)
3958  {
3959  D[i+1] = 0.;
3960  DL[i] = 0.;
3961  }
3962 
3963  for (octave_idx_type j = 0; j < nc; j++)
3964  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
3965  {
3966  if (ridx (i) == j)
3967  D[j] = data (i);
3968  else if (ridx (i) == j + 1)
3969  DL[j] = data (i);
3970  }
3971  }
3972 
3973  F77_INT tmp_nr = octave::to_f77_int (nr);
3974 
3975  F77_INT b_nr = octave::to_f77_int (b.rows ());
3976  F77_INT b_nc = octave::to_f77_int (b.cols ());
3977 
3978  rcond = 1.;
3979 
3980  retval = b;
3981  Complex *result = retval.fortran_vec ();
3982 
3983  F77_INT tmp_err = 0;
3984 
3985  F77_XFCN (zptsv, ZPTSV, (tmp_nr, b_nc, D, F77_DBLE_CMPLX_ARG (DL),
3986  F77_DBLE_CMPLX_ARG (result),
3987  b_nr, tmp_err));
3988 
3989  err = tmp_err;
3990 
3991  if (err != 0)
3992  {
3993  err = 0;
3994  mattype.mark_as_unsymmetric ();
3995  typ = MatrixType::Tridiagonal;
3996  }
3997  }
3998 
3999  if (typ == MatrixType::Tridiagonal)
4000  {
4001  OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1);
4002  OCTAVE_LOCAL_BUFFER (Complex, D, nr);
4003  OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1);
4004 
4005  if (mattype.is_dense ())
4006  {
4007  octave_idx_type ii = 0;
4008 
4009  for (octave_idx_type j = 0; j < nc-1; j++)
4010  {
4011  D[j] = data (ii++);
4012  DL[j] = data (ii++);
4013  DU[j] = data (ii++);
4014  }
4015  D[nc-1] = data (ii);
4016  }
4017  else
4018  {
4019  D[0] = 0.;
4020  for (octave_idx_type i = 0; i < nr - 1; i++)
4021  {
4022  D[i+1] = 0.;
4023  DL[i] = 0.;
4024  DU[i] = 0.;
4025  }
4026 
4027  for (octave_idx_type j = 0; j < nc; j++)
4028  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4029  {
4030  if (ridx (i) == j)
4031  D[j] = data (i);
4032  else if (ridx (i) == j + 1)
4033  DL[j] = data (i);
4034  else if (ridx (i) == j - 1)
4035  DU[j-1] = data (i);
4036  }
4037  }
4038 
4039  F77_INT tmp_nr = octave::to_f77_int (nr);
4040 
4041  F77_INT b_nr = octave::to_f77_int (b.rows ());
4042  F77_INT b_nc = octave::to_f77_int (b.cols ());
4043 
4044  rcond = 1.;
4045 
4046  retval = b;
4047  Complex *result = retval.fortran_vec ();
4048 
4049  F77_INT tmp_err = 0;
4050 
4051  F77_XFCN (zgtsv, ZGTSV, (tmp_nr, b_nc, F77_DBLE_CMPLX_ARG (DL),
4052  F77_DBLE_CMPLX_ARG (D),
4053  F77_DBLE_CMPLX_ARG (DU),
4054  F77_DBLE_CMPLX_ARG (result),
4055  b_nr, tmp_err));
4056 
4057  err = tmp_err;
4058 
4059  if (err != 0)
4060  {
4061  rcond = 0.;
4062  err = -2;
4063 
4064  if (sing_handler)
4065  {
4066  sing_handler (rcond);
4067  mattype.mark_as_rectangular ();
4068  }
4069  else
4070  octave::warn_singular_matrix ();
4071  }
4072  }
4073  else if (typ != MatrixType::Tridiagonal_Hermitian)
4074  (*current_liboctave_error_handler) ("incorrect matrix type");
4075  }
4076 
4077  return retval;
4078 }
4079 
4080 SparseComplexMatrix
4081 SparseMatrix::trisolve (MatrixType& mattype, const SparseComplexMatrix& b,
4082  octave_idx_type& err, double& rcond,
4083  solve_singularity_handler sing_handler,
4084  bool calc_cond) const
4085 {
4086  SparseComplexMatrix retval;
4087 
4088  octave_idx_type nr = rows ();
4089  octave_idx_type nc = cols ();
4090  err = 0;
4091 
4092  if (nr != nc || nr != b.rows ())
4093  (*current_liboctave_error_handler)
4094  ("matrix dimension mismatch solution of linear equations");
4095 
4096  if (nr == 0 || b.cols () == 0)
4097  retval = SparseComplexMatrix (nc, b.cols ());
4098  else if (calc_cond)
4099  (*current_liboctave_error_handler)
4100  ("calculation of condition number not implemented");
4101  else
4102  {
4103  // Print spparms("spumoni") info if requested
4104  int typ = mattype.type ();
4105  mattype.info ();
4106 
4107  // Note can't treat symmetric case as there is no dpttrf function
4108  if (typ == MatrixType::Tridiagonal
4109  || typ == MatrixType::Tridiagonal_Hermitian)
4110  {
4111  OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2);
4112  OCTAVE_LOCAL_BUFFER (double, DU, nr - 1);
4113  OCTAVE_LOCAL_BUFFER (double, D, nr);
4114  OCTAVE_LOCAL_BUFFER (double, DL, nr - 1);
4115  Array<F77_INT> ipvt (dim_vector (nr, 1));
4116  F77_INT *pipvt = ipvt.fortran_vec ();
4117 
4118  if (mattype.is_dense ())
4119  {
4120  octave_idx_type ii = 0;
4121 
4122  for (octave_idx_type j = 0; j < nc-1; j++)
4123  {
4124  D[j] = data (ii++);
4125  DL[j] = data (ii++);
4126  DU[j] = data (ii++);
4127  }
4128  D[nc-1] = data (ii);
4129  }
4130  else
4131  {
4132  D[0] = 0.;
4133  for (octave_idx_type i = 0; i < nr - 1; i++)
4134  {
4135  D[i+1] = 0.;
4136  DL[i] = 0.;
4137  DU[i] = 0.;
4138  }
4139 
4140  for (octave_idx_type j = 0; j < nc; j++)
4141  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4142  {
4143  if (ridx (i) == j)
4144  D[j] = data (i);
4145  else if (ridx (i) == j + 1)
4146  DL[j] = data (i);
4147  else if (ridx (i) == j - 1)
4148  DU[j-1] = data (i);
4149  }
4150  }
4151 
4152  F77_INT tmp_nr = octave::to_f77_int (nr);
4153 
4154  F77_INT tmp_err = 0;
4155 
4156  F77_XFCN (dgttrf, DGTTRF, (tmp_nr, DL, D, DU, DU2, pipvt, tmp_err));
4157 
4158  err = tmp_err;
4159 
4160  if (err != 0)
4161  {
4162  rcond = 0.0;
4163  err = -2;
4164 
4165  if (sing_handler)
4166  {
4167  sing_handler (rcond);
4168  mattype.mark_as_rectangular ();
4169  }
4170  else
4171  octave::warn_singular_matrix ();
4172  }
4173  else
4174  {
4175  rcond = 1.;
4176  char job = 'N';
4177  F77_INT b_nr = octave::to_f77_int (b.rows ());
4178  octave_idx_type b_nc = b.cols ();
4179  OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
4180  OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
4181 
4182  // Take a first guess that the number of nonzero terms
4183  // will be as many as in b
4184  volatile octave_idx_type x_nz = b.nnz ();
4185  volatile octave_idx_type ii = 0;
4186  retval = SparseComplexMatrix (b_nr, b_nc, x_nz);
4187 
4188  retval.xcidx (0) = 0;
4189  for (volatile octave_idx_type j = 0; j < b_nc; j++)
4190  {
4191 
4192  for (F77_INT i = 0; i < b_nr; i++)
4193  {
4194  Complex c = b(i, j);
4195  Bx[i] = c.real ();
4196  Bz[i] = c.imag ();
4197  }
4198 
4199  F77_XFCN (dgttrs, DGTTRS,
4200  (F77_CONST_CHAR_ARG2 (&job, 1),
4201  tmp_nr, 1, DL, D, DU, DU2, pipvt,
4202  Bx, b_nr, tmp_err
4203  F77_CHAR_ARG_LEN (1)));
4204 
4205  err = tmp_err;
4206 
4207  if (err != 0)
4208  {
4209  // FIXME: Should this be a warning?
4210  (*current_liboctave_error_handler)
4211  ("SparseMatrix::solve solve failed");
4212 
4213  err = -1;
4214  break;
4215  }
4216 
4217  F77_XFCN (dgttrs, DGTTRS,
4218  (F77_CONST_CHAR_ARG2 (&job, 1),
4219  tmp_nr, 1, DL, D, DU, DU2, pipvt,
4220  Bz, b_nr, tmp_err
4221  F77_CHAR_ARG_LEN (1)));
4222 
4223  err = tmp_err;
4224 
4225  if (err != 0)
4226  {
4227  // FIXME: Should this be a warning?
4228  (*current_liboctave_error_handler)
4229  ("SparseMatrix::solve solve failed");
4230 
4231  err = -1;
4232  break;
4233  }
4234 
4235  // Count nonzeros in work vector and adjust
4236  // space in retval if needed
4237  octave_idx_type new_nnz = 0;
4238  for (octave_idx_type i = 0; i < nr; i++)
4239  if (Bx[i] != 0. || Bz[i] != 0.)
4240  new_nnz++;
4241 
4242  if (ii + new_nnz > x_nz)
4243  {
4244  // Resize the sparse matrix
4245  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
4246  retval.change_capacity (sz);
4247  x_nz = sz;
4248  }
4249 
4250  for (octave_idx_type i = 0; i < nr; i++)
4251  if (Bx[i] != 0. || Bz[i] != 0.)
4252  {
4253  retval.xridx (ii) = i;
4254  retval.xdata (ii++) = Complex (Bx[i], Bz[i]);
4255  }
4256 
4257  retval.xcidx (j+1) = ii;
4258  }
4259 
4260  retval.maybe_compress ();
4261  }
4262  }
4263  else if (typ != MatrixType::Tridiagonal_Hermitian)
4264  (*current_liboctave_error_handler) ("incorrect matrix type");
4265  }
4266 
4267  return retval;
4268 }
4269 
4270 Matrix
4271 SparseMatrix::bsolve (MatrixType& mattype, const Matrix& b,
4272  octave_idx_type& err, double& rcond,
4273  solve_singularity_handler sing_handler,
4274  bool calc_cond) const
4275 {
4276  Matrix retval;
4277 
4278  octave_idx_type nr = rows ();
4279  octave_idx_type nc = cols ();
4280  err = 0;
4281 
4282  if (nr != nc || nr != b.rows ())
4283  (*current_liboctave_error_handler)
4284  ("matrix dimension mismatch solution of linear equations");
4285 
4286  if (nr == 0 || b.cols () == 0)
4287  retval = Matrix (nc, b.cols (), 0.0);
4288  else
4289  {
4290  // Print spparms("spumoni") info if requested
4291  volatile int typ = mattype.type ();
4292  mattype.info ();
4293 
4294  if (typ == MatrixType::Banded_Hermitian)
4295  {
4296  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
4297  F77_INT ldm = n_lower + 1;
4298  Matrix m_band (ldm, nc);
4299  double *tmp_data = m_band.fortran_vec ();
4300 
4301  if (! mattype.is_dense ())
4302  {
4303  octave_idx_type ii = 0;
4304 
4305  for (octave_idx_type j = 0; j < ldm; j++)
4306  for (octave_idx_type i = 0; i < nc; i++)
4307  tmp_data[ii++] = 0.;
4308  }
4309 
4310  for (octave_idx_type j = 0; j < nc; j++)
4311  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4312  {
4313  octave_idx_type ri = ridx (i);
4314  if (ri >= j)
4315  m_band(ri - j, j) = data (i);
4316  }
4317 
4318  // Calculate the norm of the matrix, for later use.
4319  double anorm;
4320  if (calc_cond)
4321  anorm = m_band.abs ().sum ().row (0).max ();
4322 
4323  F77_INT tmp_nr = octave::to_f77_int (nr);
4324 
4325  F77_INT tmp_err = 0;
4326 
4327  char job = 'L';
4328  F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
4329  tmp_nr, n_lower, tmp_data, ldm, tmp_err
4330  F77_CHAR_ARG_LEN (1)));
4331 
4332  err = tmp_err;
4333 
4334  if (err != 0)
4335  {
4336  // Matrix is not positive definite!! Fall through to
4337  // unsymmetric banded solver.
4338  mattype.mark_as_unsymmetric ();
4339  typ = MatrixType::Banded;
4340  rcond = 0.0;
4341  err = 0;
4342  }
4343  else
4344  {
4345  if (calc_cond)
4346  {
4347  Array<double> z (dim_vector (3 * nr, 1));
4348  double *pz = z.fortran_vec ();
4349  Array<F77_INT> iz (dim_vector (nr, 1));
4350  F77_INT *piz = iz.fortran_vec ();
4351 
4352  F77_XFCN (dpbcon, DPBCON,
4353  (F77_CONST_CHAR_ARG2 (&job, 1),
4354  tmp_nr, n_lower, tmp_data, ldm,
4355  anorm, rcond, pz, piz, tmp_err
4356  F77_CHAR_ARG_LEN (1)));
4357 
4358  err = tmp_err;
4359 
4360  if (err != 0)
4361  err = -2;
4362 
4363  volatile double rcond_plus_one = rcond + 1.0;
4364 
4365  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
4366  {
4367  err = -2;
4368 
4369  if (sing_handler)
4370  {
4371  sing_handler (rcond);
4372  mattype.mark_as_rectangular ();
4373  }
4374  else
4375  octave::warn_singular_matrix (rcond);
4376  }
4377  }
4378  else
4379  rcond = 1.;
4380 
4381  if (err == 0)
4382  {
4383  retval = b;
4384  double *result = retval.fortran_vec ();
4385 
4386  F77_INT b_nr = octave::to_f77_int (b.rows ());
4387  F77_INT b_nc = octave::to_f77_int (b.cols ());
4388 
4389  F77_XFCN (dpbtrs, DPBTRS,
4390  (F77_CONST_CHAR_ARG2 (&job, 1),
4391  tmp_nr, n_lower, b_nc, tmp_data,
4392  ldm, result, b_nr, tmp_err
4393  F77_CHAR_ARG_LEN (1)));
4394 
4395  err = tmp_err;
4396 
4397  if (err != 0)
4398  {
4399  // FIXME: Should this be a warning?
4400  (*current_liboctave_error_handler)
4401  ("SparseMatrix::solve solve failed");
4402  err = -1;
4403  }
4404  }
4405  }
4406  }
4407 
4408  if (typ == MatrixType::Banded)
4409  {
4410  // Create the storage for the banded form of the sparse matrix
4411  F77_INT n_upper = octave::to_f77_int (mattype.nupper ());
4412  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
4413  F77_INT ldm = n_upper + 2 * n_lower + 1;
4414 
4415  Matrix m_band (ldm, nc);
4416  double *tmp_data = m_band.fortran_vec ();
4417 
4418  if (! mattype.is_dense ())
4419  {
4420  octave_idx_type ii = 0;
4421 
4422  for (F77_INT j = 0; j < ldm; j++)
4423  for (octave_idx_type i = 0; i < nc; i++)
4424  tmp_data[ii++] = 0.;
4425  }
4426 
4427  for (octave_idx_type j = 0; j < nc; j++)
4428  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4429  m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
4430 
4431  // Calculate the norm of the matrix, for later use.
4432  double anorm = 0.0;
4433  if (calc_cond)
4434  {
4435  for (octave_idx_type j = 0; j < nr; j++)
4436  {
4437  double atmp = 0.;
4438  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4439  atmp += fabs (data (i));
4440  if (atmp > anorm)
4441  anorm = atmp;
4442  }
4443  }
4444 
4445  F77_INT tmp_nr = octave::to_f77_int (nr);
4446 
4447  Array<F77_INT> ipvt (dim_vector (nr, 1));
4448  F77_INT *pipvt = ipvt.fortran_vec ();
4449 
4450  F77_INT tmp_err = 0;
4451 
4452  F77_XFCN (dgbtrf, DGBTRF, (tmp_nr, tmp_nr, n_lower, n_upper,
4453  tmp_data, ldm, pipvt, tmp_err));
4454 
4455  err = tmp_err;
4456 
4457  // Throw away extra info LAPACK gives so as to not
4458  // change output.
4459  if (err != 0)
4460  {
4461  err = -2;
4462  rcond = 0.0;
4463 
4464  if (sing_handler)
4465  {
4466  sing_handler (rcond);
4467  mattype.mark_as_rectangular ();
4468  }
4469  else
4470  octave::warn_singular_matrix ();
4471  }
4472  else
4473  {
4474  if (calc_cond)
4475  {
4476  char job = '1';
4477  Array<double> z (dim_vector (3 * nr, 1));
4478  double *pz = z.fortran_vec ();
4479  Array<F77_INT> iz (dim_vector (nr, 1));
4480  F77_INT *piz = iz.fortran_vec ();
4481 
4482  F77_INT tmp_nc = octave::to_f77_int (nc);
4483 
4484  F77_XFCN (dgbcon, DGBCON,
4485  (F77_CONST_CHAR_ARG2 (&job, 1),
4486  tmp_nc, n_lower, n_upper, tmp_data, ldm, pipvt,
4487  anorm, rcond, pz, piz, tmp_err
4488  F77_CHAR_ARG_LEN (1)));
4489 
4490  err = tmp_err;
4491 
4492  if (err != 0)
4493  err = -2;
4494 
4495  volatile double rcond_plus_one = rcond + 1.0;
4496 
4497  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
4498  {
4499  err = -2;
4500 
4501  if (sing_handler)
4502  {
4503  sing_handler (rcond);
4504  mattype.mark_as_rectangular ();
4505  }
4506  else
4507  octave::warn_singular_matrix (rcond);
4508  }
4509  }
4510  else
4511  rcond = 1.;
4512 
4513  if (err == 0)
4514  {
4515  retval = b;
4516  double *result = retval.fortran_vec ();
4517 
4518  F77_INT b_nr = octave::to_f77_int (b.rows ());
4519  F77_INT b_nc = octave::to_f77_int (b.cols ());
4520 
4521  char job = 'N';
4522  F77_XFCN (dgbtrs, DGBTRS,
4523  (F77_CONST_CHAR_ARG2 (&job, 1),
4524  tmp_nr, n_lower, n_upper, b_nc, tmp_data,
4525  ldm, pipvt, result, b_nr, tmp_err
4526  F77_CHAR_ARG_LEN (1)));
4527 
4528  err = tmp_err;
4529  }
4530  }
4531  }
4532  else if (typ != MatrixType::Banded_Hermitian)
4533  (*current_liboctave_error_handler) ("incorrect matrix type");
4534  }
4535 
4536  return retval;
4537 }
4538 
4539 SparseMatrix
4540 SparseMatrix::bsolve (MatrixType& mattype, const SparseMatrix& b,
4541  octave_idx_type& err, double& rcond,
4542  solve_singularity_handler sing_handler,
4543  bool calc_cond) const
4544 {
4545  SparseMatrix retval;
4546 
4547  octave_idx_type nr = rows ();
4548  octave_idx_type nc = cols ();
4549  err = 0;
4550 
4551  if (nr != nc || nr != b.rows ())
4552  (*current_liboctave_error_handler)
4553  ("matrix dimension mismatch solution of linear equations");
4554 
4555  if (nr == 0 || b.cols () == 0)
4556  retval = SparseMatrix (nc, b.cols ());
4557  else
4558  {
4559  // Print spparms("spumoni") info if requested
4560  volatile int typ = mattype.type ();
4561  mattype.info ();
4562 
4563  if (typ == MatrixType::Banded_Hermitian)
4564  {
4565  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
4566  F77_INT ldm = octave::to_f77_int (n_lower + 1);
4567 
4568  Matrix m_band (ldm, nc);
4569  double *tmp_data = m_band.fortran_vec ();
4570 
4571  if (! mattype.is_dense ())
4572  {
4573  octave_idx_type ii = 0;
4574 
4575  for (F77_INT j = 0; j < ldm; j++)
4576  for (octave_idx_type i = 0; i < nc; i++)
4577  tmp_data[ii++] = 0.;
4578  }
4579 
4580  for (octave_idx_type j = 0; j < nc; j++)
4581  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4582  {
4583  octave_idx_type ri = ridx (i);
4584  if (ri >= j)
4585  m_band(ri - j, j) = data (i);
4586  }
4587 
4588  // Calculate the norm of the matrix, for later use.
4589  double anorm;
4590  if (calc_cond)
4591  anorm = m_band.abs ().sum ().row (0).max ();
4592 
4593  F77_INT tmp_nr = octave::to_f77_int (nr);
4594 
4595  F77_INT tmp_err = 0;
4596 
4597  char job = 'L';
4598  F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
4599  tmp_nr, n_lower, tmp_data, ldm, tmp_err
4600  F77_CHAR_ARG_LEN (1)));
4601 
4602  err = tmp_err;
4603 
4604  if (err != 0)
4605  {
4606  mattype.mark_as_unsymmetric ();
4607  typ = MatrixType::Banded;
4608  rcond = 0.0;
4609  err = 0;
4610  }
4611  else
4612  {
4613  if (calc_cond)
4614  {
4615  Array<double> z (dim_vector (3 * nr, 1));
4616  double *pz = z.fortran_vec ();
4617  Array<F77_INT> iz (dim_vector (nr, 1));
4618  F77_INT *piz = iz.fortran_vec ();
4619 
4620  F77_XFCN (dpbcon, DPBCON,
4621  (F77_CONST_CHAR_ARG2 (&job, 1),
4622  tmp_nr, n_lower, tmp_data, ldm,
4623  anorm, rcond, pz, piz, tmp_err
4624  F77_CHAR_ARG_LEN (1)));
4625 
4626  err = tmp_err;
4627 
4628  if (err != 0)
4629  err = -2;
4630 
4631  volatile double rcond_plus_one = rcond + 1.0;
4632 
4633  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
4634  {
4635  err = -2;
4636 
4637  if (sing_handler)
4638  {
4639  sing_handler (rcond);
4640  mattype.mark_as_rectangular ();
4641  }
4642  else
4643  octave::warn_singular_matrix (rcond);
4644  }
4645  }
4646  else
4647  rcond = 1.;
4648 
4649  if (err == 0)
4650  {
4651  F77_INT b_nr = octave::to_f77_int (b.rows ());
4652  octave_idx_type b_nc = b.cols ();
4653  OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
4654 
4655  // Take a first guess that the number of nonzero terms
4656  // will be as many as in b
4657  volatile octave_idx_type x_nz = b.nnz ();
4658  volatile octave_idx_type ii = 0;
4659  retval = SparseMatrix (b_nr, b_nc, x_nz);
4660 
4661  retval.xcidx (0) = 0;
4662  for (volatile octave_idx_type j = 0; j < b_nc; j++)
4663  {
4664  for (F77_INT i = 0; i < b_nr; i++)
4665  Bx[i] = b.elem (i, j);
4666 
4667  F77_XFCN (dpbtrs, DPBTRS,
4668  (F77_CONST_CHAR_ARG2 (&job, 1),
4669  tmp_nr, n_lower, 1, tmp_data,
4670  ldm, Bx, b_nr, tmp_err
4671  F77_CHAR_ARG_LEN (1)));
4672 
4673  err = tmp_err;
4674 
4675  if (err != 0)
4676  {
4677  // FIXME: Should this be a warning?
4678  (*current_liboctave_error_handler)
4679  ("SparseMatrix::solve solve failed");
4680  err = -1;
4681  break;
4682  }
4683 
4684  for (F77_INT i = 0; i < b_nr; i++)
4685  {
4686  double tmp = Bx[i];
4687  if (tmp != 0.0)
4688  {
4689  if (ii == x_nz)
4690  {
4691  // Resize the sparse matrix
4692  octave_idx_type sz;
4693  sz = (static_cast<double> (b_nc) - j) / b_nc
4694  * x_nz;
4695  sz = x_nz + (sz > 100 ? sz : 100);
4696  retval.change_capacity (sz);
4697  x_nz = sz;
4698  }
4699  retval.xdata (ii) = tmp;
4700  retval.xridx (ii++) = i;
4701  }
4702  }
4703  retval.xcidx (j+1) = ii;
4704  }
4705 
4706  retval.maybe_compress ();
4707  }
4708  }
4709  }
4710 
4711  if (typ == MatrixType::Banded)
4712  {
4713  // Create the storage for the banded form of the sparse matrix
4714  F77_INT n_upper = octave::to_f77_int (mattype.nupper ());
4715  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
4716  F77_INT ldm = octave::to_f77_int (n_upper + 2 * n_lower + 1);
4717 
4718  Matrix m_band (ldm, nc);
4719  double *tmp_data = m_band.fortran_vec ();
4720 
4721  if (! mattype.is_dense ())
4722  {
4723  octave_idx_type ii = 0;
4724 
4725  for (octave_idx_type j = 0; j < ldm; j++)
4726  for (octave_idx_type i = 0; i < nc; i++)
4727  tmp_data[ii++] = 0.;
4728  }
4729 
4730  for (octave_idx_type j = 0; j < nc; j++)
4731  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4732  m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
4733 
4734  // Calculate the norm of the matrix, for later use.
4735  double anorm;
4736  if (calc_cond)
4737  {
4738  anorm = 0.0;
4739  for (octave_idx_type j = 0; j < nr; j++)
4740  {
4741  double atmp = 0.0;
4742  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4743  atmp += fabs (data (i));
4744  if (atmp > anorm)
4745  anorm = atmp;
4746  }
4747  }
4748 
4749  F77_INT tmp_nr = octave::to_f77_int (nr);
4750 
4751  Array<F77_INT> ipvt (dim_vector (nr, 1));
4752  F77_INT *pipvt = ipvt.fortran_vec ();
4753 
4754  F77_INT tmp_err = 0;
4755 
4756  F77_XFCN (dgbtrf, DGBTRF, (tmp_nr, tmp_nr, n_lower, n_upper,
4757  tmp_data, ldm, pipvt, tmp_err));
4758 
4759  err = tmp_err;
4760 
4761  if (err != 0)
4762  {
4763  err = -2;
4764  rcond = 0.0;
4765 
4766  if (sing_handler)
4767  {
4768  sing_handler (rcond);
4769  mattype.mark_as_rectangular ();
4770  }
4771  else
4772  octave::warn_singular_matrix ();
4773  }
4774  else
4775  {
4776  if (calc_cond)
4777  {
4778  char job = '1';
4779  Array<double> z (dim_vector (3 * nr, 1));
4780  double *pz = z.fortran_vec ();
4781  Array<F77_INT> iz (dim_vector (nr, 1));
4782  F77_INT *piz = iz.fortran_vec ();
4783 
4784  F77_INT tmp_nc = octave::to_f77_int (nc);
4785 
4786  F77_XFCN (dgbcon, DGBCON,
4787  (F77_CONST_CHAR_ARG2 (&job, 1),
4788  tmp_nc, n_lower, n_upper, tmp_data, ldm, pipvt,
4789  anorm, rcond, pz, piz, tmp_err
4790  F77_CHAR_ARG_LEN (1)));
4791 
4792  err = tmp_err;
4793 
4794  if (err != 0)
4795  err = -2;
4796 
4797  volatile double rcond_plus_one = rcond + 1.0;
4798 
4799  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
4800  {
4801  err = -2;
4802 
4803  if (sing_handler)
4804  {
4805  sing_handler (rcond);
4806  mattype.mark_as_rectangular ();
4807  }
4808  else
4809  octave::warn_singular_matrix (rcond);
4810  }
4811  }
4812  else
4813  rcond = 1.;
4814 
4815  if (err == 0)
4816  {
4817  char job = 'N';
4818  volatile octave_idx_type x_nz = b.nnz ();
4819  octave_idx_type b_nc = b.cols ();
4820  retval = SparseMatrix (nr, b_nc, x_nz);
4821  retval.xcidx (0) = 0;
4822  volatile octave_idx_type ii = 0;
4823 
4824  OCTAVE_LOCAL_BUFFER (double, work, nr);
4825 
4826  for (volatile octave_idx_type j = 0; j < b_nc; j++)
4827  {
4828  for (octave_idx_type i = 0; i < nr; i++)
4829  work[i] = 0.;
4830  for (octave_idx_type i = b.cidx (j);
4831  i < b.cidx (j+1); i++)
4832  work[b.ridx (i)] = b.data (i);
4833 
4834  F77_INT b_nr = octave::to_f77_int (b.rows ());
4835 
4836  F77_XFCN (dgbtrs, DGBTRS,
4837  (F77_CONST_CHAR_ARG2 (&job, 1),
4838  tmp_nr, n_lower, n_upper, 1, tmp_data,
4839  ldm, pipvt, work, b_nr, tmp_err
4840  F77_CHAR_ARG_LEN (1)));
4841 
4842  err = tmp_err;
4843 
4844  // Count nonzeros in work vector and adjust
4845  // space in retval if needed
4846  octave_idx_type new_nnz = 0;
4847  for (octave_idx_type i = 0; i < nr; i++)
4848  if (work[i] != 0.)
4849  new_nnz++;
4850 
4851  if (ii + new_nnz > x_nz)
4852  {
4853  // Resize the sparse matrix
4854  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
4855  retval.change_capacity (sz);
4856  x_nz = sz;
4857  }
4858 
4859  for (octave_idx_type i = 0; i < nr; i++)
4860  if (work[i] != 0.)
4861  {
4862  retval.xridx (ii) = i;
4863  retval.xdata (ii++) = work[i];
4864  }
4865  retval.xcidx (j+1) = ii;
4866  }
4867 
4868  retval.maybe_compress ();
4869  }
4870  }
4871  }
4872  else if (typ != MatrixType::Banded_Hermitian)
4873  (*current_liboctave_error_handler) ("incorrect matrix type");
4874  }
4875 
4876  return retval;
4877 }
4878 
4879 ComplexMatrix
4880 SparseMatrix::bsolve (MatrixType& mattype, const ComplexMatrix& b,
4881  octave_idx_type& err, double& rcond,
4882  solve_singularity_handler sing_handler,
4883  bool calc_cond) const
4884 {
4885  ComplexMatrix retval;
4886 
4887  octave_idx_type nr = rows ();
4888  octave_idx_type nc = cols ();
4889  err = 0;
4890 
4891  if (nr != nc || nr != b.rows ())
4892  (*current_liboctave_error_handler)
4893  ("matrix dimension mismatch solution of linear equations");
4894 
4895  if (nr == 0 || b.cols () == 0)
4896  retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
4897  else
4898  {
4899  // Print spparms("spumoni") info if requested
4900  volatile int typ = mattype.type ();
4901  mattype.info ();
4902 
4903  if (typ == MatrixType::Banded_Hermitian)
4904  {
4905  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
4906  F77_INT ldm = n_lower + 1;
4907 
4908  Matrix m_band (ldm, nc);
4909  double *tmp_data = m_band.fortran_vec ();
4910 
4911  if (! mattype.is_dense ())
4912  {
4913  octave_idx_type ii = 0;
4914 
4915  for (F77_INT j = 0; j < ldm; j++)
4916  for (octave_idx_type i = 0; i < nc; i++)
4917  tmp_data[ii++] = 0.;
4918  }
4919 
4920  for (octave_idx_type j = 0; j < nc; j++)
4921  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
4922  {
4923  octave_idx_type ri = ridx (i);
4924  if (ri >= j)
4925  m_band(ri - j, j) = data (i);
4926  }
4927 
4928  // Calculate the norm of the matrix, for later use.
4929  double anorm;
4930  if (calc_cond)
4931  anorm = m_band.abs ().sum ().row (0).max ();
4932 
4933  F77_INT tmp_nr = octave::to_f77_int (nr);
4934 
4935  F77_INT tmp_err = 0;
4936 
4937  char job = 'L';
4938  F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
4939  tmp_nr, n_lower, tmp_data, ldm, tmp_err
4940  F77_CHAR_ARG_LEN (1)));
4941 
4942  err = tmp_err;
4943 
4944  if (err != 0)
4945  {
4946  // Matrix is not positive definite!! Fall through to
4947  // unsymmetric banded solver.
4948  mattype.mark_as_unsymmetric ();
4949  typ = MatrixType::Banded;
4950  rcond = 0.0;
4951  err = 0;
4952  }
4953  else
4954  {
4955  if (calc_cond)
4956  {
4957  Array<double> z (dim_vector (3 * nr, 1));
4958  double *pz = z.fortran_vec ();
4959  Array<F77_INT> iz (dim_vector (nr, 1));
4960  F77_INT *piz = iz.fortran_vec ();
4961 
4962  F77_XFCN (dpbcon, DPBCON,
4963  (F77_CONST_CHAR_ARG2 (&job, 1),
4964  tmp_nr, n_lower, tmp_data, ldm,
4965  anorm, rcond, pz, piz, tmp_err
4966  F77_CHAR_ARG_LEN (1)));
4967 
4968  err = tmp_err;
4969 
4970  if (err != 0)
4971  err = -2;
4972 
4973  volatile double rcond_plus_one = rcond + 1.0;
4974 
4975  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
4976  {
4977  err = -2;
4978 
4979  if (sing_handler)
4980  {
4981  sing_handler (rcond);
4982  mattype.mark_as_rectangular ();
4983  }
4984  else
4985  octave::warn_singular_matrix (rcond);
4986  }
4987  }
4988  else
4989  rcond = 1.;
4990 
4991  if (err == 0)
4992  {
4993  F77_INT b_nr = octave::to_f77_int (b.rows ());
4994  octave_idx_type b_nc = b.cols ();
4995 
4996  OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
4997  OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
4998 
4999  retval.resize (b_nr, b_nc);
5000 
5001  for (volatile octave_idx_type j = 0; j < b_nc; j++)
5002  {
5003  for (F77_INT i = 0; i < b_nr; i++)
5004  {
5005  Complex c = b(i, j);
5006  Bx[i] = c.real ();
5007  Bz[i] = c.imag ();
5008  }
5009 
5010  F77_XFCN (dpbtrs, DPBTRS,
5011  (F77_CONST_CHAR_ARG2 (&job, 1),
5012  tmp_nr, n_lower, 1, tmp_data,
5013  ldm, Bx, b_nr, tmp_err
5014  F77_CHAR_ARG_LEN (1)));
5015 
5016  err = tmp_err;
5017 
5018  if (err != 0)
5019  {
5020  // FIXME: Should this be a warning?
5021  (*current_liboctave_error_handler)
5022  ("SparseMatrix::solve solve failed");
5023  err = -1;
5024  break;
5025  }
5026 
5027  F77_XFCN (dpbtrs, DPBTRS,
5028  (F77_CONST_CHAR_ARG2 (&job, 1),
5029  tmp_nr, n_lower, 1, tmp_data,
5030  ldm, Bz, b_nr, tmp_err
5031  F77_CHAR_ARG_LEN (1)));
5032 
5033  err = tmp_err;
5034 
5035  if (err != 0)
5036  {
5037  // FIXME: Should this be a warning?
5038  (*current_liboctave_error_handler)
5039  ("SparseMatrix::solve solve failed");
5040  err = -1;
5041  break;
5042  }
5043 
5044  for (octave_idx_type i = 0; i < b_nr; i++)
5045  retval(i, j) = Complex (Bx[i], Bz[i]);
5046  }
5047  }
5048  }
5049  }
5050 
5051  if (typ == MatrixType::Banded)
5052  {
5053  // Create the storage for the banded form of the sparse matrix
5054  F77_INT n_upper = octave::to_f77_int (mattype.nupper ());
5055  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
5056  F77_INT ldm = n_upper + 2 * n_lower + 1;
5057 
5058  Matrix m_band (ldm, nc);
5059  double *tmp_data = m_band.fortran_vec ();
5060 
5061  if (! mattype.is_dense ())
5062  {
5063  octave_idx_type ii = 0;
5064 
5065  for (F77_INT j = 0; j < ldm; j++)
5066  for (octave_idx_type i = 0; i < nc; i++)
5067  tmp_data[ii++] = 0.;
5068  }
5069 
5070  for (octave_idx_type j = 0; j < nc; j++)
5071  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5072  m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
5073 
5074  // Calculate the norm of the matrix, for later use.
5075  double anorm;
5076  if (calc_cond)
5077  {
5078  anorm = 0.0;
5079  for (octave_idx_type j = 0; j < nr; j++)
5080  {
5081  double atmp = 0.0;
5082  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5083  atmp += fabs (data (i));
5084  if (atmp > anorm)
5085  anorm = atmp;
5086  }
5087  }
5088 
5089  F77_INT tmp_nr = octave::to_f77_int (nr);
5090 
5091  Array<F77_INT> ipvt (dim_vector (nr, 1));
5092  F77_INT *pipvt = ipvt.fortran_vec ();
5093 
5094  F77_INT tmp_err = 0;
5095 
5096  F77_XFCN (dgbtrf, DGBTRF, (tmp_nr, tmp_nr, n_lower, n_upper,
5097  tmp_data, ldm, pipvt, tmp_err));
5098 
5099  err = tmp_err;
5100 
5101  if (err != 0)
5102  {
5103  err = -2;
5104  rcond = 0.0;
5105 
5106  if (sing_handler)
5107  {
5108  sing_handler (rcond);
5109  mattype.mark_as_rectangular ();
5110  }
5111  else
5112  octave::warn_singular_matrix ();
5113  }
5114  else
5115  {
5116  if (calc_cond)
5117  {
5118  char job = '1';
5119  Array<double> z (dim_vector (3 * nr, 1));
5120  double *pz = z.fortran_vec ();
5121  Array<F77_INT> iz (dim_vector (nr, 1));
5122  F77_INT *piz = iz.fortran_vec ();
5123 
5124  F77_INT tmp_nc = octave::to_f77_int (nc);
5125 
5126  F77_XFCN (dgbcon, DGBCON,
5127  (F77_CONST_CHAR_ARG2 (&job, 1),
5128  tmp_nc, n_lower, n_upper, tmp_data, ldm, pipvt,
5129  anorm, rcond, pz, piz, tmp_err
5130  F77_CHAR_ARG_LEN (1)));
5131 
5132  err = tmp_err;
5133 
5134  if (err != 0)
5135  err = -2;
5136 
5137  volatile double rcond_plus_one = rcond + 1.0;
5138 
5139  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
5140  {
5141  err = -2;
5142 
5143  if (sing_handler)
5144  {
5145  sing_handler (rcond);
5146  mattype.mark_as_rectangular ();
5147  }
5148  else
5149  octave::warn_singular_matrix (rcond);
5150  }
5151  }
5152  else
5153  rcond = 1.;
5154 
5155  if (err == 0)
5156  {
5157  char job = 'N';
5158  F77_INT b_nr = octave::to_f77_int (b.rows ());
5159  octave_idx_type b_nc = b.cols ();
5160  retval.resize (nr, b_nc);
5161 
5162  OCTAVE_LOCAL_BUFFER (double, Bz, nr);
5163  OCTAVE_LOCAL_BUFFER (double, Bx, nr);
5164 
5165  for (volatile octave_idx_type j = 0; j < b_nc; j++)
5166  {
5167  for (octave_idx_type i = 0; i < nr; i++)
5168  {
5169  Complex c = b(i, j);
5170  Bx[i] = c.real ();
5171  Bz[i] = c.imag ();
5172  }
5173 
5174  F77_XFCN (dgbtrs, DGBTRS,
5175  (F77_CONST_CHAR_ARG2 (&job, 1),
5176  tmp_nr, n_lower, n_upper, 1, tmp_data,
5177  ldm, pipvt, Bx, b_nr, tmp_err
5178  F77_CHAR_ARG_LEN (1)));
5179 
5180  err = tmp_err;
5181 
5182  F77_XFCN (dgbtrs, DGBTRS,
5183  (F77_CONST_CHAR_ARG2 (&job, 1),
5184  tmp_nr, n_lower, n_upper, 1, tmp_data,
5185  ldm, pipvt, Bz, b_nr, tmp_err
5186  F77_CHAR_ARG_LEN (1)));
5187 
5188  err = tmp_err;
5189 
5190  for (octave_idx_type i = 0; i < nr; i++)
5191  retval(i, j) = Complex (Bx[i], Bz[i]);
5192  }
5193  }
5194  }
5195  }
5196  else if (typ != MatrixType::Banded_Hermitian)
5197  (*current_liboctave_error_handler) ("incorrect matrix type");
5198  }
5199 
5200  return retval;
5201 }
5202 
5203 SparseComplexMatrix
5204 SparseMatrix::bsolve (MatrixType& mattype, const SparseComplexMatrix& b,
5205  octave_idx_type& err, double& rcond,
5206  solve_singularity_handler sing_handler,
5207  bool calc_cond) const
5208 {
5209  SparseComplexMatrix retval;
5210 
5211  octave_idx_type nr = rows ();
5212  octave_idx_type nc = cols ();
5213  err = 0;
5214 
5215  if (nr != nc || nr != b.rows ())
5216  (*current_liboctave_error_handler)
5217  ("matrix dimension mismatch solution of linear equations");
5218 
5219  if (nr == 0 || b.cols () == 0)
5220  retval = SparseComplexMatrix (nc, b.cols ());
5221  else
5222  {
5223  // Print spparms("spumoni") info if requested
5224  volatile int typ = mattype.type ();
5225  mattype.info ();
5226 
5227  if (typ == MatrixType::Banded_Hermitian)
5228  {
5229  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
5230  F77_INT ldm = n_lower + 1;
5231 
5232  Matrix m_band (ldm, nc);
5233  double *tmp_data = m_band.fortran_vec ();
5234 
5235  if (! mattype.is_dense ())
5236  {
5237  octave_idx_type ii = 0;
5238 
5239  for (F77_INT j = 0; j < ldm; j++)
5240  for (octave_idx_type i = 0; i < nc; i++)
5241  tmp_data[ii++] = 0.;
5242  }
5243 
5244  for (octave_idx_type j = 0; j < nc; j++)
5245  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5246  {
5247  octave_idx_type ri = ridx (i);
5248  if (ri >= j)
5249  m_band(ri - j, j) = data (i);
5250  }
5251 
5252  // Calculate the norm of the matrix, for later use.
5253  double anorm;
5254  if (calc_cond)
5255  anorm = m_band.abs ().sum ().row (0).max ();
5256 
5257  F77_INT tmp_nr = octave::to_f77_int (nr);
5258 
5259  F77_INT tmp_err = 0;
5260 
5261  char job = 'L';
5262  F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1),
5263  tmp_nr, n_lower, tmp_data, ldm, tmp_err
5264  F77_CHAR_ARG_LEN (1)));
5265 
5266  err = tmp_err;
5267 
5268  if (err != 0)
5269  {
5270  // Matrix is not positive definite!! Fall through to
5271  // unsymmetric banded solver.
5272  mattype.mark_as_unsymmetric ();
5273  typ = MatrixType::Banded;
5274 
5275  rcond = 0.0;
5276  err = 0;
5277  }
5278  else
5279  {
5280  if (calc_cond)
5281  {
5282  Array<double> z (dim_vector (3 * nr, 1));
5283  double *pz = z.fortran_vec ();
5284  Array<F77_INT> iz (dim_vector (nr, 1));
5285  F77_INT *piz = iz.fortran_vec ();
5286 
5287  F77_XFCN (dpbcon, DPBCON,
5288  (F77_CONST_CHAR_ARG2 (&job, 1),
5289  tmp_nr, n_lower, tmp_data, ldm,
5290  anorm, rcond, pz, piz, tmp_err
5291  F77_CHAR_ARG_LEN (1)));
5292 
5293  err = tmp_err;
5294 
5295  if (err != 0)
5296  err = -2;
5297 
5298  volatile double rcond_plus_one = rcond + 1.0;
5299 
5300  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
5301  {
5302  err = -2;
5303 
5304  if (sing_handler)
5305  {
5306  sing_handler (rcond);
5307  mattype.mark_as_rectangular ();
5308  }
5309  else
5310  octave::warn_singular_matrix (rcond);
5311  }
5312  }
5313  else
5314  rcond = 1.;
5315 
5316  if (err == 0)
5317  {
5318  F77_INT b_nr = octave::to_f77_int (b.rows ());
5319  octave_idx_type b_nc = b.cols ();
5320  OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
5321  OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
5322 
5323  // Take a first guess that the number of nonzero terms
5324  // will be as many as in b
5325  volatile octave_idx_type x_nz = b.nnz ();
5326  volatile octave_idx_type ii = 0;
5327  retval = SparseComplexMatrix (b_nr, b_nc, x_nz);
5328 
5329  retval.xcidx (0) = 0;
5330  for (volatile octave_idx_type j = 0; j < b_nc; j++)
5331  {
5332 
5333  for (F77_INT i = 0; i < b_nr; i++)
5334  {
5335  Complex c = b(i, j);
5336  Bx[i] = c.real ();
5337  Bz[i] = c.imag ();
5338  }
5339 
5340  F77_XFCN (dpbtrs, DPBTRS,
5341  (F77_CONST_CHAR_ARG2 (&job, 1),
5342  tmp_nr, n_lower, 1, tmp_data,
5343  ldm, Bx, b_nr, tmp_err
5344  F77_CHAR_ARG_LEN (1)));
5345 
5346  err = tmp_err;
5347 
5348  if (err != 0)
5349  {
5350  // FIXME: Should this be a warning?
5351  (*current_liboctave_error_handler)
5352  ("SparseMatrix::solve solve failed");
5353  err = -1;
5354  break;
5355  }
5356 
5357  F77_XFCN (dpbtrs, DPBTRS,
5358  (F77_CONST_CHAR_ARG2 (&job, 1),
5359  tmp_nr, n_lower, 1, tmp_data,
5360  ldm, Bz, b_nr, tmp_err
5361  F77_CHAR_ARG_LEN (1)));
5362 
5363  err = tmp_err;
5364 
5365  if (err != 0)
5366  {
5367  // FIXME: Should this be a warning?
5368  (*current_liboctave_error_handler)
5369  ("SparseMatrix::solve solve failed");
5370 
5371  err = -1;
5372  break;
5373  }
5374 
5375  // Count nonzeros in work vector and adjust
5376  // space in retval if needed
5377  octave_idx_type new_nnz = 0;
5378  for (octave_idx_type i = 0; i < nr; i++)
5379  if (Bx[i] != 0. || Bz[i] != 0.)
5380  new_nnz++;
5381 
5382  if (ii + new_nnz > x_nz)
5383  {
5384  // Resize the sparse matrix
5385  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
5386  retval.change_capacity (sz);
5387  x_nz = sz;
5388  }
5389 
5390  for (octave_idx_type i = 0; i < nr; i++)
5391  if (Bx[i] != 0. || Bz[i] != 0.)
5392  {
5393  retval.xridx (ii) = i;
5394  retval.xdata (ii++) = Complex (Bx[i], Bz[i]);
5395  }
5396 
5397  retval.xcidx (j+1) = ii;
5398  }
5399 
5400  retval.maybe_compress ();
5401  }
5402  }
5403  }
5404 
5405  if (typ == MatrixType::Banded)
5406  {
5407  // Create the storage for the banded form of the sparse matrix
5408  F77_INT n_upper = octave::to_f77_int (mattype.nupper ());
5409  F77_INT n_lower = octave::to_f77_int (mattype.nlower ());
5410  F77_INT ldm = n_upper + 2 * n_lower + 1;
5411 
5412  Matrix m_band (ldm, nc);
5413  double *tmp_data = m_band.fortran_vec ();
5414 
5415  if (! mattype.is_dense ())
5416  {
5417  octave_idx_type ii = 0;
5418 
5419  for (F77_INT j = 0; j < ldm; j++)
5420  for (octave_idx_type i = 0; i < nc; i++)
5421  tmp_data[ii++] = 0.;
5422  }
5423 
5424  for (octave_idx_type j = 0; j < nc; j++)
5425  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5426  m_band(ridx (i) - j + n_lower + n_upper, j) = data (i);
5427 
5428  // Calculate the norm of the matrix, for later use.
5429  double anorm;
5430  if (calc_cond)
5431  {
5432  anorm = 0.0;
5433  for (octave_idx_type j = 0; j < nr; j++)
5434  {
5435  double atmp = 0.0;
5436  for (octave_idx_type i = cidx (j); i < cidx (j+1); i++)
5437  atmp += fabs (data (i));
5438  if (atmp > anorm)
5439  anorm = atmp;
5440  }
5441  }
5442 
5443  F77_INT tmp_nr = octave::to_f77_int (nr);
5444 
5445  Array<F77_INT> ipvt (dim_vector (nr, 1));
5446  F77_INT *pipvt = ipvt.fortran_vec ();
5447 
5448  F77_INT tmp_err = 0;
5449 
5450  F77_XFCN (dgbtrf, DGBTRF, (tmp_nr, tmp_nr, n_lower, n_upper,
5451  tmp_data, ldm, pipvt, tmp_err));
5452 
5453  err = tmp_err;
5454 
5455  if (err != 0)
5456  {
5457  err = -2;
5458  rcond = 0.0;
5459 
5460  if (sing_handler)
5461  {
5462  sing_handler (rcond);
5463  mattype.mark_as_rectangular ();
5464  }
5465  else
5466  octave::warn_singular_matrix ();
5467  }
5468  else
5469  {
5470  if (calc_cond)
5471  {
5472  char job = '1';
5473  Array<double> z (dim_vector (3 * nr, 1));
5474  double *pz = z.fortran_vec ();
5475  Array<F77_INT> iz (dim_vector (nr, 1));
5476  F77_INT *piz = iz.fortran_vec ();
5477 
5478  F77_INT tmp_nc = octave::to_f77_int (nc);
5479 
5480  F77_XFCN (dgbcon, DGBCON,
5481  (F77_CONST_CHAR_ARG2 (&job, 1),
5482  tmp_nc, n_lower, n_upper, tmp_data, ldm, pipvt,
5483  anorm, rcond, pz, piz, tmp_err
5484  F77_CHAR_ARG_LEN (1)));
5485 
5486  err = tmp_err;
5487 
5488  if (err != 0)
5489  err = -2;
5490 
5491  volatile double rcond_plus_one = rcond + 1.0;
5492 
5493  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
5494  {
5495  err = -2;
5496 
5497  if (sing_handler)
5498  {
5499  sing_handler (rcond);
5500  mattype.mark_as_rectangular ();
5501  }
5502  else
5503  octave::warn_singular_matrix (rcond);
5504  }
5505  }
5506  else
5507  rcond = 1.;
5508 
5509  if (err == 0)
5510  {
5511  char job = 'N';
5512  volatile octave_idx_type x_nz = b.nnz ();
5513  F77_INT b_nr = octave::to_f77_int (b.rows ());
5514  octave_idx_type b_nc = b.cols ();
5515  retval = SparseComplexMatrix (nr, b_nc, x_nz);
5516  retval.xcidx (0) = 0;
5517  volatile octave_idx_type ii = 0;
5518 
5519  OCTAVE_LOCAL_BUFFER (double, Bx, nr);
5520  OCTAVE_LOCAL_BUFFER (double, Bz, nr);
5521 
5522  for (volatile octave_idx_type j = 0; j < b_nc; j++)
5523  {
5524  for (octave_idx_type i = 0; i < nr; i++)
5525  {
5526  Bx[i] = 0.;
5527  Bz[i] = 0.;
5528  }
5529  for (octave_idx_type i = b.cidx (j);
5530  i < b.cidx (j+1); i++)
5531  {
5532  Complex c = b.data (i);
5533  Bx[b.ridx (i)] = c.real ();
5534  Bz[b.ridx (i)] = c.imag ();
5535  }
5536 
5537  F77_XFCN (dgbtrs, DGBTRS,
5538  (F77_CONST_CHAR_ARG2 (&job, 1),
5539  tmp_nr, n_lower, n_upper, 1, tmp_data,
5540  ldm, pipvt, Bx, b_nr, tmp_err
5541  F77_CHAR_ARG_LEN (1)));
5542 
5543  err = tmp_err;
5544 
5545  F77_XFCN (dgbtrs, DGBTRS,
5546  (F77_CONST_CHAR_ARG2 (&job, 1),
5547  tmp_nr, n_lower, n_upper, 1, tmp_data,
5548  ldm, pipvt, Bz, b_nr, tmp_err
5549  F77_CHAR_ARG_LEN (1)));
5550 
5551  err = tmp_err;
5552 
5553  // Count nonzeros in work vector and adjust
5554  // space in retval if needed
5555  octave_idx_type new_nnz = 0;
5556  for (octave_idx_type i = 0; i < nr; i++)
5557  if (Bx[i] != 0. || Bz[i] != 0.)
5558  new_nnz++;
5559 
5560  if (ii + new_nnz > x_nz)
5561  {
5562  // Resize the sparse matrix
5563  octave_idx_type sz = new_nnz * (b_nc - j) + x_nz;
5564  retval.change_capacity (sz);
5565  x_nz = sz;
5566  }
5567 
5568  for (octave_idx_type i = 0; i < nr; i++)
5569  if (Bx[i] != 0. || Bz[i] != 0.)
5570  {
5571  retval.xridx (ii) = i;
5572  retval.xdata (ii++) = Complex (Bx[i], Bz[i]);
5573  }
5574  retval.xcidx (j+1) = ii;
5575  }
5576 
5577  retval.maybe_compress ();
5578  }
5579  }
5580  }
5581  else if (typ != MatrixType::Banded_Hermitian)
5582  (*current_liboctave_error_handler) ("incorrect matrix type");
5583  }
5584 
5585  return retval;
5586 }
5587 
5588 void *
5589 SparseMatrix::factorize (octave_idx_type& err, double& rcond, Matrix& Control,
5590  Matrix& Info, solve_singularity_handler sing_handler,
5591  bool calc_cond) const
5592 {
5593  // The return values
5594  void *Numeric = nullptr;
5595  err = 0;
5596 
5597 #if defined (HAVE_UMFPACK)
5598 
5599  // Setup the control parameters
5600  Control = Matrix (UMFPACK_CONTROL, 1);
5601  double *control = Control.fortran_vec ();
5602  UMFPACK_DNAME (defaults) (control);
5603 
5604  double tmp = octave::sparse_params::get_key ("spumoni");
5605  if (! octave::math::isnan (tmp))
5606  Control (UMFPACK_PRL) = tmp;
5607  tmp = octave::sparse_params::get_key ("piv_tol");
5608  if (! octave::math::isnan (tmp))
5609  {
5610  Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp;
5611  Control (UMFPACK_PIVOT_TOLERANCE) = tmp;
5612  }
5613 
5614  // Set whether we are allowed to modify Q or not
5615  tmp = octave::sparse_params::get_key ("autoamd");
5616  if (! octave::math::isnan (tmp))
5617  Control (UMFPACK_FIXQ) = tmp;
5618 
5619  UMFPACK_DNAME (report_control) (control);
5620 
5621  const octave_idx_type *Ap = cidx ();
5622  const octave_idx_type *Ai = ridx ();
5623  const double *Ax = data ();
5624  octave_idx_type nr = rows ();
5625  octave_idx_type nc = cols ();
5626 
5627  UMFPACK_DNAME (report_matrix) (nr, nc,
5628  octave::to_suitesparse_intptr (Ap),
5629  octave::to_suitesparse_intptr (Ai),
5630  Ax, 1, control);
5631 
5632  void *Symbolic;
5633  Info = Matrix (1, UMFPACK_INFO);
5634  double *info = Info.fortran_vec ();
5635  int status = UMFPACK_DNAME (qsymbolic) (nr, nc,
5636  octave::to_suitesparse_intptr (Ap),
5637  octave::to_suitesparse_intptr (Ai),
5638  Ax, nullptr, &Symbolic, control, info);
5639 
5640  if (status < 0)
5641  {
5642  UMFPACK_DNAME (report_status) (control, status);
5643  UMFPACK_DNAME (report_info) (control, info);
5644 
5645  UMFPACK_DNAME (free_symbolic) (&Symbolic);
5646 
5647  // FIXME: Should this be a warning?
5648  (*current_liboctave_error_handler)
5649  ("SparseMatrix::solve symbolic factorization failed");
5650  err = -1;
5651  }
5652  else
5653  {
5654  UMFPACK_DNAME (report_symbolic) (Symbolic, control);
5655 
5656  status = UMFPACK_DNAME (numeric) (octave::to_suitesparse_intptr (Ap),
5657  octave::to_suitesparse_intptr (Ai),
5658  Ax, Symbolic, &Numeric, control, info);
5659  UMFPACK_DNAME (free_symbolic) (&Symbolic);
5660 
5661  if (calc_cond)
5662  rcond = Info (UMFPACK_RCOND);
5663  else
5664  rcond = 1.;
5665  volatile double rcond_plus_one = rcond + 1.0;
5666 
5667  if (status == UMFPACK_WARNING_singular_matrix
5668  || rcond_plus_one == 1.0 || octave::math::isnan (rcond))
5669  {
5670  UMFPACK_DNAME (report_numeric) (Numeric, control);
5671 
5672  err = -2;
5673 
5674  if (sing_handler)
5675  sing_handler (rcond);
5676  else
5677  octave::warn_singular_matrix (rcond);
5678  }
5679  else if (status < 0)
5680  {
5681  UMFPACK_DNAME (report_status) (control, status);
5682  UMFPACK_DNAME (report_info) (control, info);
5683 
5684  // FIXME: Should this be a warning?
5685  (*current_liboctave_error_handler)
5686  ("SparseMatrix::solve numeric factorization failed");
5687 
5688  err = -1;
5689  }
5690  else
5691  {
5692  UMFPACK_DNAME (report_numeric) (Numeric, control);
5693  }
5694  }
5695 
5696  if (err != 0)
5697  UMFPACK_DNAME (free_numeric) (&Numeric);
5698 
5699 #else
5700 
5701  octave_unused_parameter (rcond);
5702  octave_unused_parameter (Control);
5703  octave_unused_parameter (Info);
5704  octave_unused_parameter (sing_handler);
5705  octave_unused_parameter (calc_cond);
5706 
5707  (*current_liboctave_error_handler)
5708  ("support for UMFPACK was unavailable or disabled "
5709  "when liboctave was built");
5710 
5711 #endif
5712 
5713  return Numeric;
5714 }
5715 
5716 Matrix
5717 SparseMatrix::fsolve (MatrixType& mattype, const Matrix& b,
5718  octave_idx_type& err, double& rcond,
5719  solve_singularity_handler sing_handler,
5720  bool calc_cond) const
5721 {
5722  Matrix retval;
5723 
5724  octave_idx_type nr = rows ();
5725  octave_idx_type nc = cols ();
5726  err = 0;
5727 
5728  if (nr != nc || nr != b.rows ())
5729  (*current_liboctave_error_handler)
5730  ("matrix dimension mismatch solution of linear equations");
5731 
5732  if (nr == 0 || b.cols () == 0)
5733  retval = Matrix (nc, b.cols (), 0.0);
5734  else
5735  {
5736  // Print spparms("spumoni") info if requested
5737  volatile int typ = mattype.type ();
5738  mattype.info ();
5739 
5740  if (typ == MatrixType::Hermitian)
5741  {
5742 #if defined (HAVE_CHOLMOD)
5743  cholmod_common Common;
5744  cholmod_common *cm = &Common;
5745 
5746  // Setup initial parameters
5747  CHOLMOD_NAME(start) (cm);
5748  cm->prefer_zomplex = false;
5749 
5750  double spu = octave::sparse_params::get_key ("spumoni");
5751  if (spu == 0.)
5752  {
5753  cm->print = -1;
5754  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, nullptr);
5755  }
5756  else
5757  {
5758  cm->print = static_cast<int> (spu) + 2;
5759  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, &SparseCholPrint);
5760  }
5761 
5762  cm->error_handler = &SparseCholError;
5763  SUITESPARSE_ASSIGN_FPTR2 (divcomplex_func, cm->complex_divide, divcomplex);
5764  SUITESPARSE_ASSIGN_FPTR2 (hypot_func, cm->hypotenuse, hypot);
5765 
5766  cm->final_ll = true;
5767 
5768  cholmod_sparse Astore;
5769  cholmod_sparse *A = &Astore;
5770  A->nrow = nr;
5771  A->ncol = nc;
5772 
5773  A->p = cidx ();
5774  A->i = ridx ();
5775  A->nzmax = nnz ();
5776  A->packed = true;
5777  A->sorted = true;
5778  A->nz = nullptr;
5779 #if defined (OCTAVE_ENABLE_64)
5780  A->itype = CHOLMOD_LONG;
5781 #else
5782  A->itype = CHOLMOD_INT;
5783 #endif
5784  A->dtype = CHOLMOD_DOUBLE;
5785  A->stype = 1;
5786  A->xtype = CHOLMOD_REAL;
5787 
5788  A->x = data ();
5789 
5790  cholmod_dense Bstore;
5791  cholmod_dense *B = &Bstore;
5792  B->nrow = b.rows ();
5793  B->ncol = b.cols ();
5794  B->d = B->nrow;
5795  B->nzmax = B->nrow * B->ncol;
5796  B->dtype = CHOLMOD_DOUBLE;
5797  B->xtype = CHOLMOD_REAL;
5798 
5799  B->x = const_cast<double *> (b.data ());
5800 
5801  cholmod_factor *L = CHOLMOD_NAME(analyze) (A, cm);
5802  CHOLMOD_NAME(factorize) (A, L, cm);
5803  if (calc_cond)
5804  rcond = CHOLMOD_NAME(rcond)(L, cm);
5805  else
5806  rcond = 1.0;
5807 
5808  if (rcond == 0.0)
5809  {
5810  // Either its indefinite or singular. Try UMFPACK
5811  mattype.mark_as_unsymmetric ();
5812  typ = MatrixType::Full;
5813  }
5814  else
5815  {
5816  volatile double rcond_plus_one = rcond + 1.0;
5817 
5818  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
5819  {
5820  err = -2;
5821 
5822  if (sing_handler)
5823  {
5824  sing_handler (rcond);
5825  mattype.mark_as_rectangular ();
5826  }
5827  else
5828  octave::warn_singular_matrix (rcond);
5829 
5830  return retval;
5831  }
5832 
5833  cholmod_dense *X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm);
5834 
5835  retval.resize (b.rows (), b.cols ());
5836  for (octave_idx_type j = 0; j < b.cols (); j++)
5837  {
5838  octave_idx_type jr = j * b.rows ();
5839  for (octave_idx_type i = 0; i < b.rows (); i++)
5840  retval.xelem (i, j) = static_cast<double *> (X->x)[jr + i];
5841  }
5842 
5843  CHOLMOD_NAME(free_dense) (&X, cm);
5844  CHOLMOD_NAME(free_factor) (&L, cm);
5845  CHOLMOD_NAME(finish) (cm);
5846  static char blank_name[] = " ";
5847  CHOLMOD_NAME(print_common) (blank_name, cm);
5848  }
5849 #else
5850  (*current_liboctave_warning_with_id_handler)
5851  ("Octave:missing-dependency",
5852  "support for CHOLMOD was unavailable or disabled "
5853  "when liboctave was built");
5854 
5855  mattype.mark_as_unsymmetric ();
5856  typ = MatrixType::Full;
5857 #endif
5858  }
5859 
5860  if (typ == MatrixType::Full)
5861  {
5862 #if defined (HAVE_UMFPACK)
5863  Matrix Control, Info;
5864  void *Numeric
5865  = factorize (err, rcond, Control, Info, sing_handler, calc_cond);
5866 
5867  if (err == 0)
5868  {
5869  // one iterative refinement instead of the default two in UMFPACK
5870  Control (UMFPACK_IRSTEP) = 1;
5871  const double *Bx = b.data ();
5872  retval.resize (b.rows (), b.cols ());
5873  double *result = retval.fortran_vec ();
5874  octave_idx_type b_nr = b.rows ();
5875  octave_idx_type b_nc = b.cols ();
5876  int status = 0;
5877  double *control = Control.fortran_vec ();
5878  double *info = Info.fortran_vec ();
5879  const octave_idx_type *Ap = cidx ();
5880  const octave_idx_type *Ai = ridx ();
5881  const double *Ax = data ();
5882 
5883  for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr)
5884  {
5885  status = UMFPACK_DNAME (solve) (UMFPACK_A,
5886  octave::to_suitesparse_intptr (Ap),
5887  octave::to_suitesparse_intptr (Ai),
5888  Ax, &result[iidx], &Bx[iidx],
5889  Numeric, control, info);
5890  if (status < 0)
5891  {
5892  UMFPACK_DNAME (report_status) (control, status);
5893 
5894  // FIXME: Should this be a warning?
5895  (*current_liboctave_error_handler)
5896  ("SparseMatrix::solve solve failed");
5897 
5898  err = -1;
5899  break;
5900  }
5901  }
5902 
5903  UMFPACK_DNAME (report_info) (control, info);
5904 
5905  UMFPACK_DNAME (free_numeric) (&Numeric);
5906  }
5907  else
5908  mattype.mark_as_rectangular ();
5909 
5910 #else
5911  octave_unused_parameter (rcond);
5912  octave_unused_parameter (sing_handler);
5913  octave_unused_parameter (calc_cond);
5914 
5915  (*current_liboctave_error_handler)
5916  ("support for UMFPACK was unavailable or disabled "
5917  "when liboctave was built");
5918 #endif
5919  }
5920  else if (typ != MatrixType::Hermitian)
5921  (*current_liboctave_error_handler) ("incorrect matrix type");
5922  }
5923 
5924  return retval;
5925 }
5926 
5927 SparseMatrix
5928 SparseMatrix::fsolve (MatrixType& mattype, const SparseMatrix& b,
5929  octave_idx_type& err, double& rcond,
5930  solve_singularity_handler sing_handler,
5931  bool calc_cond) const
5932 {
5933  SparseMatrix retval;
5934 
5935  octave_idx_type nr = rows ();
5936  octave_idx_type nc = cols ();
5937  err = 0;
5938 
5939  if (nr != nc || nr != b.rows ())
5940  (*current_liboctave_error_handler)
5941  ("matrix dimension mismatch solution of linear equations");
5942 
5943  if (nr == 0 || b.cols () == 0)
5944  retval = SparseMatrix (nc, b.cols ());
5945  else
5946  {
5947  // Print spparms("spumoni") info if requested
5948  volatile int typ = mattype.type ();
5949  mattype.info ();
5950 
5951  if (typ == MatrixType::Hermitian)
5952  {
5953 #if defined (HAVE_CHOLMOD)
5954  cholmod_common Common;
5955  cholmod_common *cm = &Common;
5956 
5957  // Setup initial parameters
5958  CHOLMOD_NAME(start) (cm);
5959  cm->prefer_zomplex = false;
5960 
5961  double spu = octave::sparse_params::get_key ("spumoni");
5962  if (spu == 0.)
5963  {
5964  cm->print = -1;
5965  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, nullptr);
5966  }
5967  else
5968  {
5969  cm->print = static_cast<int> (spu) + 2;
5970  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, &SparseCholPrint);
5971  }
5972 
5973  cm->error_handler = &SparseCholError;
5974  SUITESPARSE_ASSIGN_FPTR2 (divcomplex_func, cm->complex_divide, divcomplex);
5975  SUITESPARSE_ASSIGN_FPTR2 (hypot_func, cm->hypotenuse, hypot);
5976 
5977  cm->final_ll = true;
5978 
5979  cholmod_sparse Astore;
5980  cholmod_sparse *A = &Astore;
5981  A->nrow = nr;
5982  A->ncol = nc;
5983 
5984  A->p = cidx ();
5985  A->i = ridx ();
5986  A->nzmax = nnz ();
5987  A->packed = true;
5988  A->sorted = true;
5989  A->nz = nullptr;
5990 #if defined (OCTAVE_ENABLE_64)
5991  A->itype = CHOLMOD_LONG;
5992 #else
5993  A->itype = CHOLMOD_INT;
5994 #endif
5995  A->dtype = CHOLMOD_DOUBLE;
5996  A->stype = 1;
5997  A->xtype = CHOLMOD_REAL;
5998 
5999  A->x = data ();
6000 
6001  cholmod_sparse Bstore;
6002  cholmod_sparse *B = &Bstore;
6003  B->nrow = b.rows ();
6004  B->ncol = b.cols ();
6005  B->p = b.cidx ();
6006  B->i = b.ridx ();
6007  B->nzmax = b.nnz ();
6008  B->packed = true;
6009  B->sorted = true;
6010  B->nz = nullptr;
6011 #if defined (OCTAVE_ENABLE_64)
6012  B->itype = CHOLMOD_LONG;
6013 #else
6014  B->itype = CHOLMOD_INT;
6015 #endif
6016  B->dtype = CHOLMOD_DOUBLE;
6017  B->stype = 0;
6018  B->xtype = CHOLMOD_REAL;
6019 
6020  B->x = b.data ();
6021 
6022  cholmod_factor *L = CHOLMOD_NAME(analyze) (A, cm);
6023  CHOLMOD_NAME(factorize) (A, L, cm);
6024  if (calc_cond)
6025  rcond = CHOLMOD_NAME(rcond)(L, cm);
6026  else
6027  rcond = 1.;
6028 
6029  if (rcond == 0.0)
6030  {
6031  // Either its indefinite or singular. Try UMFPACK
6032  mattype.mark_as_unsymmetric ();
6033  typ = MatrixType::Full;
6034  }
6035  else
6036  {
6037  volatile double rcond_plus_one = rcond + 1.0;
6038 
6039  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
6040  {
6041  err = -2;
6042 
6043  if (sing_handler)
6044  {
6045  sing_handler (rcond);
6046  mattype.mark_as_rectangular ();
6047  }
6048  else
6049  octave::warn_singular_matrix (rcond);
6050 
6051  return retval;
6052  }
6053 
6054  cholmod_sparse *X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm);
6055 
6056  retval = SparseMatrix
6057  (octave::from_size_t (X->nrow),
6058  octave::from_size_t (X->ncol),
6059  octave::from_suitesparse_long (CHOLMOD_NAME(nnz)
6060  (X, cm)));
6061  for (octave_idx_type j = 0;
6062  j <= static_cast<octave_idx_type> (X->ncol); j++)
6063  retval.xcidx (j) = static_cast<octave_idx_type *> (X->p)[j];
6064  for (octave_idx_type j = 0;
6065  j < octave::from_suitesparse_long (CHOLMOD_NAME(nnz) (X, cm));
6066  j++)
6067  {
6068  retval.xridx (j) = static_cast<octave_idx_type *> (X->i)[j];
6069  retval.xdata (j) = static_cast<double *> (X->x)[j];
6070  }
6071 
6072  CHOLMOD_NAME(free_sparse) (&X, cm);
6073  CHOLMOD_NAME(free_factor) (&L, cm);
6074  CHOLMOD_NAME(finish) (cm);
6075  static char blank_name[] = " ";
6076  CHOLMOD_NAME(print_common) (blank_name, cm);
6077  }
6078 #else
6079  (*current_liboctave_warning_with_id_handler)
6080  ("Octave:missing-dependency",
6081  "support for CHOLMOD was unavailable or disabled "
6082  "when liboctave was built");
6083 
6084  mattype.mark_as_unsymmetric ();
6085  typ = MatrixType::Full;
6086 #endif
6087  }
6088 
6089  if (typ == MatrixType::Full)
6090  {
6091 #if defined (HAVE_UMFPACK)
6092  Matrix Control, Info;
6093  void *Numeric = factorize (err, rcond, Control, Info,
6094  sing_handler, calc_cond);
6095 
6096  if (err == 0)
6097  {
6098  // one iterative refinement instead of the default two in UMFPACK
6099  Control (UMFPACK_IRSTEP) = 1;
6100  octave_idx_type b_nr = b.rows ();
6101  octave_idx_type b_nc = b.cols ();
6102  int status = 0;
6103  double *control = Control.fortran_vec ();
6104  double *info = Info.fortran_vec ();
6105  const octave_idx_type *Ap = cidx ();
6106  const octave_idx_type *Ai = ridx ();
6107  const double *Ax = data ();
6108 
6109  OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
6110  OCTAVE_LOCAL_BUFFER (double, Xx, b_nr);
6111 
6112  // Take a first guess that the number of nonzero terms
6113  // will be as many as in b
6114  octave_idx_type x_nz = b.nnz ();
6115  octave_idx_type ii = 0;
6116  retval = SparseMatrix (b_nr, b_nc, x_nz);
6117 
6118  retval.xcidx (0) = 0;
6119  for (octave_idx_type j = 0; j < b_nc; j++)
6120  {
6121 
6122  for (octave_idx_type i = 0; i < b_nr; i++)
6123  Bx[i] = b.elem (i, j);
6124 
6125  status = UMFPACK_DNAME (solve) (UMFPACK_A,
6126  octave::to_suitesparse_intptr (Ap),
6127  octave::to_suitesparse_intptr (Ai),
6128  Ax, Xx, Bx, Numeric,
6129  control, info);
6130  if (status < 0)
6131  {
6132  UMFPACK_DNAME (report_status) (control, status);
6133 
6134  // FIXME: Should this be a warning?
6135  (*current_liboctave_error_handler)
6136  ("SparseMatrix::solve solve failed");
6137 
6138  err = -1;
6139  break;
6140  }
6141 
6142  for (octave_idx_type i = 0; i < b_nr; i++)
6143  {
6144  double tmp = Xx[i];
6145  if (tmp != 0.0)
6146  {
6147  if (ii == x_nz)
6148  {
6149  // Resize the sparse matrix
6150  octave_idx_type sz;
6151  sz = (static_cast<double> (b_nc) - j) / b_nc
6152  * x_nz;
6153  sz = x_nz + (sz > 100 ? sz : 100);
6154  retval.change_capacity (sz);
6155  x_nz = sz;
6156  }
6157  retval.xdata (ii) = tmp;
6158  retval.xridx (ii++) = i;
6159  }
6160  }
6161  retval.xcidx (j+1) = ii;
6162  }
6163 
6164  retval.maybe_compress ();
6165 
6166  UMFPACK_DNAME (report_info) (control, info);
6167 
6168  UMFPACK_DNAME (free_numeric) (&Numeric);
6169  }
6170  else
6171  mattype.mark_as_rectangular ();
6172 
6173 #else
6174  octave_unused_parameter (rcond);
6175  octave_unused_parameter (sing_handler);
6176  octave_unused_parameter (calc_cond);
6177 
6178  (*current_liboctave_error_handler)
6179  ("support for UMFPACK was unavailable or disabled "
6180  "when liboctave was built");
6181 #endif
6182  }
6183  else if (typ != MatrixType::Hermitian)
6184  (*current_liboctave_error_handler) ("incorrect matrix type");
6185  }
6186 
6187  return retval;
6188 }
6189 
6190 ComplexMatrix
6191 SparseMatrix::fsolve (MatrixType& mattype, const ComplexMatrix& b,
6192  octave_idx_type& err, double& rcond,
6193  solve_singularity_handler sing_handler,
6194  bool calc_cond) const
6195 {
6196  ComplexMatrix retval;
6197 
6198  octave_idx_type nr = rows ();
6199  octave_idx_type nc = cols ();
6200  err = 0;
6201 
6202  if (nr != nc || nr != b.rows ())
6203  (*current_liboctave_error_handler)
6204  ("matrix dimension mismatch solution of linear equations");
6205 
6206  if (nr == 0 || b.cols () == 0)
6207  retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
6208  else
6209  {
6210  // Print spparms("spumoni") info if requested
6211  volatile int typ = mattype.type ();
6212  mattype.info ();
6213 
6214  if (typ == MatrixType::Hermitian)
6215  {
6216 #if defined (HAVE_CHOLMOD)
6217  cholmod_common Common;
6218  cholmod_common *cm = &Common;
6219 
6220  // Setup initial parameters
6221  CHOLMOD_NAME(start) (cm);
6222  cm->prefer_zomplex = false;
6223 
6224  double spu = octave::sparse_params::get_key ("spumoni");
6225  if (spu == 0.)
6226  {
6227  cm->print = -1;
6228  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, nullptr);
6229  }
6230  else
6231  {
6232  cm->print = static_cast<int> (spu) + 2;
6233  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, &SparseCholPrint);
6234  }
6235 
6236  cm->error_handler = &SparseCholError;
6237  SUITESPARSE_ASSIGN_FPTR2 (divcomplex_func, cm->complex_divide, divcomplex);
6238  SUITESPARSE_ASSIGN_FPTR2 (hypot_func, cm->hypotenuse, hypot);
6239 
6240  cm->final_ll = true;
6241 
6242  cholmod_sparse Astore;
6243  cholmod_sparse *A = &Astore;
6244  A->nrow = nr;
6245  A->ncol = nc;
6246 
6247  A->p = cidx ();
6248  A->i = ridx ();
6249  A->nzmax = nnz ();
6250  A->packed = true;
6251  A->sorted = true;
6252  A->nz = nullptr;
6253 #if defined (OCTAVE_ENABLE_64)
6254  A->itype = CHOLMOD_LONG;
6255 #else
6256  A->itype = CHOLMOD_INT;
6257 #endif
6258  A->dtype = CHOLMOD_DOUBLE;
6259  A->stype = 1;
6260  A->xtype = CHOLMOD_REAL;
6261 
6262  A->x = data ();
6263 
6264  cholmod_dense Bstore;
6265  cholmod_dense *B = &Bstore;
6266  B->nrow = b.rows ();
6267  B->ncol = b.cols ();
6268  B->d = B->nrow;
6269  B->nzmax = B->nrow * B->ncol;
6270  B->dtype = CHOLMOD_DOUBLE;
6271  B->xtype = CHOLMOD_COMPLEX;
6272 
6273  B->x = const_cast<Complex *> (b.data ());
6274 
6275  cholmod_factor *L = CHOLMOD_NAME(analyze) (A, cm);
6276  CHOLMOD_NAME(factorize) (A, L, cm);
6277  if (calc_cond)
6278  rcond = CHOLMOD_NAME(rcond)(L, cm);
6279  else
6280  rcond = 1.0;
6281 
6282  if (rcond == 0.0)
6283  {
6284  // Either its indefinite or singular. Try UMFPACK
6285  mattype.mark_as_unsymmetric ();
6286  typ = MatrixType::Full;
6287  }
6288  else
6289  {
6290  volatile double rcond_plus_one = rcond + 1.0;
6291 
6292  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
6293  {
6294  err = -2;
6295 
6296  if (sing_handler)
6297  {
6298  sing_handler (rcond);
6299  mattype.mark_as_rectangular ();
6300  }
6301  else
6302  octave::warn_singular_matrix (rcond);
6303 
6304  return retval;
6305  }
6306 
6307  cholmod_dense *X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm);
6308 
6309  retval.resize (b.rows (), b.cols ());
6310  for (octave_idx_type j = 0; j < b.cols (); j++)
6311  {
6312  octave_idx_type jr = j * b.rows ();
6313  for (octave_idx_type i = 0; i < b.rows (); i++)
6314  retval.xelem (i, j) = static_cast<Complex *> (X->x)[jr + i];
6315  }
6316 
6317  CHOLMOD_NAME(free_dense) (&X, cm);
6318  CHOLMOD_NAME(free_factor) (&L, cm);
6319  CHOLMOD_NAME(finish) (cm);
6320  static char blank_name[] = " ";
6321  CHOLMOD_NAME(print_common) (blank_name, cm);
6322  }
6323 #else
6324  (*current_liboctave_warning_with_id_handler)
6325  ("Octave:missing-dependency",
6326  "support for CHOLMOD was unavailable or disabled "
6327  "when liboctave was built");
6328 
6329  mattype.mark_as_unsymmetric ();
6330  typ = MatrixType::Full;
6331 #endif
6332  }
6333 
6334  if (typ == MatrixType::Full)
6335  {
6336 #if defined (HAVE_UMFPACK)
6337  Matrix Control, Info;
6338  void *Numeric = factorize (err, rcond, Control, Info,
6339  sing_handler, calc_cond);
6340 
6341  if (err == 0)
6342  {
6343  // one iterative refinement instead of the default two in UMFPACK
6344  Control (UMFPACK_IRSTEP) = 1;
6345  octave_idx_type b_nr = b.rows ();
6346  octave_idx_type b_nc = b.cols ();
6347  int status = 0;
6348  double *control = Control.fortran_vec ();
6349  double *info = Info.fortran_vec ();
6350  const octave_idx_type *Ap = cidx ();
6351  const octave_idx_type *Ai = ridx ();
6352  const double *Ax = data ();
6353 
6354  OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
6355  OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
6356 
6357  retval.resize (b_nr, b_nc);
6358 
6359  OCTAVE_LOCAL_BUFFER (double, Xx, b_nr);
6360  OCTAVE_LOCAL_BUFFER (double, Xz, b_nr);
6361 
6362  for (octave_idx_type j = 0; j < b_nc; j++)
6363  {
6364  for (octave_idx_type i = 0; i < b_nr; i++)
6365  {
6366  Complex c = b(i, j);
6367  Bx[i] = c.real ();
6368  Bz[i] = c.imag ();
6369  }
6370 
6371  status = UMFPACK_DNAME (solve) (UMFPACK_A,
6372  octave::to_suitesparse_intptr (Ap),
6373  octave::to_suitesparse_intptr (Ai),
6374  Ax, Xx, Bx, Numeric,
6375  control, info);
6376  int status2 = UMFPACK_DNAME (solve) (UMFPACK_A,
6377  octave::to_suitesparse_intptr (Ap),
6378  octave::to_suitesparse_intptr (Ai),
6379  Ax, Xz, Bz,
6380  Numeric, control, info);
6381 
6382  if (status < 0 || status2 < 0)
6383  {
6384  UMFPACK_DNAME (report_status) (control, status);
6385 
6386  // FIXME: Should this be a warning?
6387  (*current_liboctave_error_handler)
6388  ("SparseMatrix::solve solve failed");
6389 
6390  err = -1;
6391  break;
6392  }
6393 
6394  for (octave_idx_type i = 0; i < b_nr; i++)
6395  retval(i, j) = Complex (Xx[i], Xz[i]);
6396  }
6397 
6398  UMFPACK_DNAME (report_info) (control, info);
6399 
6400  UMFPACK_DNAME (free_numeric) (&Numeric);
6401  }
6402  else
6403  mattype.mark_as_rectangular ();
6404 
6405 #else
6406  octave_unused_parameter (rcond);
6407  octave_unused_parameter (sing_handler);
6408  octave_unused_parameter (calc_cond);
6409 
6410  (*current_liboctave_error_handler)
6411  ("support for UMFPACK was unavailable or disabled "
6412  "when liboctave was built");
6413 #endif
6414  }
6415  else if (typ != MatrixType::Hermitian)
6416  (*current_liboctave_error_handler) ("incorrect matrix type");
6417  }
6418 
6419  return retval;
6420 }
6421 
6422 SparseComplexMatrix
6423 SparseMatrix::fsolve (MatrixType& mattype, const SparseComplexMatrix& b,
6424  octave_idx_type& err, double& rcond,
6425  solve_singularity_handler sing_handler,
6426  bool calc_cond) const
6427 {
6428  SparseComplexMatrix retval;
6429 
6430  octave_idx_type nr = rows ();
6431  octave_idx_type nc = cols ();
6432  err = 0;
6433 
6434  if (nr != nc || nr != b.rows ())
6435  (*current_liboctave_error_handler)
6436  ("matrix dimension mismatch solution of linear equations");
6437 
6438  if (nr == 0 || b.cols () == 0)
6439  retval = SparseComplexMatrix (nc, b.cols ());
6440  else
6441  {
6442  // Print spparms("spumoni") info if requested
6443  volatile int typ = mattype.type ();
6444  mattype.info ();
6445 
6446  if (typ == MatrixType::Hermitian)
6447  {
6448 #if defined (HAVE_CHOLMOD)
6449  cholmod_common Common;
6450  cholmod_common *cm = &Common;
6451 
6452  // Setup initial parameters
6453  CHOLMOD_NAME(start) (cm);
6454  cm->prefer_zomplex = false;
6455 
6456  double spu = octave::sparse_params::get_key ("spumoni");
6457  if (spu == 0.)
6458  {
6459  cm->print = -1;
6460  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, nullptr);
6461  }
6462  else
6463  {
6464  cm->print = static_cast<int> (spu) + 2;
6465  SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, &SparseCholPrint);
6466  }
6467 
6468  cm->error_handler = &SparseCholError;
6469  SUITESPARSE_ASSIGN_FPTR2 (divcomplex_func, cm->complex_divide, divcomplex);
6470  SUITESPARSE_ASSIGN_FPTR2 (hypot_func, cm->hypotenuse, hypot);
6471 
6472  cm->final_ll = true;
6473 
6474  cholmod_sparse Astore;
6475  cholmod_sparse *A = &Astore;
6476  A->nrow = nr;
6477  A->ncol = nc;
6478 
6479  A->p = cidx ();
6480  A->i = ridx ();
6481  A->nzmax = nnz ();
6482  A->packed = true;
6483  A->sorted = true;
6484  A->nz = nullptr;
6485 #if defined (OCTAVE_ENABLE_64)
6486  A->itype = CHOLMOD_LONG;
6487 #else
6488  A->itype = CHOLMOD_INT;
6489 #endif
6490  A->dtype = CHOLMOD_DOUBLE;
6491  A->stype = 1;
6492  A->xtype = CHOLMOD_REAL;
6493 
6494  A->x = data ();
6495 
6496  cholmod_sparse Bstore;
6497  cholmod_sparse *B = &Bstore;
6498  B->nrow = b.rows ();
6499  B->ncol = b.cols ();
6500  B->p = b.cidx ();
6501  B->i = b.ridx ();
6502  B->nzmax = b.nnz ();
6503  B->packed = true;
6504  B->sorted = true;
6505  B->nz = nullptr;
6506 #if defined (OCTAVE_ENABLE_64)
6507  B->itype = CHOLMOD_LONG;
6508 #else
6509  B->itype = CHOLMOD_INT;
6510 #endif
6511  B->dtype = CHOLMOD_DOUBLE;
6512  B->stype = 0;
6513  B->xtype = CHOLMOD_COMPLEX;
6514 
6515  B->x = b.data ();
6516 
6517  cholmod_factor *L = CHOLMOD_NAME(analyze) (A, cm);
6518  CHOLMOD_NAME(factorize) (A, L, cm);
6519  if (calc_cond)
6520  rcond = CHOLMOD_NAME(rcond)(L, cm);
6521  else
6522  rcond = 1.0;
6523 
6524  if (rcond == 0.0)
6525  {
6526  // Either its indefinite or singular. Try UMFPACK
6527  mattype.mark_as_unsymmetric ();
6528  typ = MatrixType::Full;
6529  }
6530  else
6531  {
6532  volatile double rcond_plus_one = rcond + 1.0;
6533 
6534  if (rcond_plus_one == 1.0 || octave::math::isnan (rcond))
6535  {
6536  err = -2;
6537 
6538  if (sing_handler)
6539  {
6540  sing_handler (rcond);
6541  mattype.mark_as_rectangular ();
6542  }
6543  else
6544  octave::warn_singular_matrix (rcond);
6545 
6546  return retval;
6547  }
6548 
6549  cholmod_sparse *X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm);
6550 
6551  retval = SparseComplexMatrix
6552  (octave::from_size_t (X->nrow),
6553  octave::from_size_t (X->ncol),
6554  octave::from_suitesparse_long (CHOLMOD_NAME(nnz)
6555  (X, cm)));
6556  for (octave_idx_type j = 0;
6557  j <= static_cast<octave_idx_type> (X->ncol); j++)
6558  retval.xcidx (j) = static_cast<octave_idx_type *> (X->p)[j];
6559  for (octave_idx_type j = 0;
6560  j < octave::from_suitesparse_long (CHOLMOD_NAME(nnz) (X, cm));
6561  j++)
6562  {
6563  retval.xridx (j) = static_cast<octave_idx_type *> (X->i)[j];
6564  retval.xdata (j) = static_cast<Complex *> (X->x)[j];
6565  }
6566 
6567  CHOLMOD_NAME(free_sparse) (&X, cm);
6568  CHOLMOD_NAME(free_factor) (&L, cm);
6569  CHOLMOD_NAME(finish) (cm);
6570  static char blank_name[] = " ";
6571  CHOLMOD_NAME(print_common) (blank_name, cm);
6572  }
6573 #else
6574  (*current_liboctave_warning_with_id_handler)
6575  ("Octave:missing-dependency",
6576  "support for CHOLMOD was unavailable or disabled "
6577  "when liboctave was built");
6578 
6579  mattype.mark_as_unsymmetric ();
6580  typ = MatrixType::Full;
6581 #endif
6582  }
6583 
6584  if (typ == MatrixType::Full)
6585  {
6586 #if defined (HAVE_UMFPACK)
6587  Matrix Control, Info;
6588  void *Numeric = factorize (err, rcond, Control, Info,
6589  sing_handler, calc_cond);
6590 
6591  if (err == 0)
6592  {
6593  // one iterative refinement instead of the default two in UMFPACK
6594  Control (UMFPACK_IRSTEP) = 1;
6595  octave_idx_type b_nr = b.rows ();
6596  octave_idx_type b_nc = b.cols ();
6597  int status = 0;
6598  double *control = Control.fortran_vec ();
6599  double *info = Info.fortran_vec ();
6600  const octave_idx_type *Ap = cidx ();
6601  const octave_idx_type *Ai = ridx ();
6602  const double *Ax = data ();
6603 
6604  OCTAVE_LOCAL_BUFFER (double, Bx, b_nr);
6605  OCTAVE_LOCAL_BUFFER (double, Bz, b_nr);
6606 
6607  // Take a first guess that the number of nonzero terms
6608  // will be as many as in b
6609  octave_idx_type x_nz = b.nnz ();
6610  octave_idx_type ii = 0;
6611  retval = SparseComplexMatrix (b_nr, b_nc, x_nz);
6612 
6613  OCTAVE_LOCAL_BUFFER (double, Xx, b_nr);
6614  OCTAVE_LOCAL_BUFFER (double, Xz, b_nr);
6615 
6616  retval.xcidx (0) = 0;
6617  for (octave_idx_type j = 0; j < b_nc; j++)
6618  {
6619  for (octave_idx_type i = 0; i < b_nr; i++)
6620  {
6621  Complex c = b(i, j);
6622  Bx[i] = c.real ();
6623  Bz[i] = c.imag ();
6624  }
6625 
6626  status = UMFPACK_DNAME (solve) (UMFPACK_A,
6627  octave::to_suitesparse_intptr (Ap),
6628  octave::to_suitesparse_intptr (Ai),
6629  Ax, Xx, Bx, Numeric,
6630  control, info);
6631  int status2 = UMFPACK_DNAME (solve) (UMFPACK_A,
6632  octave::to_suitesparse_intptr (Ap),
6633  octave::to_suitesparse_intptr (Ai),
6634  Ax, Xz, Bz,
6635  Numeric, control, info);
6636 
6637  if (status < 0 || status2 < 0)
6638  {
6639  UMFPACK_DNAME (report_status) (control, status);
6640 
6641  // FIXME: Should this be a warning?
6642  (*current_liboctave_error_handler)
6643  ("SparseMatrix::solve solve failed");
6644 
6645  err = -1;
6646  break;
6647  }
6648 
6649  for (octave_idx_type i = 0; i < b_nr; i++)
6650  {
6651  Complex tmp = Complex (Xx[i], Xz[i]);
6652  if (tmp != 0.0)
6653  {
6654  if (ii == x_nz)
6655  {
6656  // Resize the sparse matrix
6657  octave_idx_type sz;
6658  sz = (static_cast<double> (b_nc) - j) / b_nc
6659  * x_nz;
6660  sz = x_nz + (sz > 100 ? sz : 100);
6661  retval.change_capacity (sz);
6662  x_nz = sz;
6663  }
6664  retval.xdata (ii) = tmp;
6665  retval.xridx (ii++) = i;
6666  }
6667  }
6668  retval.xcidx (j+1) = ii;
6669  }
6670 
6671  retval.maybe_compress ();
6672 
6673  UMFPACK_DNAME (report_info) (control, info);
6674 
6675  UMFPACK_DNAME (free_numeric) (&Numeric);
6676  }
6677  else
6678  mattype.mark_as_rectangular ();
6679 #else
6680  octave_unused_parameter (rcond);
6681  octave_unused_parameter (sing_handler);
6682  octave_unused_parameter (calc_cond);
6683 
6684  (*current_liboctave_error_handler)
6685  ("support for UMFPACK was unavailable or disabled "
6686  "when liboctave was built");
6687 #endif
6688  }
6689  else if (typ != MatrixType::Hermitian)
6690  (*current_liboctave_error_handler) ("incorrect matrix type");
6691  }
6692 
6693  return retval;
6694 }
6695 
6696 Matrix
6697 SparseMatrix::solve (MatrixType& mattype, const Matrix& b) const
6698 {
6699  octave_idx_type info;
6700  double rcond;
6701  return solve (mattype, b, info, rcond, nullptr);
6702 }
6703 
6704 Matrix
6705 SparseMatrix::solve (MatrixType& mattype, const Matrix& b,
6706  octave_idx_type& info) const
6707 {
6708  double rcond;
6709  return solve (mattype, b, info, rcond, nullptr);
6710 }
6711 
6712 Matrix
6713 SparseMatrix::solve (MatrixType& mattype, const Matrix& b,
6714  octave_idx_type& info, double& rcond) const
6715 {
6716  return solve (mattype, b, info, rcond, nullptr);
6717 }
6718 
6719 Matrix
6720 SparseMatrix::solve (MatrixType& mattype, const Matrix& b, octave_idx_type& err,
6721  double& rcond, solve_singularity_handler sing_handler,
6722  bool singular_fallback) const
6723 {
6724  Matrix retval;
6725  int typ = mattype.type (false);
6726 
6727  if (typ == MatrixType::Unknown)
6728  typ = mattype.type (*this);
6729 
6730  // Only calculate the condition number for CHOLMOD/UMFPACK
6731  if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
6732  retval = dsolve (mattype, b, err, rcond, sing_handler, false);
6733  else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
6734  retval = utsolve (mattype, b, err, rcond, sing_handler, false);
6735  else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
6736  retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
6737  else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
6738  retval = bsolve (mattype, b, err, rcond, sing_handler, false);
6739  else if (typ == MatrixType::Tridiagonal
6740  || typ == MatrixType::Tridiagonal_Hermitian)
6741  retval = trisolve (mattype, b, err, rcond, sing_handler, false);
6742  else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
6743  retval = fsolve (mattype, b, err, rcond, sing_handler, true);
6744  else if (typ != MatrixType::Rectangular)
6745  (*current_liboctave_error_handler) ("unknown matrix type");
6746 
6747  // Rectangular or one of the above solvers flags a singular matrix
6748  if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
6749  {
6750  rcond = 1.;
6751 #if defined (USE_QRSOLVE)
6752  retval = qrsolve (*this, b, err);
6753 #else
6754  retval = dmsolve<Matrix, SparseMatrix, Matrix> (*this, b, err);
6755 #endif
6756  }
6757 
6758  return retval;
6759 }
6760 
6761 SparseMatrix
6762 SparseMatrix::solve (MatrixType& mattype, const SparseMatrix& b) const
6763 {
6764  octave_idx_type info;
6765  double rcond;
6766  return solve (mattype, b, info, rcond, nullptr);
6767 }
6768 
6769 SparseMatrix
6770 SparseMatrix::solve (MatrixType& mattype, const SparseMatrix& b,
6771  octave_idx_type& info) const
6772 {
6773  double rcond;
6774  return solve (mattype, b, info, rcond, nullptr);
6775 }
6776 
6777 SparseMatrix
6778 SparseMatrix::solve (MatrixType& mattype, const SparseMatrix& b,
6779  octave_idx_type& info, double& rcond) const
6780 {
6781  return solve (mattype, b, info, rcond, nullptr);
6782 }
6783 
6784 SparseMatrix
6785 SparseMatrix::solve (MatrixType& mattype, const SparseMatrix& b,
6786  octave_idx_type& err, double& rcond,
6787  solve_singularity_handler sing_handler,
6788  bool singular_fallback) const
6789 {
6790  SparseMatrix retval;
6791  int typ = mattype.type (false);
6792 
6793  if (typ == MatrixType::Unknown)
6794  typ = mattype.type (*this);
6795 
6796  if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
6797  retval = dsolve (mattype, b, err, rcond, sing_handler, false);
6798  else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
6799  retval = utsolve (mattype, b, err, rcond, sing_handler, false);
6800  else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
6801  retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
6802  else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
6803  retval = bsolve (mattype, b, err, rcond, sing_handler, false);
6804  else if (typ == MatrixType::Tridiagonal
6805  || typ == MatrixType::Tridiagonal_Hermitian)
6806  retval = trisolve (mattype, b, err, rcond, sing_handler, false);
6807  else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
6808  retval = fsolve (mattype, b, err, rcond, sing_handler, true);
6809  else if (typ != MatrixType::Rectangular)
6810  (*current_liboctave_error_handler) ("unknown matrix type");
6811 
6812  if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
6813  {
6814  rcond = 1.;
6815 #if defined (USE_QRSOLVE)
6816  retval = qrsolve (*this, b, err);
6817 #else
6818  retval = dmsolve<SparseMatrix, SparseMatrix, SparseMatrix>
6819  (*this, b, err);
6820 #endif
6821  }
6822 
6823  return retval;
6824 }
6825 
6826 ComplexMatrix
6827 SparseMatrix::solve (MatrixType& mattype, const ComplexMatrix& b) const
6828 {
6829  octave_idx_type info;
6830  double rcond;
6831  return solve (mattype, b, info, rcond, nullptr);
6832 }
6833 
6834 ComplexMatrix
6835 SparseMatrix::solve (MatrixType& mattype, const ComplexMatrix& b,
6836  octave_idx_type& info) const
6837 {
6838  double rcond;
6839  return solve (mattype, b, info, rcond, nullptr);
6840 }
6841 
6842 ComplexMatrix
6843 SparseMatrix::solve (MatrixType& mattype, const ComplexMatrix& b,
6844  octave_idx_type& info, double& rcond) const
6845 {
6846  return solve (mattype, b, info, rcond, nullptr);
6847 }
6848 
6849 ComplexMatrix
6850 SparseMatrix::solve (MatrixType& mattype, const ComplexMatrix& b,
6851  octave_idx_type& err, double& rcond,
6852  solve_singularity_handler sing_handler,
6853  bool singular_fallback) const
6854 {
6855  ComplexMatrix retval;
6856  int typ = mattype.type (false);
6857 
6858  if (typ == MatrixType::Unknown)
6859  typ = mattype.type (*this);
6860 
6861  if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
6862  retval = dsolve (mattype, b, err, rcond, sing_handler, false);
6863  else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
6864  retval = utsolve (mattype, b, err, rcond, sing_handler, false);
6865  else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
6866  retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
6867  else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
6868  retval = bsolve (mattype, b, err, rcond, sing_handler, false);
6869  else if (typ == MatrixType::Tridiagonal
6870  || typ == MatrixType::Tridiagonal_Hermitian)
6871  retval = trisolve (mattype, b, err, rcond, sing_handler, false);
6872  else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
6873  retval = fsolve (mattype, b, err, rcond, sing_handler, true);
6874  else if (typ != MatrixType::Rectangular)
6875  (*current_liboctave_error_handler) ("unknown matrix type");
6876 
6877  if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
6878  {
6879  rcond = 1.;
6880 #if defined (USE_QRSOLVE)
6881  retval = qrsolve (*this, b, err);
6882 #else
6883  retval = dmsolve<ComplexMatrix, SparseMatrix, ComplexMatrix>
6884  (*this, b, err);
6885 #endif
6886  }
6887 
6888  return retval;
6889 }
6890 
6891 SparseComplexMatrix
6892 SparseMatrix::solve (MatrixType& mattype, const SparseComplexMatrix& b) const
6893 {
6894  octave_idx_type info;
6895  double rcond;
6896  return solve (mattype, b, info, rcond, nullptr);
6897 }
6898 
6899 SparseComplexMatrix
6900 SparseMatrix::solve (MatrixType& mattype, const SparseComplexMatrix& b,
6901  octave_idx_type& info) const
6902 {
6903  double rcond;
6904  return solve (mattype, b, info, rcond, nullptr);
6905 }
6906 
6907 SparseComplexMatrix
6908 SparseMatrix::solve (MatrixType& mattype, const SparseComplexMatrix& b,
6909  octave_idx_type& info, double& rcond) const
6910 {
6911  return solve (mattype, b, info, rcond, nullptr);
6912 }
6913 
6914 SparseComplexMatrix
6915 SparseMatrix::solve (MatrixType& mattype, const SparseComplexMatrix& b,
6916  octave_idx_type& err, double& rcond,
6917  solve_singularity_handler sing_handler,
6918  bool singular_fallback) const
6919 {
6920  SparseComplexMatrix retval;
6921  int typ = mattype.type (false);
6922 
6923  if (typ == MatrixType::Unknown)
6924  typ = mattype.type (*this);
6925 
6926  if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal)
6927  retval = dsolve (mattype, b, err, rcond, sing_handler, false);
6928  else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
6929  retval = utsolve (mattype, b, err, rcond, sing_handler, false);
6930  else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
6931  retval = ltsolve (mattype, b, err, rcond, sing_handler, false);
6932  else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian)
6933  retval = bsolve (mattype, b, err, rcond, sing_handler, false);
6934  else if (typ == MatrixType::Tridiagonal
6935  || typ == MatrixType::Tridiagonal_Hermitian)
6936  retval = trisolve (mattype, b, err, rcond, sing_handler, false);
6937  else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
6938  retval = fsolve (mattype, b, err, rcond, sing_handler, true);
6939  else if (typ != MatrixType::Rectangular)
6940  (*current_liboctave_error_handler) ("unknown matrix type");
6941 
6942  if (singular_fallback && mattype.type (false) == MatrixType::Rectangular)
6943  {
6944  rcond = 1.;
6945 #if defined (USE_QRSOLVE)
6946  retval = qrsolve (*this, b, err);
6947 #else
6948  retval = dmsolve<SparseComplexMatrix, SparseMatrix, SparseComplexMatrix>
6949  (*this, b, err);
6950 #endif
6951  }
6952 
6953  return retval;
6954 }
6955 
6956 ColumnVector
6957 SparseMatrix::solve (MatrixType& mattype, const ColumnVector& b) const
6958 {
6959  octave_idx_type info; double rcond;
6960  return solve (mattype, b, info, rcond);
6961 }
6962 
6963 ColumnVector
6964 SparseMatrix::solve (MatrixType& mattype, const ColumnVector& b,
6965  octave_idx_type& info) const
6966 {
6967  double rcond;
6968  return solve (mattype, b, info, rcond);
6969 }
6970 
6971 ColumnVector
6972 SparseMatrix::solve (MatrixType& mattype, const ColumnVector& b,
6973  octave_idx_type& info, double& rcond) const
6974 {
6975  return solve (mattype, b, info, rcond, nullptr);
6976 }
6977 
6978 ColumnVector
6979 SparseMatrix::solve (MatrixType& mattype, const ColumnVector& b,
6980  octave_idx_type& info, double& rcond,
6981  solve_singularity_handler sing_handler) const
6982 {
6983  Matrix tmp (b);
6984  return solve (mattype, tmp, info, rcond,
6985  sing_handler).column (static_cast<octave_idx_type> (0));
6986 }
6987 
6988 ComplexColumnVector
6989 SparseMatrix::solve (MatrixType& mattype, const ComplexColumnVector& b) const
6990 {
6991  octave_idx_type info;
6992  double rcond;
6993  return solve (mattype, b, info, rcond, nullptr);
6994 }
6995 
6996 ComplexColumnVector
6997 SparseMatrix::solve (MatrixType& mattype, const ComplexColumnVector& b,
6998  octave_idx_type& info) const
6999 {
7000  double rcond;
7001  return solve (mattype, b, info, rcond, nullptr);
7002 }
7003 
7004 ComplexColumnVector
7005 SparseMatrix::solve (MatrixType& mattype, const ComplexColumnVector& b,
7006  octave_idx_type& info,
7007  double& rcond) const
7008 {
7009  return solve (mattype, b, info, rcond, nullptr);
7010 }
7011 
7012 ComplexColumnVector
7013 SparseMatrix::solve (MatrixType& mattype, const ComplexColumnVector& b,
7014  octave_idx_type& info, double& rcond,
7015  solve_singularity_handler sing_handler) const
7016 {
7017  ComplexMatrix tmp (b);
7018  return solve (mattype, tmp, info, rcond,
7019  sing_handler).column (static_cast<octave_idx_type> (0));
7020 }
7021 
7022 Matrix
7023 SparseMatrix::solve (const Matrix& b) const
7024 {
7025  octave_idx_type info;
7026  double rcond;
7027  return solve (b, info, rcond, nullptr);
7028 }
7029 
7030 Matrix
7031 SparseMatrix::solve (const Matrix& b, octave_idx_type& info) const
7032 {
7033  double rcond;
7034  return solve (b, info, rcond, nullptr);
7035 }
7036 
7037 Matrix
7038 SparseMatrix::solve (const Matrix& b, octave_idx_type& info,
7039  double& rcond) const
7040 {
7041  return solve (b, info, rcond, nullptr);
7042 }
7043 
7044 Matrix
7045 SparseMatrix::solve (const Matrix& b, octave_idx_type& err, double& rcond,
7046  solve_singularity_handler sing_handler) const
7047 {
7048  MatrixType mattype (*this);
7049  return solve (mattype, b, err, rcond, sing_handler);
7050 }
7051 
7052 SparseMatrix
7053 SparseMatrix::solve (const SparseMatrix& b) const
7054 {
7055  octave_idx_type info;
7056  double rcond;
7057  return solve (b, info, rcond, nullptr);
7058 }
7059 
7060 SparseMatrix
7061 SparseMatrix::solve (const SparseMatrix& b,
7062  octave_idx_type& info) const
7063 {
7064  double rcond;
7065  return solve (b, info, rcond, nullptr);
7066 }
7067 
7068 SparseMatrix
7069 SparseMatrix::solve (const SparseMatrix& b,
7070  octave_idx_type& info, double& rcond) const
7071 {
7072  return solve (b, info, rcond, nullptr);
7073 }
7074 
7075 SparseMatrix
7076 SparseMatrix::solve (const SparseMatrix& b, octave_idx_type& err, double& rcond,
7077  solve_singularity_handler sing_handler) const
7078 {
7079  MatrixType mattype (*this);
7080  return solve (mattype, b, err, rcond, sing_handler);
7081 }
7082 
7083 ComplexMatrix
7084 SparseMatrix::solve (const ComplexMatrix& b, octave_idx_type& info) const
7085 {
7086  double rcond;
7087  return solve (b, info, rcond, nullptr);
7088 }
7089 
7090 ComplexMatrix
7091 SparseMatrix::solve (const ComplexMatrix& b, octave_idx_type& info,
7092  double& rcond) const
7093 {
7094  return solve (b, info, rcond, nullptr);
7095 }
7096 
7097 ComplexMatrix
7098 SparseMatrix::solve (const ComplexMatrix& b, octave_idx_type& err,
7099  double& rcond,
7100  solve_singularity_handler sing_handler) const
7101 {
7102  MatrixType mattype (*this);
7103  return solve (mattype, b, err, rcond, sing_handler);
7104 }
7105 
7106 SparseComplexMatrix
7107 SparseMatrix::solve (const SparseComplexMatrix& b) const
7108 {
7109  octave_idx_type info;
7110  double rcond;
7111  return solve (b, info, rcond, nullptr);
7112 }
7113 
7114 SparseComplexMatrix
7115 SparseMatrix::solve (const SparseComplexMatrix& b, octave_idx_type& info) const
7116 {
7117  double rcond;
7118  return solve (b, info, rcond, nullptr);
7119 }
7120 
7121 SparseComplexMatrix
7122 SparseMatrix::solve (const SparseComplexMatrix& b, octave_idx_type& info,
7123  double& rcond) const
7124 {
7125  return solve (b, info, rcond, nullptr);
7126 }
7127 
7128 SparseComplexMatrix
7129 SparseMatrix::solve (const SparseComplexMatrix& b,
7130  octave_idx_type& err, double& rcond,
7131  solve_singularity_handler sing_handler) const
7132 {
7133  MatrixType mattype (*this);
7134  return solve (mattype, b, err, rcond, sing_handler);
7135 }
7136 
7137 ColumnVector
7138 SparseMatrix::solve (const ColumnVector& b) const
7139 {
7140  octave_idx_type info; double rcond;
7141  return solve (b, info, rcond);
7142 }
7143 
7144 ColumnVector
7145 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info) const
7146 {
7147  double rcond;
7148  return solve (b, info, rcond);
7149 }
7150 
7151 ColumnVector
7152 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info,
7153  double& rcond) const
7154 {
7155  return solve (b, info, rcond, nullptr);
7156 }
7157 
7158 ColumnVector
7159 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info,
7160  double& rcond,
7161  solve_singularity_handler sing_handler) const
7162 {
7163  Matrix tmp (b);
7164  return solve (tmp, info, rcond,
7165  sing_handler).column (static_cast<octave_idx_type> (0));
7166 }
7167 
7168 ComplexColumnVector
7169 SparseMatrix::solve (const ComplexColumnVector& b) const
7170 {
7171  octave_idx_type info;
7172  double rcond;
7173  return solve (b, info, rcond, nullptr);
7174 }
7175 
7176 ComplexColumnVector
7177 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const
7178 {
7179  double rcond;
7180  return solve (b, info, rcond, nullptr);
7181 }
7182 
7183 ComplexColumnVector
7184 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info,
7185  double& rcond) const
7186 {
7187  return solve (b, info, rcond, nullptr);
7188 }
7189 
7190 ComplexColumnVector
7191 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info,
7192  double& rcond,
7193  solve_singularity_handler sing_handler) const
7194 {
7195  ComplexMatrix tmp (b);
7196  return solve (tmp, info, rcond,
7197  sing_handler).column (static_cast<octave_idx_type> (0));
7198 }
7199 
7200 // other operations.
7201 
7202 bool
7203 SparseMatrix::any_element_is_negative (bool neg_zero) const
7204 {
7205  octave_idx_type nel = nnz ();
7206 
7207  if (neg_zero)
7208  {
7209  for (octave_idx_type i = 0; i < nel; i++)
7210  if (lo_ieee_signbit (data (i)))
7211  return true;
7212  }
7213  else
7214  {
7215  for (octave_idx_type i = 0; i < nel; i++)
7216  if (data (i) < 0)
7217  return true;
7218  }
7219 
7220  return false;
7221 }
7222 
7223 bool
7224 SparseMatrix::any_element_is_nan () const
7225 {
7226  octave_idx_type nel = nnz ();
7227 
7228  for (octave_idx_type i = 0; i < nel; i++)
7229  {
7230  double val = data (i);
7231  if (octave::math::isnan (val))
7232  return true;
7233  }
7234 
7235  return false;
7236 }
7237 
7238 bool
7239 SparseMatrix::any_element_is_inf_or_nan () const
7240 {
7241  octave_idx_type nel = nnz ();
7242 
7243  for (octave_idx_type i = 0; i < nel; i++)
7244  {
7245  double val = data (i);
7246  if (octave::math::isinf (val) || octave::math::isnan (val))
7247  return true;
7248  }
7249 
7250  return false;
7251 }
7252 
7253 bool
7254 SparseMatrix::any_element_not_one_or_zero () const
7255 {
7256  octave_idx_type nel = nnz ();
7257 
7258  for (octave_idx_type i = 0; i < nel; i++)
7259  {
7260  double val = data (i);
7261  if (val != 0.0 && val != 1.0)
7262  return true;
7263  }
7264 
7265  return false;
7266 }
7267 
7268 bool
7269 SparseMatrix::all_elements_are_zero () const
7270 {
7271  octave_idx_type nel = nnz ();
7272 
7273  for (octave_idx_type i = 0; i < nel; i++)
7274  if (data (i) != 0)
7275  return false;
7276 
7277  return true;
7278 }
7279 
7280 bool
7281 SparseMatrix::all_elements_are_int_or_inf_or_nan () const
7282 {
7283  octave_idx_type nel = nnz ();
7284 
7285  for (octave_idx_type i = 0; i < nel; i++)
7286  {
7287  double val = data (i);
7288  if (octave::math::isnan (val) || octave::math::x_nint (val) == val)
7289  continue;
7290  else
7291  return false;
7292  }
7293 
7294  return true;
7295 }
7296 
7297 // Return nonzero if any element of M is not an integer. Also extract
7298 // the largest and smallest values and return them in MAX_VAL and MIN_VAL.
7299 
7300 bool
7301 SparseMatrix::all_integers (double& max_val, double& min_val) const
7302 {
7303  octave_idx_type nel = nnz ();
7304 
7305  if (nel == 0)
7306  return false;
7307 
7308  max_val = data (0);
7309  min_val = data (0);
7310 
7311  for (octave_idx_type i = 0; i < nel; i++)
7312  {
7313  double val = data (i);
7314 
7315  if (val > max_val)
7316  max_val = val;
7317 
7318  if (val < min_val)
7319  min_val = val;
7320 
7321  if (octave::math::x_nint (val) != val)
7322  return false;
7323  }
7324 
7325  return true;
7326 }
7327 
7328 bool
7329 SparseMatrix::too_large_for_float () const
7330 {
7331  return test_any (octave::too_large_for_float);
7332 }
7333 
7334 SparseBoolMatrix
7335 SparseMatrix::operator ! () const
7336 {
7337  if (any_element_is_nan ())
7338  octave::err_nan_to_logical_conversion ();
7339 
7340  octave_idx_type nr = rows ();
7341  octave_idx_type nc = cols ();
7342  octave_idx_type nz1 = nnz ();
7343  octave_idx_type nz2 = nr*nc - nz1;
7344 
7345  SparseBoolMatrix r (nr, nc, nz2);
7346 
7347  octave_idx_type ii = 0;
7348  octave_idx_type jj = 0;
7349  r.cidx (0) = 0;
7350  for (octave_idx_type i = 0; i < nc; i++)
7351  {
7352  for (octave_idx_type j = 0; j < nr; j++)
7353  {
7354  if (jj < cidx (i+1) && ridx (jj) == j)
7355  jj++;
7356  else
7357  {
7358  r.data (ii) = true;
7359  r.ridx (ii++) = j;
7360  }
7361  }
7362  r.cidx (i+1) = ii;
7363  }
7364 
7365  return r;
7366 }
7367 
7368 // FIXME: Do these really belong here? Maybe they should be in a base class?
7369 
7370 SparseBoolMatrix
7371 SparseMatrix::all (int dim) const
7372 {
7373  SPARSE_ALL_OP (dim);
7374 }
7375 
7376 SparseBoolMatrix
7377 SparseMatrix::any (int dim) const
7378 {
7379  SPARSE_ANY_OP (dim);
7380 }
7381 
7382 SparseMatrix
7383 SparseMatrix::cumprod (int dim) const
7384 {
7385  SPARSE_CUMPROD (SparseMatrix, double, cumprod);
7386 }
7387 
7388 SparseMatrix
7389 SparseMatrix::cumsum (int dim) const
7390 {
7391  SPARSE_CUMSUM (SparseMatrix, double, cumsum);
7392 }
7393 
7394 SparseMatrix
7395 SparseMatrix::prod (int dim) const
7396 {
7397  if ((rows () == 1 && dim == -1) || dim == 1)
7398  return transpose ().prod (0).transpose ();
7399  else
7400  {
7401  SPARSE_REDUCTION_OP (SparseMatrix, double, *=,
7402  (cidx (j+1) - cidx (j) < nr ? 0.0 : 1.0), 1.0);
7403  }
7404 }
7405 
7406 SparseMatrix
7407 SparseMatrix::sum (int dim) const
7408 {
7409  SPARSE_REDUCTION_OP (SparseMatrix, double, +=, 0.0, 0.0);
7410 }
7411 
7412 SparseMatrix
7413 SparseMatrix::sumsq (int dim) const
7414 {
7415 #define ROW_EXPR \
7416  double d = data (i); \
7417  tmp[ridx (i)] += d * d
7418 
7419 #define COL_EXPR \
7420  double d = data (i); \
7421  tmp[j] += d * d
7422 
7423  SPARSE_BASE_REDUCTION_OP (SparseMatrix, double, ROW_EXPR, COL_EXPR,
7424  0.0, 0.0);
7425 
7426 #undef ROW_EXPR
7427 #undef COL_EXPR
7428 }
7429 
7430 SparseMatrix
7431 SparseMatrix::abs () const
7432 {
7433  octave_idx_type nz = nnz ();
7434 
7435  SparseMatrix retval (*this);
7436 
7437  for (octave_idx_type i = 0; i < nz; i++)
7438  retval.data (i) = fabs (retval.data (i));
7439 
7440  return retval;
7441 }
7442 
7443 SparseMatrix
7444 SparseMatrix::diag (octave_idx_type k) const
7445 {
7446  return MSparse<double>::diag (k);
7447 }
7448 
7449 Matrix
7450 SparseMatrix::matrix_value () const
7451 {
7452  return Sparse<double>::array_value ();
7453 }
7454 
7455 std::ostream&
7456 operator << (std::ostream& os, const SparseMatrix& a)
7457 {
7458  octave_idx_type nc = a.cols ();
7459 
7460  // add one to the printed indices to go from
7461  // zero-based to one-based arrays
7462  for (octave_idx_type j = 0; j < nc; j++)
7463  {
7464  octave_quit ();
7465  for (octave_idx_type i = a.cidx (j); i < a.cidx (j+1); i++)
7466  {
7467  os << a.ridx (i) + 1 << ' ' << j + 1 << ' ';
7468  octave::write_value<double> (os, a.data (i));
7469  os << "\n";
7470  }
7471  }
7472 
7473  return os;
7474 }
7475 
7476 std::istream&
7477 operator >> (std::istream& is, SparseMatrix& a)
7478 {
7479  typedef SparseMatrix::element_type elt_type;
7480 
7481  return read_sparse_matrix<elt_type> (is, a, octave::read_value<double>);
7482 }
7483 
7484 SparseMatrix
7485 SparseMatrix::squeeze () const
7486 {
7487  return MSparse<double>::squeeze ();
7488 }
7489 
7490 SparseMatrix
7491 SparseMatrix::reshape (const dim_vector& new_dims) const
7492 {
7493  return MSparse<double>::reshape (new_dims);
7494 }
7495 
7496 SparseMatrix
7497 SparseMatrix::permute (const Array<octave_idx_type>& vec, bool inv) const
7498 {
7499  return MSparse<double>::permute (vec, inv);
7500 }
7501 
7502 SparseMatrix
7503 SparseMatrix::ipermute (const Array<octave_idx_type>& vec) const
7504 {
7505  return MSparse<double>::ipermute (vec);
7506 }
7507 
7508 // matrix by matrix -> matrix operations
7509 
7510 SparseMatrix
7511 operator * (const SparseMatrix& m, const SparseMatrix& a)
7512 {
7513  SPARSE_SPARSE_MUL (SparseMatrix, double, double);
7514 }
7515 
7516 Matrix
7517 operator * (const Matrix& m, const SparseMatrix& a)
7518 {
7519  FULL_SPARSE_MUL (Matrix, double);
7520 }
7521 
7522 Matrix
7523 mul_trans (const Matrix& m, const SparseMatrix& a)
7524 {
7525  FULL_SPARSE_MUL_TRANS (Matrix, double, );
7526 }
7527 
7528 Matrix
7529 operator * (const SparseMatrix& m, const Matrix& a)
7530 {
7531  SPARSE_FULL_MUL (Matrix, double);
7532 }
7533 
7534 Matrix
7535 trans_mul (const SparseMatrix& m, const Matrix& a)
7536 {
7537  SPARSE_FULL_TRANS_MUL (Matrix, double, );
7538 }
7539 
7540 // diag * sparse and sparse * diag
7541 
7542 SparseMatrix
7543 operator * (const DiagMatrix& d, const SparseMatrix& a)
7544 {
7545  return do_mul_dm_sm<SparseMatrix> (d, a);
7546 }
7547 
7548 SparseMatrix
7549 operator * (const SparseMatrix& a, const DiagMatrix& d)
7550 {
7551  return do_mul_sm_dm<SparseMatrix> (a, d);
7552 }
7553 
7554 SparseMatrix
7555 operator + (const DiagMatrix& d, const SparseMatrix& a)
7556 {
7557  return do_add_dm_sm<SparseMatrix> (d, a);
7558 }
7559 
7560 SparseMatrix
7561 operator - (const DiagMatrix& d, const SparseMatrix& a)
7562 {
7563  return do_sub_dm_sm<SparseMatrix> (d, a);
7564 }
7565 
7566 SparseMatrix
7567 operator + (const SparseMatrix& a, const DiagMatrix& d)
7568 {
7569  return do_add_sm_dm<SparseMatrix> (a, d);
7570 }
7571 
7572 SparseMatrix
7573 operator - (const SparseMatrix& a, const DiagMatrix& d)
7574 {
7575  return do_sub_sm_dm<SparseMatrix> (a, d);
7576 }
7577 
7578 // perm * sparse and sparse * perm
7579 
7580 SparseMatrix
7581 operator * (const PermMatrix& p, const SparseMatrix& a)
7582 {
7583  return octinternal_do_mul_pm_sm (p, a);
7584 }
7585 
7586 SparseMatrix
7587 operator * (const SparseMatrix& a, const PermMatrix& p)
7588 {
7589  return octinternal_do_mul_sm_pm (a, p);
7590 }
7591 
7592 // FIXME: it would be nice to share code among the min/max functions below.
7593 
7594 #define EMPTY_RETURN_CHECK(T) \
7595  if (nr == 0 || nc == 0) \
7596  return T (nr, nc);
7597 
7598 SparseMatrix
7599 min (double d, const SparseMatrix& m)
7600 {
7601  SparseMatrix result;
7602 
7603  octave_idx_type nr = m.rows ();
7604  octave_idx_type nc = m.columns ();
7605 
7606  EMPTY_RETURN_CHECK (SparseMatrix);
7607 
7608  // Count the number of nonzero elements
7609  if (d < 0.)
7610  {
7611  result = SparseMatrix (nr, nc, d);
7612  for (octave_idx_type j = 0; j < nc; j++)
7613  for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7614  {
7615  double tmp = octave::math::min (d, m.data (i));
7616  if (tmp != 0.)
7617  {
7618  octave_idx_type idx = m.ridx (i) + j * nr;
7619  result.xdata (idx) = tmp;
7620  result.xridx (idx) = m.ridx (i);
7621  }
7622  }
7623  }
7624  else
7625  {
7626  octave_idx_type nel = 0;
7627  for (octave_idx_type j = 0; j < nc; j++)
7628  for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7629  if (octave::math::min (d, m.data (i)) != 0.)
7630  nel++;
7631 
7632  result = SparseMatrix (nr, nc, nel);
7633 
7634  octave_idx_type ii = 0;
7635  result.xcidx (0) = 0;
7636  for (octave_idx_type j = 0; j < nc; j++)
7637  {
7638  for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7639  {
7640  double tmp = octave::math::min (d, m.data (i));
7641 
7642  if (tmp != 0.)
7643  {
7644  result.xdata (ii) = tmp;
7645  result.xridx (ii++) = m.ridx (i);
7646  }
7647  }
7648  result.xcidx (j+1) = ii;
7649  }
7650  }
7651 
7652  return result;
7653 }
7654 
7655 SparseMatrix
7656 min (const SparseMatrix& m, double d)
7657 {
7658  return min (d, m);
7659 }
7660 
7661 SparseMatrix
7662 min (const SparseMatrix& a, const SparseMatrix& b)
7663 {
7664  SparseMatrix r;
7665 
7666  octave_idx_type a_nr = a.rows ();
7667  octave_idx_type a_nc = a.cols ();
7668  octave_idx_type b_nr = b.rows ();
7669  octave_idx_type b_nc = b.cols ();
7670 
7671  if (a_nr == b_nr && a_nc == b_nc)
7672  {
7673  r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ()));
7674 
7675  octave_idx_type jx = 0;
7676  r.cidx (0) = 0;
7677  for (octave_idx_type i = 0 ; i < a_nc ; i++)
7678  {
7679  octave_idx_type ja = a.cidx (i);
7680  octave_idx_type ja_max = a.cidx (i+1);
7681  bool ja_lt_max = ja < ja_max;
7682 
7683  octave_idx_type jb = b.cidx (i);
7684  octave_idx_type jb_max = b.cidx (i+1);
7685  bool jb_lt_max = jb < jb_max;
7686 
7687  while (ja_lt_max || jb_lt_max)
7688  {
7689  octave_quit ();
7690  if ((! jb_lt_max) || (ja_lt_max && (a.ridx (ja) < b.ridx (jb))))
7691  {
7692  double tmp = octave::math::min (a.data (ja), 0.);
7693  if (tmp != 0.)
7694  {
7695  r.ridx (jx) = a.ridx (ja);
7696  r.data (jx) = tmp;
7697  jx++;
7698  }
7699  ja++;
7700  ja_lt_max= ja < ja_max;
7701  }
7702  else if ((! ja_lt_max)
7703  || (jb_lt_max && (b.ridx (jb) < a.ridx (ja))))
7704  {
7705  double tmp = octave::math::min (0., b.data (jb));
7706  if (tmp != 0.)
7707  {
7708  r.ridx (jx) = b.ridx (jb);
7709  r.data (jx) = tmp;
7710  jx++;
7711  }
7712  jb++;
7713  jb_lt_max= jb < jb_max;
7714  }
7715  else
7716  {
7717  double tmp = octave::math::min (a.data (ja), b.data (jb));
7718  if (tmp != 0.)
7719  {
7720  r.data (jx) = tmp;
7721  r.ridx (jx) = a.ridx (ja);
7722  jx++;
7723  }
7724  ja++;
7725  ja_lt_max= ja < ja_max;
7726  jb++;
7727  jb_lt_max= jb < jb_max;
7728  }
7729  }
7730  r.cidx (i+1) = jx;
7731  }
7732 
7733  r.maybe_compress ();
7734  }
7735  else
7736  {
7737  if (a_nr == 0 || a_nc == 0)
7738  r.resize (a_nr, a_nc);
7739  else if (b_nr == 0 || b_nc == 0)
7740  r.resize (b_nr, b_nc);
7741  else
7742  octave::err_nonconformant ("min", a_nr, a_nc, b_nr, b_nc);
7743  }
7744 
7745  return r;
7746 }
7747 
7748 SparseMatrix
7749 max (double d, const SparseMatrix& m)
7750 {
7751  SparseMatrix result;
7752 
7753  octave_idx_type nr = m.rows ();
7754  octave_idx_type nc = m.columns ();
7755 
7756  EMPTY_RETURN_CHECK (SparseMatrix);
7757 
7758  // Count the number of nonzero elements
7759  if (d > 0.)
7760  {
7761  result = SparseMatrix (nr, nc, d);
7762  for (octave_idx_type j = 0; j < nc; j++)
7763  for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7764  {
7765  double tmp = octave::math::max (d, m.data (i));
7766 
7767  if (tmp != 0.)
7768  {
7769  octave_idx_type idx = m.ridx (i) + j * nr;
7770  result.xdata (idx) = tmp;
7771  result.xridx (idx) = m.ridx (i);
7772  }
7773  }
7774  }
7775  else
7776  {
7777  octave_idx_type nel = 0;
7778  for (octave_idx_type j = 0; j < nc; j++)
7779  for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7780  if (octave::math::max (d, m.data (i)) != 0.)
7781  nel++;
7782 
7783  result = SparseMatrix (nr, nc, nel);
7784 
7785  octave_idx_type ii = 0;
7786  result.xcidx (0) = 0;
7787  for (octave_idx_type j = 0; j < nc; j++)
7788  {
7789  for (octave_idx_type i = m.cidx (j); i < m.cidx (j+1); i++)
7790  {
7791  double tmp = octave::math::max (d, m.data (i));
7792  if (tmp != 0.)
7793  {
7794  result.xdata (ii) = tmp;
7795  result.xridx (ii++) = m.ridx (i);
7796  }
7797  }
7798  result.xcidx (j+1) = ii;
7799  }
7800  }
7801 
7802  return result;
7803 }
7804 
7805 SparseMatrix
7806 max (const SparseMatrix& m, double d)
7807 {
7808  return max (d, m);
7809 }
7810 
7811 SparseMatrix
7812 max (const SparseMatrix& a, const SparseMatrix& b)
7813 {
7814  SparseMatrix r;
7815 
7816  octave_idx_type a_nr = a.rows ();
7817  octave_idx_type a_nc = a.cols ();
7818  octave_idx_type b_nr = b.rows ();
7819  octave_idx_type b_nc = b.cols ();
7820 
7821  if (a_nr == b_nr && a_nc == b_nc)
7822  {
7823  r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ()));
7824 
7825  octave_idx_type jx = 0;
7826  r.cidx (0) = 0;
7827  for (octave_idx_type i = 0 ; i < a_nc ; i++)
7828  {
7829  octave_idx_type ja = a.cidx (i);
7830  octave_idx_type ja_max = a.cidx (i+1);
7831  bool ja_lt_max = ja < ja_max;
7832 
7833  octave_idx_type jb = b.cidx (i);
7834  octave_idx_type jb_max = b.cidx (i+1);
7835  bool jb_lt_max = jb < jb_max;
7836 
7837  while (ja_lt_max || jb_lt_max)
7838  {
7839  octave_quit ();
7840  if ((! jb_lt_max) || (ja_lt_max && (a.ridx (ja) < b.ridx (jb))))
7841  {
7842  double tmp = octave::math::max (a.data (ja), 0.);
7843  if (tmp != 0.)
7844  {
7845  r.ridx (jx) = a.ridx (ja);
7846  r.data (jx) = tmp;
7847  jx++;
7848  }
7849  ja++;
7850  ja_lt_max= ja < ja_max;
7851  }
7852  else if ((! ja_lt_max)
7853  || (jb_lt_max && (b.ridx (jb) < a.ridx (ja))))
7854  {
7855  double tmp = octave::math::max (0., b.data (jb));
7856  if (tmp != 0.)
7857  {
7858  r.ridx (jx) = b.ridx (jb);
7859  r.data (jx) = tmp;
7860  jx++;
7861  }
7862  jb++;
7863  jb_lt_max= jb < jb_max;
7864  }
7865  else
7866  {
7867  double tmp = octave::math::max (a.data (ja), b.data (jb));
7868  if (tmp != 0.)
7869  {
7870  r.data (jx) = tmp;
7871  r.ridx (jx) = a.ridx (ja);
7872  jx++;
7873  }
7874  ja++;
7875  ja_lt_max= ja < ja_max;
7876  jb++;
7877  jb_lt_max= jb < jb_max;
7878  }
7879  }
7880  r.cidx (i+1) = jx;
7881  }
7882 
7883  r.maybe_compress ();
7884  }
7885  else
7886  {
7887  if (a_nr == 0 || a_nc == 0)
7888  r.resize (a_nr, a_nc);
7889  else if (b_nr == 0 || b_nc == 0)
7890  r.resize (b_nr, b_nc);
7891  else
7892  octave::err_nonconformant ("max", a_nr, a_nc, b_nr, b_nc);
7893  }
7894 
7895  return r;
7896 }
7897 
7898 SPARSE_SMS_CMP_OPS (SparseMatrix, double)
7899 SPARSE_SMS_BOOL_OPS (SparseMatrix, double)
7900 
7901 SPARSE_SSM_CMP_OPS (double, SparseMatrix)
7902 SPARSE_SSM_BOOL_OPS (double, SparseMatrix)
7903 
7904 SPARSE_SMSM_CMP_OPS (SparseMatrix, SparseMatrix)
7905 SPARSE_SMSM_BOOL_OPS (SparseMatrix, SparseMatrix)
DET
base_det< double > DET
Definition: DET.h:86
Inf
#define Inf
Definition: Faddeeva.cc:260
NaN
#define NaN
Definition: Faddeeva.cc:261
SPARSE_SSM_BOOL_OPS
#define SPARSE_SSM_BOOL_OPS(S, M)
Definition: Sparse-op-defs.h:377
SPARSE_ANY_OP
#define SPARSE_ANY_OP(DIM)
Definition: Sparse-op-defs.h:1761
SPARSE_BASE_REDUCTION_OP
#define SPARSE_BASE_REDUCTION_OP(RET_TYPE, EL_TYPE, ROW_EXPR, COL_EXPR, INIT_VAL, MT_RESULT)
Definition: Sparse-op-defs.h:1595
SPARSE_FULL_MUL
#define SPARSE_FULL_MUL(RET_TYPE, EL_TYPE)
Definition: Sparse-op-defs.h:1929
FULL_SPARSE_MUL_TRANS
#define FULL_SPARSE_MUL_TRANS(RET_TYPE, EL_TYPE, CONJ_OP)
Definition: Sparse-op-defs.h:2031
SPARSE_SSM_CMP_OPS
#define SPARSE_SSM_CMP_OPS(S, M)
Definition: Sparse-op-defs.h:293
SPARSE_SMSM_CMP_OPS
#define SPARSE_SMSM_CMP_OPS(M1, M2)
Definition: Sparse-op-defs.h:893
SPARSE_REDUCTION_OP
#define SPARSE_REDUCTION_OP(RET_TYPE, EL_TYPE, OP, INIT_VAL, MT_RESULT)
Definition: Sparse-op-defs.h:1727
SPARSE_SMS_CMP_OPS
#define SPARSE_SMS_CMP_OPS(M, S)
Definition: Sparse-op-defs.h:120
SPARSE_SPARSE_MUL
#define SPARSE_SPARSE_MUL(RET_TYPE, RET_EL_TYPE, EL_TYPE)
Definition: Sparse-op-defs.h:1763
SPARSE_CUMSUM
#define SPARSE_CUMSUM(RET_TYPE, ELT_TYPE, FCN)
Definition: Sparse-op-defs.h:1471
SPARSE_CUMPROD
#define SPARSE_CUMPROD(RET_TYPE, ELT_TYPE, FCN)
Definition: Sparse-op-defs.h:1539
SPARSE_FULL_TRANS_MUL
#define SPARSE_FULL_TRANS_MUL(RET_TYPE, EL_TYPE, CONJ_OP)
Definition: Sparse-op-defs.h:1963
FULL_SPARSE_MUL
#define FULL_SPARSE_MUL(RET_TYPE, EL_TYPE)
Definition: Sparse-op-defs.h:1996
SPARSE_SMSM_BOOL_OPS
#define SPARSE_SMSM_BOOL_OPS(M1, M2)
Definition: Sparse-op-defs.h:1047
SPARSE_SMS_BOOL_OPS
#define SPARSE_SMS_BOOL_OPS(M, S)
Definition: Sparse-op-defs.h:204
SPARSE_ALL_OP
#define SPARSE_ALL_OP(DIM)
Definition: Sparse-op-defs.h:1752
octinternal_do_mul_pm_sm
SM octinternal_do_mul_pm_sm(const PermMatrix &p, const SM &a)
Definition: Sparse-perm-op-defs.h:72
octinternal_do_mul_sm_pm
SM octinternal_do_mul_sm_pm(const SM &a, const PermMatrix &p)
Definition: Sparse-perm-op-defs.h:156
Array::elem
T & elem(octave_idx_type n)
Size of the specified dimension.
Definition: Array.h:562
Array::fortran_vec
T * fortran_vec()
Size of the specified dimension.
Definition: Array-base.cc:1764
Array::rows
octave_idx_type rows() const
Definition: Array.h:459
Array::resize
void resize(const dim_vector &dv, const T &rfv)
Size of the specified dimension.
Definition: Array-base.cc:1023
Array::data
const T * data() const
Size of the specified dimension.
Definition: Array.h:663
Array::cols
octave_idx_type cols() const
Definition: Array.h:469
Array::xelem
T & xelem(octave_idx_type n)
Size of the specified dimension.
Definition: Array.h:524
ComplexMatrix::resize
void resize(octave_idx_type nr, octave_idx_type nc, const Complex &rfv=Complex(0))
Definition: CMatrix.h:193
DiagArray2::length
octave_idx_type length() const
Definition: DiagArray2.h:95
DiagArray2::cols
octave_idx_type cols() const
Definition: DiagArray2.h:90
MSparse::permute
MSparse< T > permute(const Array< octave_idx_type > &vec, bool inv=false) const
Definition: MSparse.h:105
MSparse::squeeze
MSparse< T > squeeze() const
Definition: MSparse.h:100
MSparse::ipermute
MSparse< T > ipermute(const Array< octave_idx_type > &vec) const
Definition: MSparse.h:108
MSparse::reshape
MSparse< T > reshape(const dim_vector &new_dims) const
Definition: MSparse.h:102
MSparse::insert
MSparse< T > & insert(const Sparse< T > &a, octave_idx_type r, octave_idx_type c)
Definition: MSparse.h:86
MSparse::diag
MSparse< T > diag(octave_idx_type k=0) const
Definition: MSparse.h:111
MatrixType::ishermitian
bool ishermitian() const
Definition: MatrixType.h:122
MatrixType::mark_as_unsymmetric
void mark_as_unsymmetric()
Definition: MatrixType.cc:920
MatrixType::Tridiagonal_Hermitian
@ Tridiagonal_Hermitian
Definition: MatrixType.h:53
MatrixType::Permuted_Lower
@ Permuted_Lower
Definition: MatrixType.h:48
MatrixType::Banded_Hermitian
@ Banded_Hermitian
Definition: MatrixType.h:51
MatrixType::Permuted_Diagonal
@ Permuted_Diagonal
Definition: MatrixType.h:44
MatrixType::Permuted_Upper
@ Permuted_Upper
Definition: MatrixType.h:47
MatrixType::triangular_perm
octave_idx_type * triangular_perm() const
Definition: MatrixType.h:136
MatrixType::nupper
int nupper() const
Definition: MatrixType.h:101
MatrixType::nlower
int nlower() const
Definition: MatrixType.h:103
MatrixType::info
void info() const
Definition: MatrixType.cc:846
MatrixType::transpose
MatrixType transpose() const
Definition: MatrixType.cc:973
MatrixType::type
int type(bool quiet=true)
Definition: MatrixType.cc:656
MatrixType::mark_as_rectangular
void mark_as_rectangular()
Definition: MatrixType.h:155
MatrixType::is_dense
bool is_dense() const
Definition: MatrixType.h:105
Matrix
Definition: dMatrix.h:42
Matrix::resize
void resize(octave_idx_type nr, octave_idx_type nc, double rfv=0)
Definition: dMatrix.h:158
Matrix::column
ColumnVector column(octave_idx_type i) const
Definition: dMatrix.cc:422
SparseComplexMatrix::insert
SparseComplexMatrix & insert(const SparseComplexMatrix &a, octave_idx_type r, octave_idx_type c)
Definition: CSparse.cc:556
SparseMatrix::insert
SparseMatrix & insert(const SparseMatrix &a, octave_idx_type r, octave_idx_type c)
Definition: dSparse.cc:171
SparseMatrix::squeeze
SparseMatrix squeeze() const
Definition: dSparse.cc:7485
SparseMatrix::issymmetric
bool issymmetric() const
Definition: dSparse.cc:131
SparseMatrix::any_element_not_one_or_zero
bool any_element_not_one_or_zero() const
Definition: dSparse.cc:7254
SparseMatrix::reshape
SparseMatrix reshape(const dim_vector &new_dims) const
Definition: dSparse.cc:7491
SparseMatrix::sum
SparseMatrix sum(int dim=-1) const
Definition: dSparse.cc:7407
SparseMatrix::any
SparseBoolMatrix any(int dim=-1) const
Definition: dSparse.cc:7377
SparseMatrix::any_element_is_inf_or_nan
bool any_element_is_inf_or_nan() const
Definition: dSparse.cc:7239
SparseMatrix::all_integers
bool all_integers(double &max_val, double &min_val) const
Definition: dSparse.cc:7301
SparseMatrix::any_element_is_nan
bool any_element_is_nan() const
Definition: dSparse.cc:7224
SparseMatrix::too_large_for_float
bool too_large_for_float() const
Definition: dSparse.cc:7329
SparseMatrix::operator==
bool operator==(const SparseMatrix &a) const
Definition: dSparse.cc:101
SparseMatrix::transpose
SparseMatrix transpose() const
Definition: dSparse.h:126
SparseMatrix::determinant
DET determinant() const
Definition: dSparse.cc:1012
SparseMatrix::abs
SparseMatrix abs() const
Definition: dSparse.cc:7431
SparseMatrix::inverse
SparseMatrix inverse() const
Definition: dSparse.cc:603
SparseMatrix::operator!=
bool operator!=(const SparseMatrix &a) const
Definition: dSparse.cc:125
SparseMatrix::row
RowVector row(octave_idx_type i) const
Definition: dSparse.cc:503
SparseMatrix::cumprod
SparseMatrix cumprod(int dim=-1) const
Definition: dSparse.cc:7383
SparseMatrix::diag
SparseMatrix diag(octave_idx_type k=0) const
Definition: dSparse.cc:7444
SparseMatrix::prod
SparseMatrix prod(int dim=-1) const
Definition: dSparse.cc:7395
SparseMatrix::all_elements_are_zero
bool all_elements_are_zero() const
Definition: dSparse.cc:7269
SparseMatrix::all
SparseBoolMatrix all(int dim=-1) const
Definition: dSparse.cc:7371
SparseMatrix::min
SparseMatrix min(int dim=-1) const
Definition: dSparse.cc:337
SparseMatrix::permute
SparseMatrix permute(const Array< octave_idx_type > &vec, bool inv=false) const
Definition: dSparse.cc:7497
SparseMatrix::cumsum
SparseMatrix cumsum(int dim=-1) const
Definition: dSparse.cc:7389
SparseMatrix::column
ColumnVector column(octave_idx_type i) const
Definition: dSparse.cc:522
SparseMatrix::concat
SparseMatrix concat(const SparseMatrix &rb, const Array< octave_idx_type > &ra_idx)
Definition: dSparse.cc:534
SparseMatrix::ipermute
SparseMatrix ipermute(const Array< octave_idx_type > &vec) const
Definition: dSparse.cc:7503
SparseMatrix::operator!
SparseBoolMatrix operator!() const
Definition: dSparse.cc:7335
SparseMatrix::sumsq
SparseMatrix sumsq(int dim=-1) const
Definition: dSparse.cc:7413
SparseMatrix::SparseMatrix
SparseMatrix()
Definition: dSparse.h:53
SparseMatrix::all_elements_are_int_or_inf_or_nan
bool all_elements_are_int_or_inf_or_nan() const
Definition: dSparse.cc:7281
SparseMatrix::solve
Matrix solve(MatrixType &typ, const Matrix &b) const
Definition: dSparse.cc:6697
SparseMatrix::max
SparseMatrix max(int dim=-1) const
Definition: dSparse.cc:186
SparseMatrix::any_element_is_negative
bool any_element_is_negative(bool=false) const
Definition: dSparse.cc:7203
SparseMatrix::matrix_value
Matrix matrix_value() const
Definition: dSparse.cc:7450
Sparse::cols
octave_idx_type cols() const
Definition: Sparse.h:352
Sparse::xcidx
octave_idx_type * xcidx()
Definition: Sparse.h:602
Sparse::xdata
T * xdata()
Definition: Sparse.h:576
Sparse::array_value
Array< T > array_value() const
Definition: Sparse.cc:2767
Sparse::columns
octave_idx_type columns() const
Definition: Sparse.h:353
Sparse::cidx
octave_idx_type * cidx()
Definition: Sparse.h:596
Sparse::data
T * data()
Definition: Sparse.h:574
Sparse::test_any
bool test_any(F fcn) const
Definition: Sparse.h:663
Sparse::ridx
octave_idx_type * ridx()
Definition: Sparse.h:583
Sparse::element_type
T element_type
Definition: Sparse.h:52
Sparse::maybe_compress
Sparse< T, Alloc > maybe_compress(bool remove_zeros=false)
Definition: Sparse.h:531
Sparse::elem
T & elem(octave_idx_type n)
Definition: Sparse.h:456
Sparse::nnz
octave_idx_type nnz() const
Actual number of nonzero terms.
Definition: Sparse.h:339
Sparse::rows
octave_idx_type rows() const
Definition: Sparse.h:351
Sparse::change_capacity
void change_capacity(octave_idx_type nz)
Definition: Sparse.h:556
Sparse::dims
dim_vector dims() const
Definition: Sparse.h:371
Sparse::xridx
octave_idx_type * xridx()
Definition: Sparse.h:589
base_det
Definition: DET.h:39
dim_vector
Vector representing the dimensions (size) of an Array.
Definition: dim-vector.h:94
dim_vector::ndims
octave_idx_type ndims() const
Number of dimensions.
Definition: dim-vector.h:257
dim_vector::first_non_singleton
int first_non_singleton(int def=0) const
Definition: dim-vector.h:444
octave_idx_type
trans_mul
Matrix trans_mul(const SparseMatrix &m, const Matrix &a)
Definition: dSparse.cc:7535
real
SparseMatrix real(const SparseComplexMatrix &a)
Definition: dSparse.cc:554
EMPTY_RETURN_CHECK
#define EMPTY_RETURN_CHECK(T)
Definition: dSparse.cc:7594
min
SparseMatrix min(double d, const SparseMatrix &m)
Definition: dSparse.cc:7599
mul_trans
Matrix mul_trans(const Matrix &m, const SparseMatrix &a)
Definition: dSparse.cc:7523
COL_EXPR
#define COL_EXPR
ROW_EXPR
#define ROW_EXPR
operator-
SparseMatrix operator-(const DiagMatrix &d, const SparseMatrix &a)
Definition: dSparse.cc:7561
max
SparseMatrix max(double d, const SparseMatrix &m)
Definition: dSparse.cc:7749
operator>>
std::istream & operator>>(std::istream &is, SparseMatrix &a)
Definition: dSparse.cc:7477
operator*
SparseMatrix operator*(const SparseMatrix &m, const SparseMatrix &a)
Definition: dSparse.cc:7511
imag
SparseMatrix imag(const SparseComplexMatrix &a)
Definition: dSparse.cc:575
operator+
SparseMatrix operator+(const DiagMatrix &d, const SparseMatrix &a)
Definition: dSparse.cc:7555
operator<<
std::ostream & operator<<(std::ostream &os, const SparseMatrix &a)
Definition: dSparse.cc:7456
F77_DBLE_CMPLX_ARG
#define F77_DBLE_CMPLX_ARG(x)
Definition: f77-fcn.h:316
F77_XFCN
#define F77_XFCN(f, F, args)
Definition: f77-fcn.h:45
F77_INT
octave_f77_int_type F77_INT
Definition: f77-fcn.h:306
err_nonconformant
void err_nonconformant(const char *op, octave_idx_type op1_len, octave_idx_type op2_len)
Definition: lo-array-errwarn.cc:71
err_nan_to_logical_conversion
void err_nan_to_logical_conversion()
Definition: lo-array-errwarn.cc:57
warn_singular_matrix
void warn_singular_matrix(double rcond)
Definition: lo-array-errwarn.cc:307
current_liboctave_error_handler
OCTAVE_NORETURN liboctave_error_handler current_liboctave_error_handler
Definition: lo-error.c:41
lo_ieee_signbit
#define lo_ieee_signbit(x)
Definition: lo-ieee.h:132
B
F77_RET_T const F77_INT F77_CMPLX const F77_INT F77_CMPLX * B
Definition: lo-lapack-proto.h:859
Q
F77_RET_T const F77_INT const F77_INT const F77_INT F77_DBLE const F77_INT F77_DBLE const F77_INT F77_DBLE * Q
Definition: lo-lapack-proto.h:995
A
F77_RET_T const F77_INT F77_CMPLX * A
Definition: lo-lapack-proto.h:858
isinf
bool isinf(double x)
Definition: lo-mappers.h:203
isnan
bool isnan(bool)
Definition: lo-mappers.h:178
x_nint
T x_nint(T x)
Definition: lo-mappers.h:269
d
F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE * d
Definition: lo-slatec-proto.h:39
too_large_for_float
bool too_large_for_float(double x)
Definition: lo-utils.cc:56
m
T octave_idx_type m
Definition: mx-inlines.cc:781
n
octave_idx_type n
Definition: mx-inlines.cc:761
r
T * r
Definition: mx-inlines.cc:781
Complex
std::complex< double > Complex
Definition: oct-cmplx.h:33
OCTAVE_LOCAL_BUFFER
#define OCTAVE_LOCAL_BUFFER(T, buf, size)
Definition: oct-locbuf.h:44
to_suitesparse_intptr
suitesparse_integer * to_suitesparse_intptr(octave_idx_type *i)
Definition: oct-sparse.cc:51
CHOLMOD_NAME
#define CHOLMOD_NAME(name)
Definition: oct-sparse.h:140
from_suitesparse_long
octave_idx_type from_suitesparse_long(SuiteSparse_long x)
Definition: oct-sparse.h:200
UMFPACK_DNAME
#define UMFPACK_DNAME(name)
Definition: oct-sparse.h:169
from_size_t
octave_idx_type from_size_t(std::size_t x)
Definition: oct-sparse.h:211
ra_idx
const octave_base_value const Array< octave_idx_type > & ra_idx
Definition: op-int-concat.cc:170
dmsolve< SparseMatrix, SparseMatrix, SparseMatrix >
template SparseMatrix dmsolve< SparseMatrix, SparseMatrix, SparseMatrix >(const SparseMatrix &, const SparseMatrix &, octave_idx_type &)
dmsolve< Matrix, SparseMatrix, Matrix >
template Matrix dmsolve< Matrix, SparseMatrix, Matrix >(const SparseMatrix &, const Matrix &, octave_idx_type &)
dmsolve< ComplexMatrix, SparseMatrix, ComplexMatrix >
template ComplexMatrix dmsolve< ComplexMatrix, SparseMatrix, ComplexMatrix >(const SparseMatrix &, const ComplexMatrix &, octave_idx_type &)
dmsolve< SparseComplexMatrix, SparseMatrix, SparseComplexMatrix >
template SparseComplexMatrix dmsolve< SparseComplexMatrix, SparseMatrix, SparseComplexMatrix >(const SparseMatrix &, const SparseComplexMatrix &, octave_idx_type &)
qrsolve
Matrix qrsolve(const SparseMatrix &a, const MArray< double > &b, octave_idx_type &info)
Definition: sparse-qr.cc:3270
SparseCholError
void SparseCholError(int status, char *file, int line, char *message)
Definition: sparse-util.cc:64
SparseCholPrint
int SparseCholPrint(const char *fmt,...)
Definition: sparse-util.cc:76