Bug Summary

File:liboctave/array/dSparse.cc
Location:line 1217, column 15
Description:Value stored to 'typ' is never read

Annotated Source Code

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