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