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