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