Mercurial > octave
annotate liboctave/dSparse.cc @ 8966:1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Date: Mon, 9 Mar 2009 17:45:22 -0400
This does not use the typical sparse-mx-ops generator. I suspect the
sematics of elementwise multiplication and division to be rather
controversial, so they are not included. If comparison operations are
added, the implementation should be shifted over to use the typical
generator.
The template in Sparse-diag-op-defs.h likely could use const bools
rather than functional argument operations. I haven't measured which
is optimized more effectively.
Also, the Octave binding layer in op-dm-scm.cc likely could use all
sorts of macro or template trickery, but it's far easier to let Emacs
handle it for now. That would be worth revisiting if further
elementwise sparse and diagonal operations are added.
| author | Jason Riedy <jason@acm.org> |
|---|---|
| date | Mon, 09 Mar 2009 17:49:14 -0400 |
| parents | f4f4d65faaa0 |
| children | 5bbbf482909a |
| rev | line source |
|---|---|
| 5164 | 1 /* |
| 2 | |
| 8920 | 3 Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 David Bateman |
| 7016 | 4 Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Andy Adler |
| 5 | |
| 6 This file is part of Octave. | |
| 5164 | 7 |
| 8 Octave is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
| 11 option) any later version. | |
| 5164 | 12 |
| 13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 7016 | 19 along with Octave; see the file COPYING. If not, see |
| 20 <http://www.gnu.org/licenses/>. | |
| 5164 | 21 |
| 22 */ | |
| 23 | |
| 24 #ifdef HAVE_CONFIG_H | |
| 25 #include <config.h> | |
| 26 #endif | |
| 27 | |
| 28 #include <cfloat> | |
| 29 | |
| 30 #include <iostream> | |
| 31 #include <vector> | |
|
8964
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
32 #include <functional> |
| 5164 | 33 |
| 34 #include "quit.h" | |
| 35 #include "lo-ieee.h" | |
| 36 #include "lo-mappers.h" | |
| 37 #include "f77-fcn.h" | |
| 38 #include "dRowVector.h" | |
|
8377
25bc2d31e1bf
improve OCTAVE_LOCAL_BUFFER
Jaroslav Hajek <highegg@gmail.com>
parents:
8366
diff
changeset
|
39 #include "oct-locbuf.h" |
| 5164 | 40 |
|
8964
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
41 #include "dDiagMatrix.h" |
| 5164 | 42 #include "CSparse.h" |
| 43 #include "boolSparse.h" | |
| 44 #include "dSparse.h" | |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
45 #include "functor.h" |
| 5164 | 46 #include "oct-spparms.h" |
| 47 #include "SparsedbleLU.h" | |
| 5785 | 48 #include "MatrixType.h" |
| 5451 | 49 #include "oct-sparse.h" |
| 5506 | 50 #include "sparse-util.h" |
| 51 #include "SparsedbleCHOL.h" | |
| 5610 | 52 #include "SparseQR.h" |
| 5164 | 53 |
|
8964
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
54 #include "Sparse-diag-op-defs.h" |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
55 |
| 5681 | 56 // Define whether to use a basic QR solver or one that uses a Dulmange |
| 57 // Mendelsohn factorization to seperate the problem into under-determined, | |
| 58 // well-determined and over-determined parts and solves them seperately | |
| 59 #ifndef USE_QRSOLVE | |
| 60 #include "sparse-dmsolve.cc" | |
| 61 #endif | |
| 62 | |
| 5164 | 63 // Fortran functions we call. |
| 64 extern "C" | |
| 65 { | |
| 66 F77_RET_T | |
| 6242 | 67 F77_FUNC (dgbtrf, DGBTRF) (const octave_idx_type&, const octave_idx_type&, |
| 68 const octave_idx_type&, const octave_idx_type&, | |
| 69 double*, const octave_idx_type&, | |
| 70 octave_idx_type*, octave_idx_type&); | |
| 5164 | 71 |
| 72 F77_RET_T | |
| 5275 | 73 F77_FUNC (dgbtrs, DGBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 74 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
| 75 const double*, const octave_idx_type&, | |
| 76 const octave_idx_type*, double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 77 F77_CHAR_ARG_LEN_DECL); |
| 78 | |
| 79 F77_RET_T | |
| 5275 | 80 F77_FUNC (dgbcon, DGBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 81 const octave_idx_type&, const octave_idx_type&, double*, | |
| 82 const octave_idx_type&, const octave_idx_type*, const double&, | |
| 83 double&, double*, octave_idx_type*, octave_idx_type& | |
| 5164 | 84 F77_CHAR_ARG_LEN_DECL); |
| 85 | |
| 86 F77_RET_T | |
| 5275 | 87 F77_FUNC (dpbtrf, DPBTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 88 const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 89 F77_CHAR_ARG_LEN_DECL); |
| 90 | |
| 91 F77_RET_T | |
| 5275 | 92 F77_FUNC (dpbtrs, DPBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 93 const octave_idx_type&, const octave_idx_type&, double*, const octave_idx_type&, | |
| 94 double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 95 F77_CHAR_ARG_LEN_DECL); |
| 96 | |
| 97 F77_RET_T | |
| 5275 | 98 F77_FUNC (dpbcon, DPBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 99 const octave_idx_type&, double*, const octave_idx_type&, | |
| 100 const double&, double&, double*, octave_idx_type*, octave_idx_type& | |
| 5164 | 101 F77_CHAR_ARG_LEN_DECL); |
| 102 F77_RET_T | |
| 5275 | 103 F77_FUNC (dptsv, DPTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, |
| 104 double*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 105 |
| 106 F77_RET_T | |
| 5275 | 107 F77_FUNC (dgtsv, DGTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, |
| 108 double*, double*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 109 |
| 110 F77_RET_T | |
| 5275 | 111 F77_FUNC (dgttrf, DGTTRF) (const octave_idx_type&, double*, double*, double*, double*, |
| 112 octave_idx_type*, octave_idx_type&); | |
| 5164 | 113 |
| 114 F77_RET_T | |
| 5275 | 115 F77_FUNC (dgttrs, DGTTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 116 const octave_idx_type&, const double*, const double*, | |
| 117 const double*, const double*, const octave_idx_type*, | |
| 118 double *, const octave_idx_type&, octave_idx_type& | |
| 5164 | 119 F77_CHAR_ARG_LEN_DECL); |
| 120 | |
| 121 F77_RET_T | |
| 5322 | 122 F77_FUNC (zptsv, ZPTSV) (const octave_idx_type&, const octave_idx_type&, double*, Complex*, |
| 5275 | 123 Complex*, const octave_idx_type&, octave_idx_type&); |
| 5164 | 124 |
| 125 F77_RET_T | |
| 5275 | 126 F77_FUNC (zgtsv, ZGTSV) (const octave_idx_type&, const octave_idx_type&, Complex*, Complex*, |
| 127 Complex*, Complex*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 128 |
| 129 } | |
| 130 | |
| 131 SparseMatrix::SparseMatrix (const SparseBoolMatrix &a) | |
| 5681 | 132 : MSparse<double> (a.rows (), a.cols (), a.nnz ()) |
| 5164 | 133 { |
| 5275 | 134 octave_idx_type nc = cols (); |
| 5681 | 135 octave_idx_type nz = a.nnz (); |
| 5275 | 136 |
| 137 for (octave_idx_type i = 0; i < nc + 1; i++) | |
| 5164 | 138 cidx (i) = a.cidx (i); |
| 139 | |
| 5275 | 140 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 141 { |
| 142 data (i) = a.data (i); | |
| 143 ridx (i) = a.ridx (i); | |
| 144 } | |
| 145 } | |
| 146 | |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
147 SparseMatrix::SparseMatrix (const DiagMatrix& a) |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
148 : MSparse<double> (a.rows (), a.cols (), a.length ()) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
149 { |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
150 octave_idx_type j = 0, l = a.length (); |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
151 for (octave_idx_type i = 0; i < l; i++) |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
152 { |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
153 cidx (i) = j; |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
154 if (a(i, i) != 0.0) |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
155 { |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
156 data (j) = a(i, i); |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
157 ridx (j) = i; |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
158 j++; |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
159 } |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
160 } |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
161 for (octave_idx_type i = l; i <= a.cols (); i++) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
162 cidx(i) = j; |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
163 } |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
164 |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
165 SparseMatrix::SparseMatrix (const PermMatrix& a) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
166 : MSparse<double> (a.rows (), a.cols (), a.rows ()) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
167 { |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
168 octave_idx_type n = a.rows (); |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
169 for (octave_idx_type i = 0; i <= n; i++) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
170 cidx (i) = i; |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
171 const Array<octave_idx_type> pv = a.pvec (); |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
172 |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
173 if (a.is_row_perm ()) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
174 { |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
175 for (octave_idx_type i = 0; i < n; i++) |
|
8951
5bce1357edd6
Fix conversion from PermMatrix to SparseMatrix.
Jason Riedy <jason@acm.org>
parents:
8920
diff
changeset
|
176 ridx (pv (i)) = i; |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
177 } |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
178 else |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
179 { |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
180 for (octave_idx_type i = 0; i < n; i++) |
|
8951
5bce1357edd6
Fix conversion from PermMatrix to SparseMatrix.
Jason Riedy <jason@acm.org>
parents:
8920
diff
changeset
|
181 ridx (i) = pv (i); |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
182 } |
|
8951
5bce1357edd6
Fix conversion from PermMatrix to SparseMatrix.
Jason Riedy <jason@acm.org>
parents:
8920
diff
changeset
|
183 |
|
5bce1357edd6
Fix conversion from PermMatrix to SparseMatrix.
Jason Riedy <jason@acm.org>
parents:
8920
diff
changeset
|
184 for (octave_idx_type i = 0; i < n; i++) |
|
5bce1357edd6
Fix conversion from PermMatrix to SparseMatrix.
Jason Riedy <jason@acm.org>
parents:
8920
diff
changeset
|
185 data (i) = 1.0; |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
186 } |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
187 |
| 5164 | 188 bool |
| 189 SparseMatrix::operator == (const SparseMatrix& a) const | |
| 190 { | |
| 5275 | 191 octave_idx_type nr = rows (); |
| 192 octave_idx_type nc = cols (); | |
| 5681 | 193 octave_idx_type nz = nnz (); |
| 5275 | 194 octave_idx_type nr_a = a.rows (); |
| 195 octave_idx_type nc_a = a.cols (); | |
| 5681 | 196 octave_idx_type nz_a = a.nnz (); |
| 5164 | 197 |
| 198 if (nr != nr_a || nc != nc_a || nz != nz_a) | |
| 199 return false; | |
| 200 | |
| 5275 | 201 for (octave_idx_type i = 0; i < nc + 1; i++) |
| 5164 | 202 if (cidx(i) != a.cidx(i)) |
| 203 return false; | |
| 204 | |
| 5275 | 205 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 206 if (data(i) != a.data(i) || ridx(i) != a.ridx(i)) |
| 207 return false; | |
| 208 | |
| 209 return true; | |
| 210 } | |
| 211 | |
| 212 bool | |
| 213 SparseMatrix::operator != (const SparseMatrix& a) const | |
| 214 { | |
| 215 return !(*this == a); | |
| 216 } | |
| 217 | |
| 218 bool | |
| 219 SparseMatrix::is_symmetric (void) const | |
| 220 { | |
| 6207 | 221 octave_idx_type nr = rows (); |
| 222 octave_idx_type nc = cols (); | |
| 223 | |
| 224 if (nr == nc && nr > 0) | |
| 5164 | 225 { |
| 6207 | 226 for (octave_idx_type j = 0; j < nc; j++) |
| 227 { | |
| 228 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 229 { | |
| 230 octave_idx_type ri = ridx(i); | |
| 231 | |
| 232 if (ri != j) | |
| 233 { | |
| 234 bool found = false; | |
| 235 | |
| 236 for (octave_idx_type k = cidx(ri); k < cidx(ri+1); k++) | |
| 237 { | |
| 238 if (ridx(k) == j) | |
| 239 { | |
| 240 if (data(i) == data(k)) | |
| 241 found = true; | |
| 242 break; | |
| 243 } | |
| 244 } | |
| 245 | |
| 246 if (! found) | |
| 247 return false; | |
| 248 } | |
| 249 } | |
| 250 } | |
| 5164 | 251 |
| 252 return true; | |
| 253 } | |
| 254 | |
| 255 return false; | |
| 256 } | |
| 257 | |
| 258 SparseMatrix& | |
| 5275 | 259 SparseMatrix::insert (const SparseMatrix& a, octave_idx_type r, octave_idx_type c) |
| 5164 | 260 { |
| 261 MSparse<double>::insert (a, r, c); | |
| 262 return *this; | |
| 263 } | |
| 264 | |
| 6823 | 265 SparseMatrix& |
| 266 SparseMatrix::insert (const SparseMatrix& a, const Array<octave_idx_type>& indx) | |
| 267 { | |
| 268 MSparse<double>::insert (a, indx); | |
| 269 return *this; | |
| 270 } | |
| 271 | |
| 5164 | 272 SparseMatrix |
| 273 SparseMatrix::max (int dim) const | |
| 274 { | |
| 5275 | 275 Array2<octave_idx_type> dummy_idx; |
| 5164 | 276 return max (dummy_idx, dim); |
| 277 } | |
| 278 | |
| 279 SparseMatrix | |
| 5275 | 280 SparseMatrix::max (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 281 { |
| 282 SparseMatrix result; | |
| 283 dim_vector dv = dims (); | |
| 284 | |
| 285 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 286 return result; | |
| 287 | |
| 5275 | 288 octave_idx_type nr = dv(0); |
| 289 octave_idx_type nc = dv(1); | |
| 5164 | 290 |
| 291 if (dim == 0) | |
| 292 { | |
| 293 idx_arg.resize (1, nc); | |
| 5275 | 294 octave_idx_type nel = 0; |
| 295 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 296 { |
| 297 double tmp_max = octave_NaN; | |
| 5275 | 298 octave_idx_type idx_j = 0; |
| 299 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 300 { |
| 301 if (ridx(i) != idx_j) | |
| 302 break; | |
| 303 else | |
| 304 idx_j++; | |
| 305 } | |
| 306 | |
| 307 if (idx_j != nr) | |
| 308 tmp_max = 0.; | |
| 309 | |
| 5275 | 310 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 311 { |
| 312 double tmp = data (i); | |
| 313 | |
| 5389 | 314 if (xisnan (tmp)) |
| 5164 | 315 continue; |
| 5389 | 316 else if (xisnan (tmp_max) || tmp > tmp_max) |
| 5164 | 317 { |
| 318 idx_j = ridx (i); | |
| 319 tmp_max = tmp; | |
| 320 } | |
| 321 | |
| 322 } | |
| 323 | |
| 5389 | 324 idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; |
| 5164 | 325 if (tmp_max != 0.) |
| 326 nel++; | |
| 327 } | |
| 328 | |
| 329 result = SparseMatrix (1, nc, nel); | |
| 330 | |
| 5275 | 331 octave_idx_type ii = 0; |
| 5164 | 332 result.xcidx (0) = 0; |
| 5275 | 333 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 334 { |
| 335 double tmp = elem (idx_arg(j), j); | |
| 336 if (tmp != 0.) | |
| 337 { | |
| 338 result.xdata (ii) = tmp; | |
| 339 result.xridx (ii++) = 0; | |
| 340 } | |
| 341 result.xcidx (j+1) = ii; | |
| 342 | |
| 343 } | |
| 344 } | |
| 345 else | |
| 346 { | |
| 347 idx_arg.resize (nr, 1, 0); | |
| 348 | |
| 5275 | 349 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 350 idx_arg.elem(ridx(i)) = -1; |
| 351 | |
| 5275 | 352 for (octave_idx_type j = 0; j < nc; j++) |
| 353 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 354 { |
| 355 if (idx_arg.elem(i) != -1) | |
| 356 continue; | |
| 357 bool found = false; | |
| 5275 | 358 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 359 if (ridx(k) == i) |
| 360 { | |
| 361 found = true; | |
| 362 break; | |
| 363 } | |
| 364 | |
| 365 if (!found) | |
| 366 idx_arg.elem(i) = j; | |
| 367 | |
| 368 } | |
| 369 | |
| 5275 | 370 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 371 { |
| 5275 | 372 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 373 { |
| 5275 | 374 octave_idx_type ir = ridx (i); |
| 375 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 376 double tmp = data (i); |
| 377 | |
| 5389 | 378 if (xisnan (tmp)) |
| 5164 | 379 continue; |
| 380 else if (ix == -1 || tmp > elem (ir, ix)) | |
| 381 idx_arg.elem (ir) = j; | |
| 382 } | |
| 383 } | |
| 384 | |
| 5275 | 385 octave_idx_type nel = 0; |
| 386 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 387 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 388 nel++; | |
| 389 | |
| 390 result = SparseMatrix (nr, 1, nel); | |
| 391 | |
| 5275 | 392 octave_idx_type ii = 0; |
| 5164 | 393 result.xcidx (0) = 0; |
| 394 result.xcidx (1) = nel; | |
| 5275 | 395 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 396 { |
| 397 if (idx_arg(j) == -1) | |
| 398 { | |
| 399 idx_arg(j) = 0; | |
| 400 result.xdata (ii) = octave_NaN; | |
| 401 result.xridx (ii++) = j; | |
| 402 } | |
| 403 else | |
| 404 { | |
| 405 double tmp = elem (j, idx_arg(j)); | |
| 406 if (tmp != 0.) | |
| 407 { | |
| 408 result.xdata (ii) = tmp; | |
| 409 result.xridx (ii++) = j; | |
| 410 } | |
| 411 } | |
| 412 } | |
| 413 } | |
| 414 | |
| 415 return result; | |
| 416 } | |
| 417 | |
| 418 SparseMatrix | |
| 419 SparseMatrix::min (int dim) const | |
| 420 { | |
| 5275 | 421 Array2<octave_idx_type> dummy_idx; |
| 5164 | 422 return min (dummy_idx, dim); |
| 423 } | |
| 424 | |
| 425 SparseMatrix | |
| 5275 | 426 SparseMatrix::min (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 427 { |
| 428 SparseMatrix result; | |
| 429 dim_vector dv = dims (); | |
| 430 | |
| 431 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 432 return result; | |
| 433 | |
| 5275 | 434 octave_idx_type nr = dv(0); |
| 435 octave_idx_type nc = dv(1); | |
| 5164 | 436 |
| 437 if (dim == 0) | |
| 438 { | |
| 439 idx_arg.resize (1, nc); | |
| 5275 | 440 octave_idx_type nel = 0; |
| 441 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 442 { |
| 443 double tmp_min = octave_NaN; | |
| 5275 | 444 octave_idx_type idx_j = 0; |
| 445 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 446 { |
| 447 if (ridx(i) != idx_j) | |
| 448 break; | |
| 449 else | |
| 450 idx_j++; | |
| 451 } | |
| 452 | |
| 453 if (idx_j != nr) | |
| 454 tmp_min = 0.; | |
| 455 | |
| 5275 | 456 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 457 { |
| 458 double tmp = data (i); | |
| 459 | |
| 5389 | 460 if (xisnan (tmp)) |
| 5164 | 461 continue; |
| 5389 | 462 else if (xisnan (tmp_min) || tmp < tmp_min) |
| 5164 | 463 { |
| 464 idx_j = ridx (i); | |
| 465 tmp_min = tmp; | |
| 466 } | |
| 467 | |
| 468 } | |
| 469 | |
| 5389 | 470 idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; |
| 5164 | 471 if (tmp_min != 0.) |
| 472 nel++; | |
| 473 } | |
| 474 | |
| 475 result = SparseMatrix (1, nc, nel); | |
| 476 | |
| 5275 | 477 octave_idx_type ii = 0; |
| 5164 | 478 result.xcidx (0) = 0; |
| 5275 | 479 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 480 { |
| 481 double tmp = elem (idx_arg(j), j); | |
| 482 if (tmp != 0.) | |
| 483 { | |
| 484 result.xdata (ii) = tmp; | |
| 485 result.xridx (ii++) = 0; | |
| 486 } | |
| 487 result.xcidx (j+1) = ii; | |
| 488 | |
| 489 } | |
| 490 } | |
| 491 else | |
| 492 { | |
| 493 idx_arg.resize (nr, 1, 0); | |
| 494 | |
| 5275 | 495 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 496 idx_arg.elem(ridx(i)) = -1; |
| 497 | |
| 5275 | 498 for (octave_idx_type j = 0; j < nc; j++) |
| 499 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 500 { |
| 501 if (idx_arg.elem(i) != -1) | |
| 502 continue; | |
| 503 bool found = false; | |
| 5275 | 504 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 505 if (ridx(k) == i) |
| 506 { | |
| 507 found = true; | |
| 508 break; | |
| 509 } | |
| 510 | |
| 511 if (!found) | |
| 512 idx_arg.elem(i) = j; | |
| 513 | |
| 514 } | |
| 515 | |
| 5275 | 516 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 517 { |
| 5275 | 518 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 519 { |
| 5275 | 520 octave_idx_type ir = ridx (i); |
| 521 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 522 double tmp = data (i); |
| 523 | |
| 5389 | 524 if (xisnan (tmp)) |
| 5164 | 525 continue; |
| 526 else if (ix == -1 || tmp < elem (ir, ix)) | |
| 527 idx_arg.elem (ir) = j; | |
| 528 } | |
| 529 } | |
| 530 | |
| 5275 | 531 octave_idx_type nel = 0; |
| 532 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 533 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 534 nel++; | |
| 535 | |
| 536 result = SparseMatrix (nr, 1, nel); | |
| 537 | |
| 5275 | 538 octave_idx_type ii = 0; |
| 5164 | 539 result.xcidx (0) = 0; |
| 540 result.xcidx (1) = nel; | |
| 5275 | 541 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 542 { |
| 543 if (idx_arg(j) == -1) | |
| 544 { | |
| 545 idx_arg(j) = 0; | |
| 546 result.xdata (ii) = octave_NaN; | |
| 547 result.xridx (ii++) = j; | |
| 548 } | |
| 549 else | |
| 550 { | |
| 551 double tmp = elem (j, idx_arg(j)); | |
| 552 if (tmp != 0.) | |
| 553 { | |
| 554 result.xdata (ii) = tmp; | |
| 555 result.xridx (ii++) = j; | |
| 556 } | |
| 557 } | |
| 558 } | |
| 559 } | |
| 560 | |
| 561 return result; | |
| 562 } | |
| 563 | |
|
8303
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
564 RowVector |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
565 SparseMatrix::row (octave_idx_type i) const |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
566 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
567 octave_idx_type nc = columns (); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
568 RowVector retval (nc, 0); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
569 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
570 for (octave_idx_type j = 0; j < nc; j++) |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
571 for (octave_idx_type k = cidx (j); k < cidx (j+1); k++) |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
572 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
573 if (ridx (k) == i) |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
574 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
575 retval(j) = data (k); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
576 break; |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
577 } |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
578 } |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
579 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
580 return retval; |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
581 } |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
582 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
583 ColumnVector |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
584 SparseMatrix::column (octave_idx_type i) const |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
585 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
586 octave_idx_type nr = rows (); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
587 ColumnVector retval (nr); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
588 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
589 for (octave_idx_type k = cidx (i); k < cidx (i+1); k++) |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
590 retval(ridx (k)) = data (k); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
591 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
592 return retval; |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
593 } |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
594 |
| 5164 | 595 SparseMatrix |
| 5275 | 596 SparseMatrix::concat (const SparseMatrix& rb, const Array<octave_idx_type>& ra_idx) |
| 5164 | 597 { |
| 598 // Don't use numel to avoid all possiblity of an overflow | |
| 599 if (rb.rows () > 0 && rb.cols () > 0) | |
| 600 insert (rb, ra_idx(0), ra_idx(1)); | |
| 601 return *this; | |
| 602 } | |
| 603 | |
| 604 SparseComplexMatrix | |
| 5275 | 605 SparseMatrix::concat (const SparseComplexMatrix& rb, const Array<octave_idx_type>& ra_idx) |
| 5164 | 606 { |
| 607 SparseComplexMatrix retval (*this); | |
| 608 if (rb.rows () > 0 && rb.cols () > 0) | |
| 609 retval.insert (rb, ra_idx(0), ra_idx(1)); | |
| 610 return retval; | |
| 611 } | |
| 612 | |
| 613 SparseMatrix | |
| 614 real (const SparseComplexMatrix& a) | |
| 615 { | |
| 5275 | 616 octave_idx_type nr = a.rows (); |
| 617 octave_idx_type nc = a.cols (); | |
| 5681 | 618 octave_idx_type nz = a.nnz (); |
| 5164 | 619 SparseMatrix r (nr, nc, nz); |
| 620 | |
| 5275 | 621 for (octave_idx_type i = 0; i < nc +1; i++) |
| 5164 | 622 r.cidx(i) = a.cidx(i); |
| 623 | |
| 5275 | 624 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 625 { |
| 5261 | 626 r.data(i) = std::real (a.data(i)); |
| 5164 | 627 r.ridx(i) = a.ridx(i); |
| 628 } | |
| 629 | |
| 630 return r; | |
| 631 } | |
| 632 | |
| 633 SparseMatrix | |
| 634 imag (const SparseComplexMatrix& a) | |
| 635 { | |
| 5275 | 636 octave_idx_type nr = a.rows (); |
| 637 octave_idx_type nc = a.cols (); | |
| 5681 | 638 octave_idx_type nz = a.nnz (); |
| 5164 | 639 SparseMatrix r (nr, nc, nz); |
| 640 | |
| 5275 | 641 for (octave_idx_type i = 0; i < nc +1; i++) |
| 5164 | 642 r.cidx(i) = a.cidx(i); |
| 643 | |
| 5275 | 644 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 645 { |
| 5261 | 646 r.data(i) = std::imag (a.data(i)); |
| 5164 | 647 r.ridx(i) = a.ridx(i); |
| 648 } | |
| 649 | |
| 650 return r; | |
| 651 } | |
| 652 | |
| 653 SparseMatrix | |
| 654 atan2 (const double& x, const SparseMatrix& y) | |
| 655 { | |
| 5275 | 656 octave_idx_type nr = y.rows (); |
| 657 octave_idx_type nc = y.cols (); | |
| 5164 | 658 |
| 659 if (x == 0.) | |
| 660 return SparseMatrix (nr, nc); | |
| 661 else | |
| 662 { | |
| 663 // Its going to be basically full, so this is probably the | |
| 664 // best way to handle it. | |
| 665 Matrix tmp (nr, nc, atan2 (x, 0.)); | |
| 666 | |
| 5275 | 667 for (octave_idx_type j = 0; j < nc; j++) |
| 668 for (octave_idx_type i = y.cidx (j); i < y.cidx (j+1); i++) | |
| 5164 | 669 tmp.elem (y.ridx(i), j) = atan2 (x, y.data(i)); |
| 670 | |
| 671 return SparseMatrix (tmp); | |
| 672 } | |
| 673 } | |
| 674 | |
| 675 SparseMatrix | |
| 676 atan2 (const SparseMatrix& x, const double& y) | |
| 677 { | |
| 5275 | 678 octave_idx_type nr = x.rows (); |
| 679 octave_idx_type nc = x.cols (); | |
| 5681 | 680 octave_idx_type nz = x.nnz (); |
| 5164 | 681 |
| 682 SparseMatrix retval (nr, nc, nz); | |
| 683 | |
| 5275 | 684 octave_idx_type ii = 0; |
| 5164 | 685 retval.xcidx(0) = 0; |
| 5275 | 686 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 687 { |
| 5275 | 688 for (octave_idx_type j = x.cidx(i); j < x.cidx(i+1); j++) |
| 5164 | 689 { |
| 690 double tmp = atan2 (x.data(j), y); | |
| 691 if (tmp != 0.) | |
| 692 { | |
| 693 retval.xdata (ii) = tmp; | |
| 694 retval.xridx (ii++) = x.ridx (j); | |
| 695 } | |
| 696 } | |
| 697 retval.xcidx (i+1) = ii; | |
| 698 } | |
| 699 | |
| 700 if (ii != nz) | |
| 701 { | |
| 702 SparseMatrix retval2 (nr, nc, ii); | |
| 5275 | 703 for (octave_idx_type i = 0; i < nc+1; i++) |
| 5164 | 704 retval2.xcidx (i) = retval.cidx (i); |
| 5275 | 705 for (octave_idx_type i = 0; i < ii; i++) |
| 5164 | 706 { |
| 707 retval2.xdata (i) = retval.data (i); | |
| 708 retval2.xridx (i) = retval.ridx (i); | |
| 709 } | |
| 710 return retval2; | |
| 711 } | |
| 712 else | |
| 713 return retval; | |
| 714 } | |
| 715 | |
| 716 SparseMatrix | |
| 717 atan2 (const SparseMatrix& x, const SparseMatrix& y) | |
| 718 { | |
| 719 SparseMatrix r; | |
| 720 | |
| 721 if ((x.rows() == y.rows()) && (x.cols() == y.cols())) | |
| 722 { | |
| 5275 | 723 octave_idx_type x_nr = x.rows (); |
| 724 octave_idx_type x_nc = x.cols (); | |
| 725 | |
| 726 octave_idx_type y_nr = y.rows (); | |
| 727 octave_idx_type y_nc = y.cols (); | |
| 5164 | 728 |
| 729 if (x_nr != y_nr || x_nc != y_nc) | |
| 730 gripe_nonconformant ("atan2", x_nr, x_nc, y_nr, y_nc); | |
| 731 else | |
| 732 { | |
| 5681 | 733 r = SparseMatrix (x_nr, x_nc, (x.nnz () + y.nnz ())); |
| 5164 | 734 |
| 5275 | 735 octave_idx_type jx = 0; |
| 5164 | 736 r.cidx (0) = 0; |
| 5275 | 737 for (octave_idx_type i = 0 ; i < x_nc ; i++) |
| 5164 | 738 { |
| 5275 | 739 octave_idx_type ja = x.cidx(i); |
| 740 octave_idx_type ja_max = x.cidx(i+1); | |
| 5164 | 741 bool ja_lt_max= ja < ja_max; |
| 742 | |
| 5275 | 743 octave_idx_type jb = y.cidx(i); |
| 744 octave_idx_type jb_max = y.cidx(i+1); | |
| 5164 | 745 bool jb_lt_max = jb < jb_max; |
| 746 | |
| 747 while (ja_lt_max || jb_lt_max ) | |
| 748 { | |
| 749 OCTAVE_QUIT; | |
| 750 if ((! jb_lt_max) || | |
| 751 (ja_lt_max && (x.ridx(ja) < y.ridx(jb)))) | |
| 752 { | |
| 753 r.ridx(jx) = x.ridx(ja); | |
| 754 r.data(jx) = atan2 (x.data(ja), 0.); | |
| 755 jx++; | |
| 756 ja++; | |
| 757 ja_lt_max= ja < ja_max; | |
| 758 } | |
| 759 else if (( !ja_lt_max ) || | |
| 760 (jb_lt_max && (y.ridx(jb) < x.ridx(ja)) ) ) | |
| 761 { | |
| 762 jb++; | |
| 763 jb_lt_max= jb < jb_max; | |
| 764 } | |
| 765 else | |
| 766 { | |
| 767 double tmp = atan2 (x.data(ja), y.data(jb)); | |
| 768 if (tmp != 0.) | |
| 769 { | |
| 770 r.data(jx) = tmp; | |
| 771 r.ridx(jx) = x.ridx(ja); | |
| 772 jx++; | |
| 773 } | |
| 774 ja++; | |
| 775 ja_lt_max= ja < ja_max; | |
| 776 jb++; | |
| 777 jb_lt_max= jb < jb_max; | |
| 778 } | |
| 779 } | |
| 780 r.cidx(i+1) = jx; | |
| 781 } | |
| 782 | |
| 783 r.maybe_compress (); | |
| 784 } | |
| 785 } | |
| 786 else | |
| 787 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 788 | |
| 789 return r; | |
| 790 } | |
| 791 | |
| 792 SparseMatrix | |
| 793 SparseMatrix::inverse (void) const | |
| 794 { | |
| 5275 | 795 octave_idx_type info; |
| 5164 | 796 double rcond; |
| 5785 | 797 MatrixType mattype (*this); |
| 5506 | 798 return inverse (mattype, info, rcond, 0, 0); |
| 799 } | |
| 800 | |
| 801 SparseMatrix | |
| 5785 | 802 SparseMatrix::inverse (MatrixType& mattype) const |
| 5506 | 803 { |
| 804 octave_idx_type info; | |
| 805 double rcond; | |
| 806 return inverse (mattype, info, rcond, 0, 0); | |
| 5164 | 807 } |
| 808 | |
| 809 SparseMatrix | |
| 5785 | 810 SparseMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const |
| 5164 | 811 { |
| 812 double rcond; | |
| 5506 | 813 return inverse (mattype, info, rcond, 0, 0); |
| 814 } | |
| 815 | |
| 816 SparseMatrix | |
| 5785 | 817 SparseMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 818 double& rcond, const bool, |
| 5506 | 819 const bool calccond) const |
| 820 { | |
| 821 SparseMatrix retval; | |
| 822 | |
| 823 octave_idx_type nr = rows (); | |
| 824 octave_idx_type nc = cols (); | |
| 825 info = 0; | |
| 826 | |
| 827 if (nr == 0 || nc == 0 || nr != nc) | |
| 828 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 829 else | |
| 830 { | |
| 831 // Print spparms("spumoni") info if requested | |
| 832 int typ = mattyp.type (); | |
| 833 mattyp.info (); | |
| 834 | |
| 5785 | 835 if (typ == MatrixType::Diagonal || |
| 836 typ == MatrixType::Permuted_Diagonal) | |
| 5506 | 837 { |
| 5785 | 838 if (typ == MatrixType::Permuted_Diagonal) |
| 5506 | 839 retval = transpose(); |
| 840 else | |
| 841 retval = *this; | |
| 842 | |
| 843 // Force make_unique to be called | |
| 844 double *v = retval.data(); | |
| 845 | |
| 846 if (calccond) | |
| 847 { | |
| 848 double dmax = 0., dmin = octave_Inf; | |
| 849 for (octave_idx_type i = 0; i < nr; i++) | |
| 850 { | |
| 851 double tmp = fabs(v[i]); | |
| 852 if (tmp > dmax) | |
| 853 dmax = tmp; | |
| 854 if (tmp < dmin) | |
| 855 dmin = tmp; | |
| 856 } | |
| 857 rcond = dmin / dmax; | |
| 858 } | |
| 859 | |
| 860 for (octave_idx_type i = 0; i < nr; i++) | |
| 861 v[i] = 1.0 / v[i]; | |
| 862 } | |
| 863 else | |
| 864 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 865 } | |
| 866 | |
| 867 return retval; | |
| 868 } | |
| 869 | |
| 870 SparseMatrix | |
| 5785 | 871 SparseMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 872 double& rcond, const bool, |
| 5506 | 873 const bool calccond) const |
| 874 { | |
| 875 SparseMatrix retval; | |
| 876 | |
| 877 octave_idx_type nr = rows (); | |
| 878 octave_idx_type nc = cols (); | |
| 879 info = 0; | |
| 880 | |
| 881 if (nr == 0 || nc == 0 || nr != nc) | |
| 882 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 883 else | |
| 884 { | |
| 885 // Print spparms("spumoni") info if requested | |
| 886 int typ = mattyp.type (); | |
| 887 mattyp.info (); | |
| 888 | |
| 5785 | 889 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper || |
| 890 typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) | |
| 5506 | 891 { |
| 892 double anorm = 0.; | |
| 893 double ainvnorm = 0.; | |
| 894 | |
| 895 if (calccond) | |
| 896 { | |
| 897 // Calculate the 1-norm of matrix for rcond calculation | |
| 898 for (octave_idx_type j = 0; j < nr; j++) | |
| 899 { | |
| 900 double atmp = 0.; | |
| 901 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 902 atmp += fabs(data(i)); | |
| 903 if (atmp > anorm) | |
| 904 anorm = atmp; | |
| 905 } | |
| 906 } | |
| 907 | |
| 5785 | 908 if (typ == MatrixType::Upper || typ == MatrixType::Lower) |
| 5506 | 909 { |
| 5681 | 910 octave_idx_type nz = nnz (); |
| 5506 | 911 octave_idx_type cx = 0; |
| 912 octave_idx_type nz2 = nz; | |
| 913 retval = SparseMatrix (nr, nc, nz2); | |
| 914 | |
| 915 for (octave_idx_type i = 0; i < nr; i++) | |
| 916 { | |
| 917 OCTAVE_QUIT; | |
| 918 // place the 1 in the identity position | |
| 919 octave_idx_type cx_colstart = cx; | |
| 920 | |
| 921 if (cx == nz2) | |
| 922 { | |
| 923 nz2 *= 2; | |
| 924 retval.change_capacity (nz2); | |
| 925 } | |
| 926 | |
| 927 retval.xcidx(i) = cx; | |
| 928 retval.xridx(cx) = i; | |
| 929 retval.xdata(cx) = 1.0; | |
| 930 cx++; | |
| 931 | |
| 932 // iterate accross columns of input matrix | |
| 933 for (octave_idx_type j = i+1; j < nr; j++) | |
| 934 { | |
| 935 double v = 0.; | |
| 936 // iterate to calculate sum | |
| 937 octave_idx_type colXp = retval.xcidx(i); | |
| 938 octave_idx_type colUp = cidx(j); | |
| 939 octave_idx_type rpX, rpU; | |
| 5876 | 940 |
| 941 if (cidx(j) == cidx(j+1)) | |
| 942 { | |
| 943 (*current_liboctave_error_handler) | |
| 944 ("division by zero"); | |
| 945 goto inverse_singular; | |
| 946 } | |
| 947 | |
| 5506 | 948 do |
| 949 { | |
| 950 OCTAVE_QUIT; | |
| 951 rpX = retval.xridx(colXp); | |
| 952 rpU = ridx(colUp); | |
| 953 | |
| 954 if (rpX < rpU) | |
| 955 colXp++; | |
| 956 else if (rpX > rpU) | |
| 957 colUp++; | |
| 958 else | |
| 959 { | |
| 960 v -= retval.xdata(colXp) * data(colUp); | |
| 961 colXp++; | |
| 962 colUp++; | |
| 963 } | |
| 964 } while ((rpX<j) && (rpU<j) && | |
| 965 (colXp<cx) && (colUp<nz)); | |
| 966 | |
| 967 // get A(m,m) | |
| 5876 | 968 if (typ == MatrixType::Upper) |
| 969 colUp = cidx(j+1) - 1; | |
| 970 else | |
| 5877 | 971 colUp = cidx(j); |
| 5506 | 972 double pivot = data(colUp); |
| 5877 | 973 if (pivot == 0. || ridx(colUp) != j) |
| 5876 | 974 { |
| 975 (*current_liboctave_error_handler) | |
| 976 ("division by zero"); | |
| 977 goto inverse_singular; | |
| 978 } | |
| 5506 | 979 |
| 980 if (v != 0.) | |
| 981 { | |
| 982 if (cx == nz2) | |
| 983 { | |
| 984 nz2 *= 2; | |
| 985 retval.change_capacity (nz2); | |
| 986 } | |
| 987 | |
| 988 retval.xridx(cx) = j; | |
| 989 retval.xdata(cx) = v / pivot; | |
| 990 cx++; | |
| 991 } | |
| 992 } | |
| 993 | |
| 994 // get A(m,m) | |
| 5876 | 995 octave_idx_type colUp; |
| 996 if (typ == MatrixType::Upper) | |
| 997 colUp = cidx(i+1) - 1; | |
| 998 else | |
| 5877 | 999 colUp = cidx(i); |
| 5506 | 1000 double pivot = data(colUp); |
| 5877 | 1001 if (pivot == 0. || ridx(colUp) != i) |
| 5876 | 1002 { |
| 1003 (*current_liboctave_error_handler) ("division by zero"); | |
| 1004 goto inverse_singular; | |
| 1005 } | |
| 5506 | 1006 |
| 1007 if (pivot != 1.0) | |
| 1008 for (octave_idx_type j = cx_colstart; j < cx; j++) | |
| 1009 retval.xdata(j) /= pivot; | |
| 1010 } | |
| 1011 retval.xcidx(nr) = cx; | |
| 1012 retval.maybe_compress (); | |
| 1013 } | |
| 1014 else | |
| 1015 { | |
| 5681 | 1016 octave_idx_type nz = nnz (); |
| 5506 | 1017 octave_idx_type cx = 0; |
| 1018 octave_idx_type nz2 = nz; | |
| 1019 retval = SparseMatrix (nr, nc, nz2); | |
| 1020 | |
| 1021 OCTAVE_LOCAL_BUFFER (double, work, nr); | |
| 1022 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); | |
| 1023 | |
| 1024 octave_idx_type *perm = mattyp.triangular_perm(); | |
| 5785 | 1025 if (typ == MatrixType::Permuted_Upper) |
| 5506 | 1026 { |
| 1027 for (octave_idx_type i = 0; i < nr; i++) | |
| 1028 rperm[perm[i]] = i; | |
| 1029 } | |
| 1030 else | |
| 1031 { | |
| 1032 for (octave_idx_type i = 0; i < nr; i++) | |
| 1033 rperm[i] = perm[i]; | |
| 1034 for (octave_idx_type i = 0; i < nr; i++) | |
| 1035 perm[rperm[i]] = i; | |
| 1036 } | |
| 1037 | |
| 1038 for (octave_idx_type i = 0; i < nr; i++) | |
| 1039 { | |
| 1040 OCTAVE_QUIT; | |
| 1041 octave_idx_type iidx = rperm[i]; | |
| 1042 | |
| 1043 for (octave_idx_type j = 0; j < nr; j++) | |
| 1044 work[j] = 0.; | |
| 1045 | |
| 1046 // place the 1 in the identity position | |
| 1047 work[iidx] = 1.0; | |
| 1048 | |
| 1049 // iterate accross columns of input matrix | |
| 1050 for (octave_idx_type j = iidx+1; j < nr; j++) | |
| 1051 { | |
| 1052 double v = 0.; | |
| 1053 octave_idx_type jidx = perm[j]; | |
| 1054 // iterate to calculate sum | |
| 1055 for (octave_idx_type k = cidx(jidx); | |
| 1056 k < cidx(jidx+1); k++) | |
| 1057 { | |
| 1058 OCTAVE_QUIT; | |
| 1059 v -= work[ridx(k)] * data(k); | |
| 1060 } | |
| 1061 | |
| 1062 // get A(m,m) | |
| 5876 | 1063 double pivot; |
| 1064 if (typ == MatrixType::Permuted_Upper) | |
| 1065 pivot = data(cidx(jidx+1) - 1); | |
| 1066 else | |
| 5877 | 1067 pivot = data(cidx(jidx)); |
| 5506 | 1068 if (pivot == 0.) |
| 5876 | 1069 { |
| 1070 (*current_liboctave_error_handler) | |
| 1071 ("division by zero"); | |
| 1072 goto inverse_singular; | |
| 1073 } | |
| 5506 | 1074 |
| 1075 work[j] = v / pivot; | |
| 1076 } | |
| 1077 | |
| 1078 // get A(m,m) | |
| 5876 | 1079 octave_idx_type colUp; |
| 1080 if (typ == MatrixType::Permuted_Upper) | |
| 1081 colUp = cidx(perm[iidx]+1) - 1; | |
| 1082 else | |
| 5877 | 1083 colUp = cidx(perm[iidx]); |
| 5876 | 1084 |
| 5506 | 1085 double pivot = data(colUp); |
| 5876 | 1086 if (pivot == 0.) |
| 1087 { | |
| 1088 (*current_liboctave_error_handler) | |
| 1089 ("division by zero"); | |
| 1090 goto inverse_singular; | |
| 1091 } | |
| 5506 | 1092 |
| 1093 octave_idx_type new_cx = cx; | |
| 1094 for (octave_idx_type j = iidx; j < nr; j++) | |
| 1095 if (work[j] != 0.0) | |
| 1096 { | |
| 1097 new_cx++; | |
| 1098 if (pivot != 1.0) | |
| 1099 work[j] /= pivot; | |
| 1100 } | |
| 1101 | |
| 1102 if (cx < new_cx) | |
| 1103 { | |
| 1104 nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2); | |
| 1105 retval.change_capacity (nz2); | |
| 1106 } | |
| 1107 | |
| 1108 retval.xcidx(i) = cx; | |
| 1109 for (octave_idx_type j = iidx; j < nr; j++) | |
| 1110 if (work[j] != 0.) | |
| 1111 { | |
| 1112 retval.xridx(cx) = j; | |
| 1113 retval.xdata(cx++) = work[j]; | |
| 1114 } | |
| 1115 } | |
| 1116 | |
| 1117 retval.xcidx(nr) = cx; | |
| 1118 retval.maybe_compress (); | |
| 1119 } | |
| 1120 | |
| 1121 if (calccond) | |
| 1122 { | |
| 1123 // Calculate the 1-norm of inverse matrix for rcond calculation | |
| 1124 for (octave_idx_type j = 0; j < nr; j++) | |
| 1125 { | |
| 1126 double atmp = 0.; | |
| 1127 for (octave_idx_type i = retval.cidx(j); | |
| 1128 i < retval.cidx(j+1); i++) | |
| 1129 atmp += fabs(retval.data(i)); | |
| 1130 if (atmp > ainvnorm) | |
| 1131 ainvnorm = atmp; | |
| 1132 } | |
| 1133 | |
| 1134 rcond = 1. / ainvnorm / anorm; | |
| 1135 } | |
| 1136 } | |
| 1137 else | |
| 1138 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1139 } | |
| 1140 | |
| 1141 return retval; | |
| 5876 | 1142 |
| 1143 inverse_singular: | |
| 1144 return SparseMatrix(); | |
| 5164 | 1145 } |
| 1146 | |
| 1147 SparseMatrix | |
| 5785 | 1148 SparseMatrix::inverse (MatrixType &mattype, octave_idx_type& info, |
| 5610 | 1149 double& rcond, int, int calc_cond) const |
| 5506 | 1150 { |
| 1151 int typ = mattype.type (false); | |
| 1152 SparseMatrix ret; | |
| 1153 | |
| 5785 | 1154 if (typ == MatrixType::Unknown) |
| 5506 | 1155 typ = mattype.type (*this); |
| 1156 | |
| 5785 | 1157 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5506 | 1158 ret = dinverse (mattype, info, rcond, true, calc_cond); |
| 5785 | 1159 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5506 | 1160 ret = tinverse (mattype, info, rcond, true, calc_cond).transpose(); |
| 5785 | 1161 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 6185 | 1162 { |
| 1163 MatrixType newtype = mattype.transpose(); | |
| 1164 ret = transpose().tinverse (newtype, info, rcond, true, calc_cond); | |
| 1165 } | |
| 6840 | 1166 else |
| 5506 | 1167 { |
| 1168 if (mattype.is_hermitian()) | |
| 1169 { | |
| 5785 | 1170 MatrixType tmp_typ (MatrixType::Upper); |
| 5506 | 1171 SparseCHOL fact (*this, info, false); |
| 1172 rcond = fact.rcond(); | |
| 1173 if (info == 0) | |
| 1174 { | |
| 1175 double rcond2; | |
| 1176 SparseMatrix Q = fact.Q(); | |
| 1177 SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, | |
| 1178 info, rcond2, true, false); | |
| 1179 ret = Q * InvL.transpose() * InvL * Q.transpose(); | |
| 1180 } | |
| 1181 else | |
| 1182 { | |
| 1183 // Matrix is either singular or not positive definite | |
| 1184 mattype.mark_as_unsymmetric (); | |
| 5785 | 1185 typ = MatrixType::Full; |
| 5506 | 1186 } |
| 1187 } | |
| 1188 | |
| 1189 if (!mattype.is_hermitian()) | |
| 1190 { | |
| 1191 octave_idx_type n = rows(); | |
| 1192 ColumnVector Qinit(n); | |
| 1193 for (octave_idx_type i = 0; i < n; i++) | |
| 1194 Qinit(i) = i; | |
| 1195 | |
| 5785 | 1196 MatrixType tmp_typ (MatrixType::Upper); |
|
7515
f3c00dc0912b
Eliminate the rest of the dispatched sparse functions
David Bateman <dbateman@free.fr>
parents:
7503
diff
changeset
|
1197 SparseLU fact (*this, Qinit, Matrix(), false, false); |
| 5506 | 1198 rcond = fact.rcond(); |
| 1199 double rcond2; | |
| 1200 SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, | |
| 1201 info, rcond2, true, false); | |
| 1202 SparseMatrix InvU = fact.U().tinverse(tmp_typ, info, rcond2, | |
| 1203 true, false).transpose(); | |
| 1204 ret = fact.Pc().transpose() * InvU * InvL * fact.Pr(); | |
| 1205 } | |
| 1206 } | |
| 1207 | |
| 1208 return ret; | |
| 5164 | 1209 } |
| 1210 | |
| 1211 DET | |
| 1212 SparseMatrix::determinant (void) const | |
| 1213 { | |
| 5275 | 1214 octave_idx_type info; |
| 5164 | 1215 double rcond; |
| 1216 return determinant (info, rcond, 0); | |
| 1217 } | |
| 1218 | |
| 1219 DET | |
| 5275 | 1220 SparseMatrix::determinant (octave_idx_type& info) const |
| 5164 | 1221 { |
| 1222 double rcond; | |
| 1223 return determinant (info, rcond, 0); | |
| 1224 } | |
| 1225 | |
| 1226 DET | |
| 5275 | 1227 SparseMatrix::determinant (octave_idx_type& err, double& rcond, int) const |
| 5164 | 1228 { |
| 1229 DET retval; | |
| 1230 | |
| 5203 | 1231 #ifdef HAVE_UMFPACK |
| 5275 | 1232 octave_idx_type nr = rows (); |
| 1233 octave_idx_type nc = cols (); | |
| 5164 | 1234 |
| 1235 if (nr == 0 || nc == 0 || nr != nc) | |
| 1236 { | |
| 8335 | 1237 retval = DET (1.0); |
| 5164 | 1238 } |
| 1239 else | |
| 1240 { | |
| 1241 err = 0; | |
| 1242 | |
| 1243 // Setup the control parameters | |
| 1244 Matrix Control (UMFPACK_CONTROL, 1); | |
| 1245 double *control = Control.fortran_vec (); | |
| 5322 | 1246 UMFPACK_DNAME (defaults) (control); |
| 5164 | 1247 |
| 5893 | 1248 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 1249 if (!xisnan (tmp)) |
| 1250 Control (UMFPACK_PRL) = tmp; | |
| 1251 | |
| 5893 | 1252 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 1253 if (!xisnan (tmp)) |
| 1254 { | |
| 1255 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 1256 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 1257 } | |
| 1258 | |
| 1259 // Set whether we are allowed to modify Q or not | |
| 5893 | 1260 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 1261 if (!xisnan (tmp)) |
| 1262 Control (UMFPACK_FIXQ) = tmp; | |
| 1263 | |
| 1264 // Turn-off UMFPACK scaling for LU | |
| 1265 Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; | |
| 1266 | |
| 5322 | 1267 UMFPACK_DNAME (report_control) (control); |
| 5164 | 1268 |
| 5275 | 1269 const octave_idx_type *Ap = cidx (); |
| 1270 const octave_idx_type *Ai = ridx (); | |
| 5164 | 1271 const double *Ax = data (); |
| 1272 | |
| 5322 | 1273 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control); |
| 5164 | 1274 |
| 1275 void *Symbolic; | |
| 1276 Matrix Info (1, UMFPACK_INFO); | |
| 1277 double *info = Info.fortran_vec (); | |
| 5322 | 1278 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, |
| 7520 | 1279 Ax, 0, &Symbolic, control, info); |
| 5164 | 1280 |
| 1281 if (status < 0) | |
| 1282 { | |
| 1283 (*current_liboctave_error_handler) | |
| 1284 ("SparseMatrix::determinant symbolic factorization failed"); | |
| 1285 | |
| 5322 | 1286 UMFPACK_DNAME (report_status) (control, status); |
| 1287 UMFPACK_DNAME (report_info) (control, info); | |
| 1288 | |
| 1289 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 1290 } |
| 1291 else | |
| 1292 { | |
| 5322 | 1293 UMFPACK_DNAME (report_symbolic) (Symbolic, control); |
| 5164 | 1294 |
| 1295 void *Numeric; | |
| 5322 | 1296 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, |
| 1297 &Numeric, control, info) ; | |
| 1298 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 1299 |
| 1300 rcond = Info (UMFPACK_RCOND); | |
| 1301 | |
| 1302 if (status < 0) | |
| 1303 { | |
| 1304 (*current_liboctave_error_handler) | |
| 1305 ("SparseMatrix::determinant numeric factorization failed"); | |
| 1306 | |
| 5322 | 1307 UMFPACK_DNAME (report_status) (control, status); |
| 1308 UMFPACK_DNAME (report_info) (control, info); | |
| 1309 | |
| 1310 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 1311 } |
| 1312 else | |
| 1313 { | |
| 5322 | 1314 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 1315 |
| 8335 | 1316 double c10, e10; |
| 1317 | |
| 1318 status = UMFPACK_DNAME (get_determinant) (&c10, &e10, Numeric, info); | |
| 5164 | 1319 |
| 1320 if (status < 0) | |
| 1321 { | |
| 1322 (*current_liboctave_error_handler) | |
| 1323 ("SparseMatrix::determinant error calculating determinant"); | |
| 1324 | |
| 5322 | 1325 UMFPACK_DNAME (report_status) (control, status); |
| 1326 UMFPACK_DNAME (report_info) (control, info); | |
| 5164 | 1327 } |
| 1328 else | |
| 8335 | 1329 retval = DET (c10, e10, 10); |
| 5346 | 1330 |
| 1331 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 1332 } |
| 1333 } | |
| 1334 } | |
| 5203 | 1335 #else |
| 1336 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 1337 #endif | |
| 5164 | 1338 |
| 1339 return retval; | |
| 1340 } | |
| 1341 | |
| 1342 Matrix | |
| 5785 | 1343 SparseMatrix::dsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, |
| 5681 | 1344 double& rcond, solve_singularity_handler, |
| 1345 bool calc_cond) const | |
| 5164 | 1346 { |
| 1347 Matrix retval; | |
| 1348 | |
| 5275 | 1349 octave_idx_type nr = rows (); |
| 1350 octave_idx_type nc = cols (); | |
| 5630 | 1351 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1352 err = 0; |
| 1353 | |
| 6924 | 1354 if (nr != b.rows ()) |
| 5164 | 1355 (*current_liboctave_error_handler) |
| 1356 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1357 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1358 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 1359 else |
| 1360 { | |
| 1361 // Print spparms("spumoni") info if requested | |
| 1362 int typ = mattype.type (); | |
| 1363 mattype.info (); | |
| 1364 | |
| 5785 | 1365 if (typ == MatrixType::Diagonal || |
| 1366 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1367 { |
| 5630 | 1368 retval.resize (nc, b.cols(), 0.); |
| 5785 | 1369 if (typ == MatrixType::Diagonal) |
| 5275 | 1370 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1371 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1372 retval(i,j) = b(i,j) / data (i); |
| 1373 else | |
| 5275 | 1374 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1375 for (octave_idx_type k = 0; k < nc; k++) |
| 1376 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1377 retval(k,j) = b(ridx(i),j) / data (i); | |
| 1378 | |
| 5681 | 1379 if (calc_cond) |
| 1380 { | |
| 1381 double dmax = 0., dmin = octave_Inf; | |
| 1382 for (octave_idx_type i = 0; i < nm; i++) | |
| 1383 { | |
| 1384 double tmp = fabs(data(i)); | |
| 1385 if (tmp > dmax) | |
| 1386 dmax = tmp; | |
| 1387 if (tmp < dmin) | |
| 1388 dmin = tmp; | |
| 1389 } | |
| 1390 rcond = dmin / dmax; | |
| 1391 } | |
| 1392 else | |
| 1393 rcond = 1.; | |
| 5164 | 1394 } |
| 1395 else | |
| 1396 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1397 } | |
| 1398 | |
| 1399 return retval; | |
| 1400 } | |
| 1401 | |
| 1402 SparseMatrix | |
| 5785 | 1403 SparseMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 1404 octave_idx_type& err, double& rcond, |
| 1405 solve_singularity_handler, bool calc_cond) const | |
| 5164 | 1406 { |
| 1407 SparseMatrix retval; | |
| 1408 | |
| 5275 | 1409 octave_idx_type nr = rows (); |
| 1410 octave_idx_type nc = cols (); | |
| 5630 | 1411 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1412 err = 0; |
| 1413 | |
| 6924 | 1414 if (nr != b.rows ()) |
| 5164 | 1415 (*current_liboctave_error_handler) |
| 1416 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1417 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1418 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 1419 else |
| 1420 { | |
| 1421 // Print spparms("spumoni") info if requested | |
| 1422 int typ = mattype.type (); | |
| 1423 mattype.info (); | |
| 1424 | |
| 5785 | 1425 if (typ == MatrixType::Diagonal || |
| 1426 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1427 { |
| 5275 | 1428 octave_idx_type b_nc = b.cols (); |
| 5681 | 1429 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1430 retval = SparseMatrix (nc, b_nc, b_nz); |
| 5164 | 1431 |
| 1432 retval.xcidx(0) = 0; | |
| 5275 | 1433 octave_idx_type ii = 0; |
| 5785 | 1434 if (typ == MatrixType::Diagonal) |
| 5681 | 1435 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1436 { |
| 5275 | 1437 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1438 { |
| 5681 | 1439 if (b.ridx(i) >= nm) |
| 1440 break; | |
| 5164 | 1441 retval.xridx (ii) = b.ridx(i); |
| 1442 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1443 } | |
| 1444 retval.xcidx(j+1) = ii; | |
| 1445 } | |
| 1446 else | |
| 5681 | 1447 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1448 { |
| 5630 | 1449 for (octave_idx_type l = 0; l < nc; l++) |
| 1450 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1451 { | |
| 1452 bool found = false; | |
| 1453 octave_idx_type k; | |
| 1454 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1455 if (ridx(i) == b.ridx(k)) | |
| 1456 { | |
| 1457 found = true; | |
| 1458 break; | |
| 1459 } | |
| 1460 if (found) | |
| 5164 | 1461 { |
| 5630 | 1462 retval.xridx (ii) = l; |
| 1463 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1464 } |
| 5630 | 1465 } |
| 5164 | 1466 retval.xcidx(j+1) = ii; |
| 1467 } | |
| 5630 | 1468 |
| 5681 | 1469 if (calc_cond) |
| 1470 { | |
| 1471 double dmax = 0., dmin = octave_Inf; | |
| 1472 for (octave_idx_type i = 0; i < nm; i++) | |
| 1473 { | |
| 1474 double tmp = fabs(data(i)); | |
| 1475 if (tmp > dmax) | |
| 1476 dmax = tmp; | |
| 1477 if (tmp < dmin) | |
| 1478 dmin = tmp; | |
| 1479 } | |
| 1480 rcond = dmin / dmax; | |
| 1481 } | |
| 1482 else | |
| 1483 rcond = 1.; | |
| 5164 | 1484 } |
| 1485 else | |
| 1486 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1487 } | |
| 1488 | |
| 1489 return retval; | |
| 1490 } | |
| 1491 | |
| 1492 ComplexMatrix | |
| 5785 | 1493 SparseMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 1494 octave_idx_type& err, double& rcond, |
| 1495 solve_singularity_handler, bool calc_cond) const | |
| 5164 | 1496 { |
| 1497 ComplexMatrix retval; | |
| 1498 | |
| 5275 | 1499 octave_idx_type nr = rows (); |
| 1500 octave_idx_type nc = cols (); | |
| 5630 | 1501 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1502 err = 0; |
| 1503 | |
| 6924 | 1504 if (nr != b.rows ()) |
| 5164 | 1505 (*current_liboctave_error_handler) |
| 1506 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1507 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1508 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 1509 else |
| 1510 { | |
| 1511 // Print spparms("spumoni") info if requested | |
| 1512 int typ = mattype.type (); | |
| 1513 mattype.info (); | |
| 1514 | |
| 5785 | 1515 if (typ == MatrixType::Diagonal || |
| 1516 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1517 { |
| 5630 | 1518 retval.resize (nc, b.cols(), 0); |
| 5785 | 1519 if (typ == MatrixType::Diagonal) |
| 5275 | 1520 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1521 for (octave_idx_type i = 0; i < nm; i++) |
| 1522 retval(i,j) = b(i,j) / data (i); | |
| 5164 | 1523 else |
| 5275 | 1524 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1525 for (octave_idx_type k = 0; k < nc; k++) |
| 1526 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1527 retval(k,j) = b(ridx(i),j) / data (i); | |
| 5164 | 1528 |
| 5681 | 1529 if (calc_cond) |
| 1530 { | |
| 1531 double dmax = 0., dmin = octave_Inf; | |
| 1532 for (octave_idx_type i = 0; i < nm; i++) | |
| 1533 { | |
| 1534 double tmp = fabs(data(i)); | |
| 1535 if (tmp > dmax) | |
| 1536 dmax = tmp; | |
| 1537 if (tmp < dmin) | |
| 1538 dmin = tmp; | |
| 1539 } | |
| 1540 rcond = dmin / dmax; | |
| 1541 } | |
| 1542 else | |
| 1543 rcond = 1.; | |
| 5164 | 1544 } |
| 1545 else | |
| 1546 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1547 } | |
| 1548 | |
| 1549 return retval; | |
| 1550 } | |
| 1551 | |
| 1552 SparseComplexMatrix | |
| 5785 | 1553 SparseMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 1554 octave_idx_type& err, double& rcond, |
| 5681 | 1555 solve_singularity_handler, bool calc_cond) const |
| 5164 | 1556 { |
| 1557 SparseComplexMatrix retval; | |
| 1558 | |
| 5275 | 1559 octave_idx_type nr = rows (); |
| 1560 octave_idx_type nc = cols (); | |
| 5630 | 1561 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1562 err = 0; |
| 1563 | |
| 6924 | 1564 if (nr != b.rows ()) |
| 5164 | 1565 (*current_liboctave_error_handler) |
| 1566 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1567 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1568 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 1569 else |
| 1570 { | |
| 1571 // Print spparms("spumoni") info if requested | |
| 1572 int typ = mattype.type (); | |
| 1573 mattype.info (); | |
| 1574 | |
| 5785 | 1575 if (typ == MatrixType::Diagonal || |
| 1576 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1577 { |
| 5275 | 1578 octave_idx_type b_nc = b.cols (); |
| 5681 | 1579 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1580 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 1581 |
| 1582 retval.xcidx(0) = 0; | |
| 5275 | 1583 octave_idx_type ii = 0; |
| 5785 | 1584 if (typ == MatrixType::Diagonal) |
| 5275 | 1585 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1586 { |
| 5275 | 1587 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1588 { |
| 5681 | 1589 if (b.ridx(i) >= nm) |
| 1590 break; | |
| 5164 | 1591 retval.xridx (ii) = b.ridx(i); |
| 1592 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1593 } | |
| 1594 retval.xcidx(j+1) = ii; | |
| 1595 } | |
| 1596 else | |
| 5275 | 1597 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1598 { |
| 5630 | 1599 for (octave_idx_type l = 0; l < nc; l++) |
| 1600 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1601 { | |
| 1602 bool found = false; | |
| 1603 octave_idx_type k; | |
| 1604 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1605 if (ridx(i) == b.ridx(k)) | |
| 1606 { | |
| 1607 found = true; | |
| 1608 break; | |
| 1609 } | |
| 1610 if (found) | |
| 5164 | 1611 { |
| 5630 | 1612 retval.xridx (ii) = l; |
| 1613 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1614 } |
| 5630 | 1615 } |
| 5164 | 1616 retval.xcidx(j+1) = ii; |
| 1617 } | |
| 1618 | |
| 5681 | 1619 if (calc_cond) |
| 1620 { | |
| 1621 double dmax = 0., dmin = octave_Inf; | |
| 1622 for (octave_idx_type i = 0; i < nm; i++) | |
| 1623 { | |
| 1624 double tmp = fabs(data(i)); | |
| 1625 if (tmp > dmax) | |
| 1626 dmax = tmp; | |
| 1627 if (tmp < dmin) | |
| 1628 dmin = tmp; | |
| 1629 } | |
| 1630 rcond = dmin / dmax; | |
| 1631 } | |
| 1632 else | |
| 1633 rcond = 1.; | |
| 5164 | 1634 } |
| 1635 else | |
| 1636 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1637 } | |
| 1638 | |
| 1639 return retval; | |
| 1640 } | |
| 1641 | |
| 1642 Matrix | |
| 5785 | 1643 SparseMatrix::utsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 1644 octave_idx_type& err, double& rcond, |
| 5681 | 1645 solve_singularity_handler sing_handler, |
| 1646 bool calc_cond) const | |
| 5164 | 1647 { |
| 1648 Matrix retval; | |
| 1649 | |
| 5275 | 1650 octave_idx_type nr = rows (); |
| 1651 octave_idx_type nc = cols (); | |
| 5630 | 1652 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1653 err = 0; |
| 1654 | |
| 6924 | 1655 if (nr != b.rows ()) |
| 5164 | 1656 (*current_liboctave_error_handler) |
| 1657 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1658 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1659 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 1660 else |
| 1661 { | |
| 1662 // Print spparms("spumoni") info if requested | |
| 1663 int typ = mattype.type (); | |
| 1664 mattype.info (); | |
| 1665 | |
| 5785 | 1666 if (typ == MatrixType::Permuted_Upper || |
| 1667 typ == MatrixType::Upper) | |
| 5164 | 1668 { |
| 1669 double anorm = 0.; | |
| 1670 double ainvnorm = 0.; | |
| 5630 | 1671 octave_idx_type b_nc = b.cols (); |
| 5681 | 1672 rcond = 1.; |
| 1673 | |
| 1674 if (calc_cond) | |
| 1675 { | |
| 1676 // Calculate the 1-norm of matrix for rcond calculation | |
| 1677 for (octave_idx_type j = 0; j < nc; j++) | |
| 1678 { | |
| 1679 double atmp = 0.; | |
| 1680 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1681 atmp += fabs(data(i)); | |
| 1682 if (atmp > anorm) | |
| 1683 anorm = atmp; | |
| 1684 } | |
| 5164 | 1685 } |
| 1686 | |
| 5785 | 1687 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1688 { |
| 5630 | 1689 retval.resize (nc, b_nc); |
| 5322 | 1690 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 1691 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1692 | |
| 1693 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 1694 { |
| 5275 | 1695 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 1696 work[i] = b(i,j); |
| 5630 | 1697 for (octave_idx_type i = nr; i < nc; i++) |
| 1698 work[i] = 0.; | |
| 1699 | |
| 1700 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1701 { |
| 5322 | 1702 octave_idx_type kidx = perm[k]; |
| 1703 | |
| 1704 if (work[k] != 0.) | |
| 5164 | 1705 { |
| 5681 | 1706 if (ridx(cidx(kidx+1)-1) != k || |
| 1707 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1708 { |
| 1709 err = -2; | |
| 1710 goto triangular_error; | |
| 1711 } | |
| 1712 | |
| 5322 | 1713 double tmp = work[k] / data(cidx(kidx+1)-1); |
| 1714 work[k] = tmp; | |
| 1715 for (octave_idx_type i = cidx(kidx); | |
| 1716 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1717 { |
| 5322 | 1718 octave_idx_type iidx = ridx(i); |
| 1719 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1720 } |
| 1721 } | |
| 1722 } | |
| 1723 | |
| 5630 | 1724 for (octave_idx_type i = 0; i < nc; i++) |
| 1725 retval.xelem (perm[i], j) = work[i]; | |
| 5164 | 1726 } |
| 1727 | |
| 5681 | 1728 if (calc_cond) |
| 1729 { | |
| 1730 // Calculation of 1-norm of inv(*this) | |
| 1731 for (octave_idx_type i = 0; i < nm; i++) | |
| 1732 work[i] = 0.; | |
| 1733 | |
| 1734 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1735 { |
| 5681 | 1736 work[j] = 1.; |
| 1737 | |
| 1738 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1739 { |
| 5681 | 1740 octave_idx_type iidx = perm[k]; |
| 1741 | |
| 1742 if (work[k] != 0.) | |
| 5164 | 1743 { |
| 5681 | 1744 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 1745 work[k] = tmp; | |
| 1746 for (octave_idx_type i = cidx(iidx); | |
| 1747 i < cidx(iidx+1)-1; i++) | |
| 1748 { | |
| 1749 octave_idx_type idx2 = ridx(i); | |
| 1750 work[idx2] = work[idx2] - tmp * data(i); | |
| 1751 } | |
| 5164 | 1752 } |
| 1753 } | |
| 5681 | 1754 double atmp = 0; |
| 1755 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1756 { | |
| 1757 atmp += fabs(work[i]); | |
| 1758 work[i] = 0.; | |
| 1759 } | |
| 1760 if (atmp > ainvnorm) | |
| 1761 ainvnorm = atmp; | |
| 5164 | 1762 } |
| 5681 | 1763 rcond = 1. / ainvnorm / anorm; |
| 5164 | 1764 } |
| 1765 } | |
| 1766 else | |
| 1767 { | |
| 5630 | 1768 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1769 retval.resize (nc, b_nc); | |
| 1770 | |
| 1771 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 1772 { |
| 5630 | 1773 for (octave_idx_type i = 0; i < nr; i++) |
| 1774 work[i] = b(i,j); | |
| 1775 for (octave_idx_type i = nr; i < nc; i++) | |
| 1776 work[i] = 0.; | |
| 1777 | |
| 1778 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1779 { |
| 5630 | 1780 if (work[k] != 0.) |
| 5164 | 1781 { |
| 5681 | 1782 if (ridx(cidx(k+1)-1) != k || |
| 1783 data(cidx(k+1)-1) == 0.) | |
| 5164 | 1784 { |
| 1785 err = -2; | |
| 1786 goto triangular_error; | |
| 1787 } | |
| 1788 | |
| 5630 | 1789 double tmp = work[k] / data(cidx(k+1)-1); |
| 1790 work[k] = tmp; | |
| 5275 | 1791 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 1792 { |
| 5275 | 1793 octave_idx_type iidx = ridx(i); |
| 5630 | 1794 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 1795 } |
| 1796 } | |
| 1797 } | |
| 5630 | 1798 |
| 1799 for (octave_idx_type i = 0; i < nc; i++) | |
| 1800 retval.xelem (i, j) = work[i]; | |
| 5164 | 1801 } |
| 1802 | |
| 5681 | 1803 if (calc_cond) |
| 1804 { | |
| 1805 // Calculation of 1-norm of inv(*this) | |
| 1806 for (octave_idx_type i = 0; i < nm; i++) | |
| 1807 work[i] = 0.; | |
| 1808 | |
| 1809 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1810 { |
| 5681 | 1811 work[j] = 1.; |
| 1812 | |
| 1813 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1814 { |
| 5681 | 1815 if (work[k] != 0.) |
| 5164 | 1816 { |
| 5681 | 1817 double tmp = work[k] / data(cidx(k+1)-1); |
| 1818 work[k] = tmp; | |
| 1819 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) | |
| 1820 { | |
| 1821 octave_idx_type iidx = ridx(i); | |
| 1822 work[iidx] = work[iidx] - tmp * data(i); | |
| 1823 } | |
| 5164 | 1824 } |
| 1825 } | |
| 5681 | 1826 double atmp = 0; |
| 1827 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1828 { | |
| 1829 atmp += fabs(work[i]); | |
| 1830 work[i] = 0.; | |
| 1831 } | |
| 1832 if (atmp > ainvnorm) | |
| 1833 ainvnorm = atmp; | |
| 5164 | 1834 } |
| 5681 | 1835 rcond = 1. / ainvnorm / anorm; |
| 1836 } | |
| 1837 } | |
| 5164 | 1838 |
| 1839 triangular_error: | |
| 1840 if (err != 0) | |
| 1841 { | |
| 1842 if (sing_handler) | |
| 5681 | 1843 { |
| 1844 sing_handler (rcond); | |
| 1845 mattype.mark_as_rectangular (); | |
| 1846 } | |
| 5164 | 1847 else |
| 1848 (*current_liboctave_error_handler) | |
| 1849 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 1850 rcond); | |
| 1851 } | |
| 1852 | |
| 1853 volatile double rcond_plus_one = rcond + 1.0; | |
| 1854 | |
| 1855 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 1856 { | |
| 1857 err = -2; | |
| 1858 | |
| 1859 if (sing_handler) | |
| 5681 | 1860 { |
| 1861 sing_handler (rcond); | |
| 1862 mattype.mark_as_rectangular (); | |
| 1863 } | |
| 5164 | 1864 else |
| 1865 (*current_liboctave_error_handler) | |
| 1866 ("matrix singular to machine precision, rcond = %g", | |
| 1867 rcond); | |
| 1868 } | |
| 1869 } | |
| 1870 else | |
| 1871 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1872 } | |
| 1873 | |
| 1874 return retval; | |
| 1875 } | |
| 1876 | |
| 1877 SparseMatrix | |
| 5785 | 1878 SparseMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 1879 octave_idx_type& err, double& rcond, |
| 5681 | 1880 solve_singularity_handler sing_handler, |
| 1881 bool calc_cond) const | |
| 5164 | 1882 { |
| 1883 SparseMatrix retval; | |
| 1884 | |
| 5275 | 1885 octave_idx_type nr = rows (); |
| 1886 octave_idx_type nc = cols (); | |
| 5630 | 1887 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1888 err = 0; |
| 1889 | |
| 6924 | 1890 if (nr != b.rows ()) |
| 5164 | 1891 (*current_liboctave_error_handler) |
| 1892 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1893 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1894 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 1895 else |
| 1896 { | |
| 1897 // Print spparms("spumoni") info if requested | |
| 1898 int typ = mattype.type (); | |
| 1899 mattype.info (); | |
| 1900 | |
| 5785 | 1901 if (typ == MatrixType::Permuted_Upper || |
| 1902 typ == MatrixType::Upper) | |
| 5164 | 1903 { |
| 1904 double anorm = 0.; | |
| 1905 double ainvnorm = 0.; | |
| 5681 | 1906 rcond = 1.; |
| 1907 | |
| 1908 if (calc_cond) | |
| 1909 { | |
| 1910 // Calculate the 1-norm of matrix for rcond calculation | |
| 1911 for (octave_idx_type j = 0; j < nc; j++) | |
| 1912 { | |
| 1913 double atmp = 0.; | |
| 1914 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1915 atmp += fabs(data(i)); | |
| 1916 if (atmp > anorm) | |
| 1917 anorm = atmp; | |
| 1918 } | |
| 5164 | 1919 } |
| 1920 | |
| 5275 | 1921 octave_idx_type b_nc = b.cols (); |
| 5681 | 1922 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1923 retval = SparseMatrix (nc, b_nc, b_nz); |
| 5164 | 1924 retval.xcidx(0) = 0; |
| 5275 | 1925 octave_idx_type ii = 0; |
| 1926 octave_idx_type x_nz = b_nz; | |
| 5164 | 1927 |
| 5785 | 1928 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1929 { |
| 5322 | 1930 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 1931 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1932 | |
| 1933 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 1934 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 1935 rperm[perm[i]] = i; |
| 5164 | 1936 |
| 5275 | 1937 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1938 { |
| 5630 | 1939 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1940 work[i] = 0.; |
| 5275 | 1941 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1942 work[b.ridx(i)] = b.data(i); |
| 1943 | |
| 5630 | 1944 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 1945 { |
| 5322 | 1946 octave_idx_type kidx = perm[k]; |
| 1947 | |
| 1948 if (work[k] != 0.) | |
| 5164 | 1949 { |
| 5681 | 1950 if (ridx(cidx(kidx+1)-1) != k || |
| 1951 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1952 { |
| 1953 err = -2; | |
| 1954 goto triangular_error; | |
| 1955 } | |
| 1956 | |
| 5322 | 1957 double tmp = work[k] / data(cidx(kidx+1)-1); |
| 1958 work[k] = tmp; | |
| 1959 for (octave_idx_type i = cidx(kidx); | |
| 1960 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1961 { |
| 5322 | 1962 octave_idx_type iidx = ridx(i); |
| 1963 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1964 } |
| 1965 } | |
| 1966 } | |
| 1967 | |
| 1968 // Count non-zeros in work vector and adjust space in | |
| 1969 // retval if needed | |
| 5275 | 1970 octave_idx_type new_nnz = 0; |
| 5630 | 1971 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 1972 if (work[i] != 0.) |
| 1973 new_nnz++; | |
| 1974 | |
| 1975 if (ii + new_nnz > x_nz) | |
| 1976 { | |
| 1977 // Resize the sparse matrix | |
| 5275 | 1978 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 1979 retval.change_capacity (sz); |
| 1980 x_nz = sz; | |
| 1981 } | |
| 1982 | |
| 5630 | 1983 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 1984 if (work[rperm[i]] != 0.) |
| 5164 | 1985 { |
| 1986 retval.xridx(ii) = i; | |
| 5322 | 1987 retval.xdata(ii++) = work[rperm[i]]; |
| 5164 | 1988 } |
| 1989 retval.xcidx(j+1) = ii; | |
| 1990 } | |
| 1991 | |
| 1992 retval.maybe_compress (); | |
| 1993 | |
| 5681 | 1994 if (calc_cond) |
| 1995 { | |
| 1996 // Calculation of 1-norm of inv(*this) | |
| 1997 for (octave_idx_type i = 0; i < nm; i++) | |
| 1998 work[i] = 0.; | |
| 1999 | |
| 2000 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2001 { |
| 5681 | 2002 work[j] = 1.; |
| 2003 | |
| 2004 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2005 { |
| 5681 | 2006 octave_idx_type iidx = perm[k]; |
| 2007 | |
| 2008 if (work[k] != 0.) | |
| 5164 | 2009 { |
| 5681 | 2010 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2011 work[k] = tmp; | |
| 2012 for (octave_idx_type i = cidx(iidx); | |
| 2013 i < cidx(iidx+1)-1; i++) | |
| 2014 { | |
| 2015 octave_idx_type idx2 = ridx(i); | |
| 2016 work[idx2] = work[idx2] - tmp * data(i); | |
| 2017 } | |
| 5164 | 2018 } |
| 2019 } | |
| 5681 | 2020 double atmp = 0; |
| 2021 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2022 { | |
| 2023 atmp += fabs(work[i]); | |
| 2024 work[i] = 0.; | |
| 2025 } | |
| 2026 if (atmp > ainvnorm) | |
| 2027 ainvnorm = atmp; | |
| 5164 | 2028 } |
| 5681 | 2029 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2030 } |
| 2031 } | |
| 2032 else | |
| 2033 { | |
| 5630 | 2034 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5164 | 2035 |
| 5275 | 2036 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2037 { |
| 5630 | 2038 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 2039 work[i] = 0.; |
| 5275 | 2040 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 2041 work[b.ridx(i)] = b.data(i); |
| 2042 | |
| 5630 | 2043 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 2044 { |
| 2045 if (work[k] != 0.) | |
| 2046 { | |
| 5681 | 2047 if (ridx(cidx(k+1)-1) != k || |
| 2048 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2049 { |
| 2050 err = -2; | |
| 2051 goto triangular_error; | |
| 2052 } | |
| 2053 | |
| 2054 double tmp = work[k] / data(cidx(k+1)-1); | |
| 2055 work[k] = tmp; | |
| 5275 | 2056 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2057 { |
| 5275 | 2058 octave_idx_type iidx = ridx(i); |
| 5164 | 2059 work[iidx] = work[iidx] - tmp * data(i); |
| 2060 } | |
| 2061 } | |
| 2062 } | |
| 2063 | |
| 2064 // Count non-zeros in work vector and adjust space in | |
| 2065 // retval if needed | |
| 5275 | 2066 octave_idx_type new_nnz = 0; |
| 5630 | 2067 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2068 if (work[i] != 0.) |
| 2069 new_nnz++; | |
| 2070 | |
| 2071 if (ii + new_nnz > x_nz) | |
| 2072 { | |
| 2073 // Resize the sparse matrix | |
| 5275 | 2074 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2075 retval.change_capacity (sz); |
| 2076 x_nz = sz; | |
| 2077 } | |
| 2078 | |
| 5630 | 2079 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2080 if (work[i] != 0.) |
| 2081 { | |
| 2082 retval.xridx(ii) = i; | |
| 2083 retval.xdata(ii++) = work[i]; | |
| 2084 } | |
| 2085 retval.xcidx(j+1) = ii; | |
| 2086 } | |
| 2087 | |
| 2088 retval.maybe_compress (); | |
| 2089 | |
| 5681 | 2090 if (calc_cond) |
| 2091 { | |
| 2092 // Calculation of 1-norm of inv(*this) | |
| 2093 for (octave_idx_type i = 0; i < nm; i++) | |
| 2094 work[i] = 0.; | |
| 2095 | |
| 2096 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2097 { |
| 5681 | 2098 work[j] = 1.; |
| 2099 | |
| 2100 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2101 { |
| 5681 | 2102 if (work[k] != 0.) |
| 5164 | 2103 { |
| 5681 | 2104 double tmp = work[k] / data(cidx(k+1)-1); |
| 2105 work[k] = tmp; | |
| 2106 for (octave_idx_type i = cidx(k); | |
| 2107 i < cidx(k+1)-1; i++) | |
| 2108 { | |
| 2109 octave_idx_type iidx = ridx(i); | |
| 2110 work[iidx] = work[iidx] - tmp * data(i); | |
| 2111 } | |
| 5164 | 2112 } |
| 2113 } | |
| 5681 | 2114 double atmp = 0; |
| 2115 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2116 { | |
| 2117 atmp += fabs(work[i]); | |
| 2118 work[i] = 0.; | |
| 2119 } | |
| 2120 if (atmp > ainvnorm) | |
| 2121 ainvnorm = atmp; | |
| 5164 | 2122 } |
| 5681 | 2123 rcond = 1. / ainvnorm / anorm; |
| 2124 } | |
| 2125 } | |
| 5164 | 2126 |
| 2127 triangular_error: | |
| 2128 if (err != 0) | |
| 2129 { | |
| 2130 if (sing_handler) | |
| 5681 | 2131 { |
| 2132 sing_handler (rcond); | |
| 2133 mattype.mark_as_rectangular (); | |
| 2134 } | |
| 5164 | 2135 else |
| 2136 (*current_liboctave_error_handler) | |
| 2137 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2138 rcond); | |
| 2139 } | |
| 2140 | |
| 2141 volatile double rcond_plus_one = rcond + 1.0; | |
| 2142 | |
| 2143 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2144 { | |
| 2145 err = -2; | |
| 2146 | |
| 2147 if (sing_handler) | |
| 5681 | 2148 { |
| 2149 sing_handler (rcond); | |
| 2150 mattype.mark_as_rectangular (); | |
| 2151 } | |
| 5164 | 2152 else |
| 2153 (*current_liboctave_error_handler) | |
| 2154 ("matrix singular to machine precision, rcond = %g", | |
| 2155 rcond); | |
| 2156 } | |
| 2157 } | |
| 2158 else | |
| 2159 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2160 } | |
| 2161 return retval; | |
| 2162 } | |
| 2163 | |
| 2164 ComplexMatrix | |
| 5785 | 2165 SparseMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 2166 octave_idx_type& err, double& rcond, |
| 5681 | 2167 solve_singularity_handler sing_handler, |
| 2168 bool calc_cond) const | |
| 5164 | 2169 { |
| 2170 ComplexMatrix retval; | |
| 2171 | |
| 5275 | 2172 octave_idx_type nr = rows (); |
| 2173 octave_idx_type nc = cols (); | |
| 5630 | 2174 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2175 err = 0; |
| 2176 | |
| 6924 | 2177 if (nr != b.rows ()) |
| 5164 | 2178 (*current_liboctave_error_handler) |
| 2179 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2180 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2181 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 2182 else |
| 2183 { | |
| 2184 // Print spparms("spumoni") info if requested | |
| 2185 int typ = mattype.type (); | |
| 2186 mattype.info (); | |
| 2187 | |
| 5785 | 2188 if (typ == MatrixType::Permuted_Upper || |
| 2189 typ == MatrixType::Upper) | |
| 5164 | 2190 { |
| 2191 double anorm = 0.; | |
| 2192 double ainvnorm = 0.; | |
| 5275 | 2193 octave_idx_type b_nc = b.cols (); |
| 5681 | 2194 rcond = 1.; |
| 2195 | |
| 2196 if (calc_cond) | |
| 2197 { | |
| 2198 // Calculate the 1-norm of matrix for rcond calculation | |
| 2199 for (octave_idx_type j = 0; j < nc; j++) | |
| 2200 { | |
| 2201 double atmp = 0.; | |
| 2202 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2203 atmp += fabs(data(i)); | |
| 2204 if (atmp > anorm) | |
| 2205 anorm = atmp; | |
| 2206 } | |
| 5164 | 2207 } |
| 2208 | |
| 5785 | 2209 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2210 { |
| 5630 | 2211 retval.resize (nc, b_nc); |
| 5322 | 2212 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2213 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 2214 |
| 5275 | 2215 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2216 { |
| 5275 | 2217 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 2218 cwork[i] = b(i,j); |
| 5630 | 2219 for (octave_idx_type i = nr; i < nc; i++) |
| 2220 cwork[i] = 0.; | |
| 2221 | |
| 2222 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2223 { |
| 5322 | 2224 octave_idx_type kidx = perm[k]; |
| 2225 | |
| 2226 if (cwork[k] != 0.) | |
| 5164 | 2227 { |
| 5681 | 2228 if (ridx(cidx(kidx+1)-1) != k || |
| 2229 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2230 { |
| 2231 err = -2; | |
| 2232 goto triangular_error; | |
| 2233 } | |
| 2234 | |
| 5322 | 2235 Complex tmp = cwork[k] / data(cidx(kidx+1)-1); |
| 2236 cwork[k] = tmp; | |
| 2237 for (octave_idx_type i = cidx(kidx); | |
| 2238 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2239 { |
| 5322 | 2240 octave_idx_type iidx = ridx(i); |
| 2241 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 2242 } |
| 2243 } | |
| 2244 } | |
| 2245 | |
| 5630 | 2246 for (octave_idx_type i = 0; i < nc; i++) |
| 2247 retval.xelem (perm[i], j) = cwork[i]; | |
| 5164 | 2248 } |
| 2249 | |
| 5681 | 2250 if (calc_cond) |
| 2251 { | |
| 2252 // Calculation of 1-norm of inv(*this) | |
| 2253 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2254 for (octave_idx_type i = 0; i < nm; i++) | |
| 2255 work[i] = 0.; | |
| 2256 | |
| 2257 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2258 { |
| 5681 | 2259 work[j] = 1.; |
| 2260 | |
| 2261 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2262 { |
| 5681 | 2263 octave_idx_type iidx = perm[k]; |
| 2264 | |
| 2265 if (work[k] != 0.) | |
| 5164 | 2266 { |
| 5681 | 2267 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2268 work[k] = tmp; | |
| 2269 for (octave_idx_type i = cidx(iidx); | |
| 2270 i < cidx(iidx+1)-1; i++) | |
| 2271 { | |
| 2272 octave_idx_type idx2 = ridx(i); | |
| 2273 work[idx2] = work[idx2] - tmp * data(i); | |
| 2274 } | |
| 5164 | 2275 } |
| 2276 } | |
| 5681 | 2277 double atmp = 0; |
| 2278 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2279 { | |
| 2280 atmp += fabs(work[i]); | |
| 2281 work[i] = 0.; | |
| 2282 } | |
| 2283 if (atmp > ainvnorm) | |
| 2284 ainvnorm = atmp; | |
| 5164 | 2285 } |
| 5681 | 2286 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2287 } |
| 2288 } | |
| 2289 else | |
| 2290 { | |
| 5630 | 2291 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 2292 retval.resize (nc, b_nc); | |
| 5164 | 2293 |
| 5275 | 2294 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2295 { |
| 5630 | 2296 for (octave_idx_type i = 0; i < nr; i++) |
| 2297 cwork[i] = b(i,j); | |
| 2298 for (octave_idx_type i = nr; i < nc; i++) | |
| 2299 cwork[i] = 0.; | |
| 2300 | |
| 2301 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2302 { |
| 5630 | 2303 if (cwork[k] != 0.) |
| 5164 | 2304 { |
| 5681 | 2305 if (ridx(cidx(k+1)-1) != k || |
| 2306 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2307 { |
| 2308 err = -2; | |
| 2309 goto triangular_error; | |
| 2310 } | |
| 2311 | |
| 5630 | 2312 Complex tmp = cwork[k] / data(cidx(k+1)-1); |
| 2313 cwork[k] = tmp; | |
| 5275 | 2314 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2315 { |
| 5275 | 2316 octave_idx_type iidx = ridx(i); |
| 5630 | 2317 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 2318 } |
| 2319 } | |
| 2320 } | |
| 5630 | 2321 |
| 2322 for (octave_idx_type i = 0; i < nc; i++) | |
| 2323 retval.xelem (i, j) = cwork[i]; | |
| 5164 | 2324 } |
| 2325 | |
| 5681 | 2326 if (calc_cond) |
| 2327 { | |
| 2328 // Calculation of 1-norm of inv(*this) | |
| 2329 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2330 for (octave_idx_type i = 0; i < nm; i++) | |
| 2331 work[i] = 0.; | |
| 2332 | |
| 2333 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2334 { |
| 5681 | 2335 work[j] = 1.; |
| 2336 | |
| 2337 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2338 { |
| 5681 | 2339 if (work[k] != 0.) |
| 5164 | 2340 { |
| 5681 | 2341 double tmp = work[k] / data(cidx(k+1)-1); |
| 2342 work[k] = tmp; | |
| 2343 for (octave_idx_type i = cidx(k); | |
| 2344 i < cidx(k+1)-1; i++) | |
| 2345 { | |
| 2346 octave_idx_type iidx = ridx(i); | |
| 2347 work[iidx] = work[iidx] - tmp * data(i); | |
| 2348 } | |
| 5164 | 2349 } |
| 2350 } | |
| 5681 | 2351 double atmp = 0; |
| 2352 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2353 { | |
| 2354 atmp += fabs(work[i]); | |
| 2355 work[i] = 0.; | |
| 2356 } | |
| 2357 if (atmp > ainvnorm) | |
| 2358 ainvnorm = atmp; | |
| 5164 | 2359 } |
| 5681 | 2360 rcond = 1. / ainvnorm / anorm; |
| 2361 } | |
| 2362 } | |
| 5164 | 2363 |
| 2364 triangular_error: | |
| 2365 if (err != 0) | |
| 2366 { | |
| 2367 if (sing_handler) | |
| 5681 | 2368 { |
| 2369 sing_handler (rcond); | |
| 2370 mattype.mark_as_rectangular (); | |
| 2371 } | |
| 5164 | 2372 else |
| 2373 (*current_liboctave_error_handler) | |
| 2374 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2375 rcond); | |
| 2376 } | |
| 2377 | |
| 2378 volatile double rcond_plus_one = rcond + 1.0; | |
| 2379 | |
| 2380 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2381 { | |
| 2382 err = -2; | |
| 2383 | |
| 2384 if (sing_handler) | |
| 5681 | 2385 { |
| 2386 sing_handler (rcond); | |
| 2387 mattype.mark_as_rectangular (); | |
| 2388 } | |
| 5164 | 2389 else |
| 2390 (*current_liboctave_error_handler) | |
| 2391 ("matrix singular to machine precision, rcond = %g", | |
| 2392 rcond); | |
| 2393 } | |
| 2394 } | |
| 2395 else | |
| 2396 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2397 } | |
| 2398 | |
| 2399 return retval; | |
| 2400 } | |
| 2401 | |
| 2402 SparseComplexMatrix | |
| 5785 | 2403 SparseMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 2404 octave_idx_type& err, double& rcond, |
| 5681 | 2405 solve_singularity_handler sing_handler, |
| 2406 bool calc_cond) const | |
| 5164 | 2407 { |
| 2408 SparseComplexMatrix retval; | |
| 2409 | |
| 5275 | 2410 octave_idx_type nr = rows (); |
| 2411 octave_idx_type nc = cols (); | |
| 5630 | 2412 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2413 err = 0; |
| 2414 | |
| 6924 | 2415 if (nr != b.rows ()) |
| 5164 | 2416 (*current_liboctave_error_handler) |
| 2417 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2418 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2419 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 2420 else |
| 2421 { | |
| 2422 // Print spparms("spumoni") info if requested | |
| 2423 int typ = mattype.type (); | |
| 2424 mattype.info (); | |
| 2425 | |
| 5785 | 2426 if (typ == MatrixType::Permuted_Upper || |
| 2427 typ == MatrixType::Upper) | |
| 5164 | 2428 { |
| 2429 double anorm = 0.; | |
| 2430 double ainvnorm = 0.; | |
| 5681 | 2431 rcond = 1.; |
| 2432 | |
| 2433 if (calc_cond) | |
| 2434 { | |
| 2435 // Calculate the 1-norm of matrix for rcond calculation | |
| 2436 for (octave_idx_type j = 0; j < nc; j++) | |
| 2437 { | |
| 2438 double atmp = 0.; | |
| 2439 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2440 atmp += fabs(data(i)); | |
| 2441 if (atmp > anorm) | |
| 2442 anorm = atmp; | |
| 2443 } | |
| 5164 | 2444 } |
| 2445 | |
| 5275 | 2446 octave_idx_type b_nc = b.cols (); |
| 5681 | 2447 octave_idx_type b_nz = b.nnz (); |
| 5630 | 2448 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 2449 retval.xcidx(0) = 0; |
| 5275 | 2450 octave_idx_type ii = 0; |
| 2451 octave_idx_type x_nz = b_nz; | |
| 5164 | 2452 |
| 5785 | 2453 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2454 { |
| 5322 | 2455 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2456 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 2457 | |
| 2458 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 2459 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 2460 rperm[perm[i]] = i; |
| 5164 | 2461 |
| 5275 | 2462 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2463 { |
| 5630 | 2464 for (octave_idx_type i = 0; i < nm; i++) |
| 5322 | 2465 cwork[i] = 0.; |
| 5275 | 2466 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 2467 cwork[b.ridx(i)] = b.data(i); |
| 5164 | 2468 |
| 5630 | 2469 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 2470 { |
| 5322 | 2471 octave_idx_type kidx = perm[k]; |
| 2472 | |
| 2473 if (cwork[k] != 0.) | |
| 5164 | 2474 { |
| 5681 | 2475 if (ridx(cidx(kidx+1)-1) != k || |
| 2476 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2477 { |
| 2478 err = -2; | |
| 2479 goto triangular_error; | |
| 2480 } | |
| 2481 | |
| 5322 | 2482 Complex tmp = cwork[k] / data(cidx(kidx+1)-1); |
| 2483 cwork[k] = tmp; | |
| 2484 for (octave_idx_type i = cidx(kidx); | |
| 2485 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2486 { |
| 5322 | 2487 octave_idx_type iidx = ridx(i); |
| 2488 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 2489 } |
| 2490 } | |
| 2491 } | |
| 2492 | |
| 2493 // Count non-zeros in work vector and adjust space in | |
| 2494 // retval if needed | |
| 5275 | 2495 octave_idx_type new_nnz = 0; |
| 5630 | 2496 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2497 if (cwork[i] != 0.) |
| 5164 | 2498 new_nnz++; |
| 2499 | |
| 2500 if (ii + new_nnz > x_nz) | |
| 2501 { | |
| 2502 // Resize the sparse matrix | |
| 5275 | 2503 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2504 retval.change_capacity (sz); |
| 2505 x_nz = sz; | |
| 2506 } | |
| 2507 | |
| 5630 | 2508 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2509 if (cwork[rperm[i]] != 0.) |
| 5164 | 2510 { |
| 2511 retval.xridx(ii) = i; | |
| 5322 | 2512 retval.xdata(ii++) = cwork[rperm[i]]; |
| 5164 | 2513 } |
| 2514 retval.xcidx(j+1) = ii; | |
| 2515 } | |
| 2516 | |
| 2517 retval.maybe_compress (); | |
| 2518 | |
| 5681 | 2519 if (calc_cond) |
| 2520 { | |
| 2521 // Calculation of 1-norm of inv(*this) | |
| 2522 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2523 for (octave_idx_type i = 0; i < nm; i++) | |
| 2524 work[i] = 0.; | |
| 2525 | |
| 2526 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2527 { |
| 5681 | 2528 work[j] = 1.; |
| 2529 | |
| 2530 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2531 { |
| 5681 | 2532 octave_idx_type iidx = perm[k]; |
| 2533 | |
| 2534 if (work[k] != 0.) | |
| 5164 | 2535 { |
| 5681 | 2536 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2537 work[k] = tmp; | |
| 2538 for (octave_idx_type i = cidx(iidx); | |
| 2539 i < cidx(iidx+1)-1; i++) | |
| 2540 { | |
| 2541 octave_idx_type idx2 = ridx(i); | |
| 2542 work[idx2] = work[idx2] - tmp * data(i); | |
| 2543 } | |
| 5164 | 2544 } |
| 2545 } | |
| 5681 | 2546 double atmp = 0; |
| 2547 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2548 { | |
| 2549 atmp += fabs(work[i]); | |
| 2550 work[i] = 0.; | |
| 2551 } | |
| 2552 if (atmp > ainvnorm) | |
| 2553 ainvnorm = atmp; | |
| 5164 | 2554 } |
| 5681 | 2555 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2556 } |
| 2557 } | |
| 2558 else | |
| 2559 { | |
| 5630 | 2560 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 2561 |
| 5275 | 2562 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2563 { |
| 5630 | 2564 for (octave_idx_type i = 0; i < nm; i++) |
| 2565 cwork[i] = 0.; | |
| 5275 | 2566 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5630 | 2567 cwork[b.ridx(i)] = b.data(i); |
| 2568 | |
| 2569 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2570 { |
| 5630 | 2571 if (cwork[k] != 0.) |
| 5164 | 2572 { |
| 5681 | 2573 if (ridx(cidx(k+1)-1) != k || |
| 2574 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2575 { |
| 2576 err = -2; | |
| 2577 goto triangular_error; | |
| 2578 } | |
| 2579 | |
| 5630 | 2580 Complex tmp = cwork[k] / data(cidx(k+1)-1); |
| 2581 cwork[k] = tmp; | |
| 5275 | 2582 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2583 { |
| 5275 | 2584 octave_idx_type iidx = ridx(i); |
| 5630 | 2585 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 2586 } |
| 2587 } | |
| 2588 } | |
| 2589 | |
| 2590 // Count non-zeros in work vector and adjust space in | |
| 2591 // retval if needed | |
| 5275 | 2592 octave_idx_type new_nnz = 0; |
| 5630 | 2593 for (octave_idx_type i = 0; i < nc; i++) |
| 2594 if (cwork[i] != 0.) | |
| 5164 | 2595 new_nnz++; |
| 2596 | |
| 2597 if (ii + new_nnz > x_nz) | |
| 2598 { | |
| 2599 // Resize the sparse matrix | |
| 5275 | 2600 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2601 retval.change_capacity (sz); |
| 2602 x_nz = sz; | |
| 2603 } | |
| 2604 | |
| 5630 | 2605 for (octave_idx_type i = 0; i < nc; i++) |
| 2606 if (cwork[i] != 0.) | |
| 5164 | 2607 { |
| 2608 retval.xridx(ii) = i; | |
| 5630 | 2609 retval.xdata(ii++) = cwork[i]; |
| 5164 | 2610 } |
| 2611 retval.xcidx(j+1) = ii; | |
| 2612 } | |
| 2613 | |
| 2614 retval.maybe_compress (); | |
| 2615 | |
| 5681 | 2616 if (calc_cond) |
| 2617 { | |
| 2618 // Calculation of 1-norm of inv(*this) | |
| 2619 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2620 for (octave_idx_type i = 0; i < nm; i++) | |
| 2621 work[i] = 0.; | |
| 2622 | |
| 2623 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2624 { |
| 5681 | 2625 work[j] = 1.; |
| 2626 | |
| 2627 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2628 { |
| 5681 | 2629 if (work[k] != 0.) |
| 5164 | 2630 { |
| 5681 | 2631 double tmp = work[k] / data(cidx(k+1)-1); |
| 2632 work[k] = tmp; | |
| 2633 for (octave_idx_type i = cidx(k); | |
| 2634 i < cidx(k+1)-1; i++) | |
| 2635 { | |
| 2636 octave_idx_type iidx = ridx(i); | |
| 2637 work[iidx] = work[iidx] - tmp * data(i); | |
| 2638 } | |
| 5164 | 2639 } |
| 2640 } | |
| 5681 | 2641 double atmp = 0; |
| 2642 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2643 { | |
| 2644 atmp += fabs(work[i]); | |
| 2645 work[i] = 0.; | |
| 2646 } | |
| 2647 if (atmp > ainvnorm) | |
| 2648 ainvnorm = atmp; | |
| 5164 | 2649 } |
| 5681 | 2650 rcond = 1. / ainvnorm / anorm; |
| 2651 } | |
| 2652 } | |
| 5164 | 2653 |
| 2654 triangular_error: | |
| 2655 if (err != 0) | |
| 2656 { | |
| 2657 if (sing_handler) | |
| 5681 | 2658 { |
| 2659 sing_handler (rcond); | |
| 2660 mattype.mark_as_rectangular (); | |
| 2661 } | |
| 5164 | 2662 else |
| 2663 (*current_liboctave_error_handler) | |
| 2664 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2665 rcond); | |
| 2666 } | |
| 2667 | |
| 2668 volatile double rcond_plus_one = rcond + 1.0; | |
| 2669 | |
| 2670 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2671 { | |
| 2672 err = -2; | |
| 2673 | |
| 2674 if (sing_handler) | |
| 5681 | 2675 { |
| 2676 sing_handler (rcond); | |
| 2677 mattype.mark_as_rectangular (); | |
| 2678 } | |
| 5164 | 2679 else |
| 2680 (*current_liboctave_error_handler) | |
| 2681 ("matrix singular to machine precision, rcond = %g", | |
| 2682 rcond); | |
| 2683 } | |
| 2684 } | |
| 2685 else | |
| 2686 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2687 } | |
| 2688 | |
| 2689 return retval; | |
| 2690 } | |
| 2691 | |
| 2692 Matrix | |
| 5785 | 2693 SparseMatrix::ltsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 2694 octave_idx_type& err, double& rcond, |
| 5681 | 2695 solve_singularity_handler sing_handler, |
| 2696 bool calc_cond) const | |
| 5164 | 2697 { |
| 2698 Matrix retval; | |
| 2699 | |
| 5275 | 2700 octave_idx_type nr = rows (); |
| 2701 octave_idx_type nc = cols (); | |
| 5630 | 2702 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2703 err = 0; |
| 2704 | |
| 6924 | 2705 if (nr != b.rows ()) |
| 5164 | 2706 (*current_liboctave_error_handler) |
| 2707 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2708 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2709 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 2710 else |
| 2711 { | |
| 2712 // Print spparms("spumoni") info if requested | |
| 2713 int typ = mattype.type (); | |
| 2714 mattype.info (); | |
| 2715 | |
| 5785 | 2716 if (typ == MatrixType::Permuted_Lower || |
| 2717 typ == MatrixType::Lower) | |
| 5164 | 2718 { |
| 2719 double anorm = 0.; | |
| 2720 double ainvnorm = 0.; | |
| 5630 | 2721 octave_idx_type b_nc = b.cols (); |
| 5681 | 2722 rcond = 1.; |
| 2723 | |
| 2724 if (calc_cond) | |
| 2725 { | |
| 2726 // Calculate the 1-norm of matrix for rcond calculation | |
| 2727 for (octave_idx_type j = 0; j < nc; j++) | |
| 2728 { | |
| 2729 double atmp = 0.; | |
| 2730 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2731 atmp += fabs(data(i)); | |
| 2732 if (atmp > anorm) | |
| 2733 anorm = atmp; | |
| 2734 } | |
| 5164 | 2735 } |
| 2736 | |
| 5785 | 2737 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 2738 { |
| 5630 | 2739 retval.resize (nc, b_nc); |
| 2740 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 5322 | 2741 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 2742 |
| 5630 | 2743 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2744 { |
| 5630 | 2745 if (nc > nr) |
| 2746 for (octave_idx_type i = 0; i < nm; i++) | |
| 2747 work[i] = 0.; | |
| 5275 | 2748 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 2749 work[perm[i]] = b(i,j); |
| 5164 | 2750 |
| 5630 | 2751 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 2752 { |
| 5322 | 2753 if (work[k] != 0.) |
| 5164 | 2754 { |
| 5322 | 2755 octave_idx_type minr = nr; |
| 2756 octave_idx_type mini = 0; | |
| 2757 | |
| 2758 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 2759 if (perm[ridx(i)] < minr) | |
| 2760 { | |
| 2761 minr = perm[ridx(i)]; | |
| 2762 mini = i; | |
| 2763 } | |
| 2764 | |
| 5681 | 2765 if (minr != k || data(mini) == 0) |
| 5164 | 2766 { |
| 2767 err = -2; | |
| 2768 goto triangular_error; | |
| 2769 } | |
| 2770 | |
| 5322 | 2771 double tmp = work[k] / data(mini); |
| 2772 work[k] = tmp; | |
| 2773 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 2774 { |
| 5322 | 2775 if (i == mini) |
| 2776 continue; | |
| 2777 | |
| 2778 octave_idx_type iidx = perm[ridx(i)]; | |
| 2779 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2780 } |
| 2781 } | |
| 2782 } | |
| 2783 | |
| 5630 | 2784 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2785 retval (i, j) = work[i]; |
| 5164 | 2786 } |
| 2787 | |
| 5681 | 2788 if (calc_cond) |
| 2789 { | |
| 2790 // Calculation of 1-norm of inv(*this) | |
| 2791 for (octave_idx_type i = 0; i < nm; i++) | |
| 2792 work[i] = 0.; | |
| 2793 | |
| 2794 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2795 { |
| 5681 | 2796 work[j] = 1.; |
| 2797 | |
| 2798 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2799 { |
| 5681 | 2800 if (work[k] != 0.) |
| 5164 | 2801 { |
| 5681 | 2802 octave_idx_type minr = nr; |
| 2803 octave_idx_type mini = 0; | |
| 2804 | |
| 2805 for (octave_idx_type i = cidx(k); | |
| 2806 i < cidx(k+1); i++) | |
| 2807 if (perm[ridx(i)] < minr) | |
| 2808 { | |
| 2809 minr = perm[ridx(i)]; | |
| 2810 mini = i; | |
| 2811 } | |
| 2812 | |
| 2813 double tmp = work[k] / data(mini); | |
| 2814 work[k] = tmp; | |
| 2815 for (octave_idx_type i = cidx(k); | |
| 2816 i < cidx(k+1); i++) | |
| 2817 { | |
| 2818 if (i == mini) | |
| 2819 continue; | |
| 2820 | |
| 2821 octave_idx_type iidx = perm[ridx(i)]; | |
| 2822 work[iidx] = work[iidx] - tmp * data(i); | |
| 2823 } | |
| 5164 | 2824 } |
| 2825 } | |
| 5681 | 2826 |
| 2827 double atmp = 0; | |
| 2828 for (octave_idx_type i = j; i < nc; i++) | |
| 2829 { | |
| 2830 atmp += fabs(work[i]); | |
| 2831 work[i] = 0.; | |
| 2832 } | |
| 2833 if (atmp > ainvnorm) | |
| 2834 ainvnorm = atmp; | |
| 5164 | 2835 } |
| 5681 | 2836 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2837 } |
| 2838 } | |
| 2839 else | |
| 2840 { | |
| 5630 | 2841 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 2842 retval.resize (nc, b_nc, 0.); | |
| 2843 | |
| 2844 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 2845 { |
| 5630 | 2846 for (octave_idx_type i = 0; i < nr; i++) |
| 2847 work[i] = b(i,j); | |
| 2848 for (octave_idx_type i = nr; i < nc; i++) | |
| 2849 work[i] = 0.; | |
| 2850 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2851 { |
| 5630 | 2852 if (work[k] != 0.) |
| 5164 | 2853 { |
| 5681 | 2854 if (ridx(cidx(k)) != k || |
| 2855 data(cidx(k)) == 0.) | |
| 5164 | 2856 { |
| 2857 err = -2; | |
| 2858 goto triangular_error; | |
| 2859 } | |
| 2860 | |
| 5630 | 2861 double tmp = work[k] / data(cidx(k)); |
| 2862 work[k] = tmp; | |
| 2863 for (octave_idx_type i = cidx(k)+1; | |
| 2864 i < cidx(k+1); i++) | |
| 5164 | 2865 { |
| 5275 | 2866 octave_idx_type iidx = ridx(i); |
| 5630 | 2867 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 2868 } |
| 2869 } | |
| 2870 } | |
| 5630 | 2871 |
| 2872 for (octave_idx_type i = 0; i < nc; i++) | |
| 2873 retval.xelem (i, j) = work[i]; | |
| 5164 | 2874 } |
| 2875 | |
| 5681 | 2876 if (calc_cond) |
| 2877 { | |
| 2878 // Calculation of 1-norm of inv(*this) | |
| 2879 for (octave_idx_type i = 0; i < nm; i++) | |
| 2880 work[i] = 0.; | |
| 2881 | |
| 2882 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2883 { |
| 5681 | 2884 work[j] = 1.; |
| 2885 | |
| 2886 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 2887 { |
| 5681 | 2888 |
| 2889 if (work[k] != 0.) | |
| 5164 | 2890 { |
| 5681 | 2891 double tmp = work[k] / data(cidx(k)); |
| 2892 work[k] = tmp; | |
| 2893 for (octave_idx_type i = cidx(k)+1; | |
| 2894 i < cidx(k+1); i++) | |
| 2895 { | |
| 2896 octave_idx_type iidx = ridx(i); | |
| 2897 work[iidx] = work[iidx] - tmp * data(i); | |
| 2898 } | |
| 5164 | 2899 } |
| 2900 } | |
| 5681 | 2901 double atmp = 0; |
| 2902 for (octave_idx_type i = j; i < nc; i++) | |
| 2903 { | |
| 2904 atmp += fabs(work[i]); | |
| 2905 work[i] = 0.; | |
| 2906 } | |
| 2907 if (atmp > ainvnorm) | |
| 2908 ainvnorm = atmp; | |
| 5164 | 2909 } |
| 5681 | 2910 rcond = 1. / ainvnorm / anorm; |
| 2911 } | |
| 2912 } | |
| 5164 | 2913 |
| 2914 triangular_error: | |
| 2915 if (err != 0) | |
| 2916 { | |
| 2917 if (sing_handler) | |
| 5681 | 2918 { |
| 2919 sing_handler (rcond); | |
| 2920 mattype.mark_as_rectangular (); | |
| 2921 } | |
| 5164 | 2922 else |
| 2923 (*current_liboctave_error_handler) | |
| 2924 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2925 rcond); | |
| 2926 } | |
| 2927 | |
| 2928 volatile double rcond_plus_one = rcond + 1.0; | |
| 2929 | |
| 2930 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2931 { | |
| 2932 err = -2; | |
| 2933 | |
| 2934 if (sing_handler) | |
| 5681 | 2935 { |
| 2936 sing_handler (rcond); | |
| 2937 mattype.mark_as_rectangular (); | |
| 2938 } | |
| 5164 | 2939 else |
| 2940 (*current_liboctave_error_handler) | |
| 2941 ("matrix singular to machine precision, rcond = %g", | |
| 2942 rcond); | |
| 2943 } | |
| 2944 } | |
| 2945 else | |
| 2946 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2947 } | |
| 2948 | |
| 2949 return retval; | |
| 2950 } | |
| 2951 | |
| 2952 SparseMatrix | |
| 5785 | 2953 SparseMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 2954 octave_idx_type& err, double& rcond, |
| 5681 | 2955 solve_singularity_handler sing_handler, |
| 2956 bool calc_cond) const | |
| 5164 | 2957 { |
| 2958 SparseMatrix retval; | |
| 2959 | |
| 5275 | 2960 octave_idx_type nr = rows (); |
| 2961 octave_idx_type nc = cols (); | |
| 5630 | 2962 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2963 err = 0; |
| 2964 | |
| 6924 | 2965 if (nr != b.rows ()) |
| 5164 | 2966 (*current_liboctave_error_handler) |
| 2967 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2968 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2969 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 2970 else |
| 2971 { | |
| 2972 // Print spparms("spumoni") info if requested | |
| 2973 int typ = mattype.type (); | |
| 2974 mattype.info (); | |
| 2975 | |
| 5785 | 2976 if (typ == MatrixType::Permuted_Lower || |
| 2977 typ == MatrixType::Lower) | |
| 5164 | 2978 { |
| 2979 double anorm = 0.; | |
| 2980 double ainvnorm = 0.; | |
| 5681 | 2981 rcond = 1.; |
| 2982 | |
| 2983 if (calc_cond) | |
| 2984 { | |
| 2985 // Calculate the 1-norm of matrix for rcond calculation | |
| 2986 for (octave_idx_type j = 0; j < nc; j++) | |
| 2987 { | |
| 2988 double atmp = 0.; | |
| 2989 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2990 atmp += fabs(data(i)); | |
| 2991 if (atmp > anorm) | |
| 2992 anorm = atmp; | |
| 2993 } | |
| 2994 } | |
| 2995 | |
| 5275 | 2996 octave_idx_type b_nc = b.cols (); |
| 5681 | 2997 octave_idx_type b_nz = b.nnz (); |
| 2998 retval = SparseMatrix (nc, b_nc, b_nz); | |
| 5164 | 2999 retval.xcidx(0) = 0; |
| 5275 | 3000 octave_idx_type ii = 0; |
| 3001 octave_idx_type x_nz = b_nz; | |
| 5164 | 3002 |
| 5785 | 3003 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3004 { |
| 5681 | 3005 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5322 | 3006 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3007 |
| 5275 | 3008 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3009 { |
| 5630 | 3010 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 3011 work[i] = 0.; |
| 5275 | 3012 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 3013 work[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 3014 |
| 5630 | 3015 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3016 { |
| 5322 | 3017 if (work[k] != 0.) |
| 5164 | 3018 { |
| 5322 | 3019 octave_idx_type minr = nr; |
| 3020 octave_idx_type mini = 0; | |
| 3021 | |
| 3022 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3023 if (perm[ridx(i)] < minr) | |
| 3024 { | |
| 3025 minr = perm[ridx(i)]; | |
| 3026 mini = i; | |
| 3027 } | |
| 3028 | |
| 5681 | 3029 if (minr != k || data(mini) == 0) |
| 5164 | 3030 { |
| 3031 err = -2; | |
| 3032 goto triangular_error; | |
| 3033 } | |
| 3034 | |
| 5322 | 3035 double tmp = work[k] / data(mini); |
| 3036 work[k] = tmp; | |
| 3037 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3038 { |
| 5322 | 3039 if (i == mini) |
| 3040 continue; | |
| 3041 | |
| 3042 octave_idx_type iidx = perm[ridx(i)]; | |
| 3043 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 3044 } |
| 3045 } | |
| 3046 } | |
| 3047 | |
| 3048 // Count non-zeros in work vector and adjust space in | |
| 3049 // retval if needed | |
| 5275 | 3050 octave_idx_type new_nnz = 0; |
| 5630 | 3051 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3052 if (work[i] != 0.) |
| 3053 new_nnz++; | |
| 3054 | |
| 3055 if (ii + new_nnz > x_nz) | |
| 3056 { | |
| 3057 // Resize the sparse matrix | |
| 5275 | 3058 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3059 retval.change_capacity (sz); |
| 3060 x_nz = sz; | |
| 3061 } | |
| 3062 | |
| 5630 | 3063 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3064 if (work[i] != 0.) |
| 5164 | 3065 { |
| 3066 retval.xridx(ii) = i; | |
| 5322 | 3067 retval.xdata(ii++) = work[i]; |
| 5164 | 3068 } |
| 3069 retval.xcidx(j+1) = ii; | |
| 3070 } | |
| 3071 | |
| 3072 retval.maybe_compress (); | |
| 3073 | |
| 5681 | 3074 if (calc_cond) |
| 3075 { | |
| 3076 // Calculation of 1-norm of inv(*this) | |
| 3077 for (octave_idx_type i = 0; i < nm; i++) | |
| 3078 work[i] = 0.; | |
| 3079 | |
| 3080 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3081 { |
| 5681 | 3082 work[j] = 1.; |
| 3083 | |
| 3084 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3085 { |
| 5681 | 3086 if (work[k] != 0.) |
| 5164 | 3087 { |
| 5681 | 3088 octave_idx_type minr = nr; |
| 3089 octave_idx_type mini = 0; | |
| 3090 | |
| 3091 for (octave_idx_type i = cidx(k); | |
| 3092 i < cidx(k+1); i++) | |
| 3093 if (perm[ridx(i)] < minr) | |
| 3094 { | |
| 3095 minr = perm[ridx(i)]; | |
| 3096 mini = i; | |
| 3097 } | |
| 3098 | |
| 3099 double tmp = work[k] / data(mini); | |
| 3100 work[k] = tmp; | |
| 3101 for (octave_idx_type i = cidx(k); | |
| 3102 i < cidx(k+1); i++) | |
| 3103 { | |
| 3104 if (i == mini) | |
| 3105 continue; | |
| 3106 | |
| 3107 octave_idx_type iidx = perm[ridx(i)]; | |
| 3108 work[iidx] = work[iidx] - tmp * data(i); | |
| 3109 } | |
| 5164 | 3110 } |
| 3111 } | |
| 5681 | 3112 |
| 3113 double atmp = 0; | |
| 3114 for (octave_idx_type i = j; i < nr; i++) | |
| 3115 { | |
| 3116 atmp += fabs(work[i]); | |
| 3117 work[i] = 0.; | |
| 3118 } | |
| 3119 if (atmp > ainvnorm) | |
| 3120 ainvnorm = atmp; | |
| 5164 | 3121 } |
| 5681 | 3122 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3123 } |
| 3124 } | |
| 3125 else | |
| 3126 { | |
| 5681 | 3127 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5164 | 3128 |
| 5275 | 3129 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3130 { |
| 5630 | 3131 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 3132 work[i] = 0.; |
| 5275 | 3133 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 3134 work[b.ridx(i)] = b.data(i); |
| 3135 | |
| 5630 | 3136 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3137 { |
| 3138 if (work[k] != 0.) | |
| 3139 { | |
| 5681 | 3140 if (ridx(cidx(k)) != k || |
| 3141 data(cidx(k)) == 0.) | |
| 5164 | 3142 { |
| 3143 err = -2; | |
| 3144 goto triangular_error; | |
| 3145 } | |
| 3146 | |
| 3147 double tmp = work[k] / data(cidx(k)); | |
| 3148 work[k] = tmp; | |
| 5275 | 3149 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3150 { |
| 5275 | 3151 octave_idx_type iidx = ridx(i); |
| 5164 | 3152 work[iidx] = work[iidx] - tmp * data(i); |
| 3153 } | |
| 3154 } | |
| 3155 } | |
| 3156 | |
| 3157 // Count non-zeros in work vector and adjust space in | |
| 3158 // retval if needed | |
| 5275 | 3159 octave_idx_type new_nnz = 0; |
| 5630 | 3160 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3161 if (work[i] != 0.) |
| 3162 new_nnz++; | |
| 3163 | |
| 3164 if (ii + new_nnz > x_nz) | |
| 3165 { | |
| 3166 // Resize the sparse matrix | |
| 5275 | 3167 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3168 retval.change_capacity (sz); |
| 3169 x_nz = sz; | |
| 3170 } | |
| 3171 | |
| 5630 | 3172 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3173 if (work[i] != 0.) |
| 3174 { | |
| 3175 retval.xridx(ii) = i; | |
| 3176 retval.xdata(ii++) = work[i]; | |
| 3177 } | |
| 3178 retval.xcidx(j+1) = ii; | |
| 3179 } | |
| 3180 | |
| 3181 retval.maybe_compress (); | |
| 3182 | |
| 5681 | 3183 if (calc_cond) |
| 3184 { | |
| 3185 // Calculation of 1-norm of inv(*this) | |
| 3186 for (octave_idx_type i = 0; i < nm; i++) | |
| 3187 work[i] = 0.; | |
| 3188 | |
| 3189 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3190 { |
| 5681 | 3191 work[j] = 1.; |
| 3192 | |
| 3193 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3194 { |
| 5681 | 3195 |
| 3196 if (work[k] != 0.) | |
| 5164 | 3197 { |
| 5681 | 3198 double tmp = work[k] / data(cidx(k)); |
| 3199 work[k] = tmp; | |
| 3200 for (octave_idx_type i = cidx(k)+1; | |
| 3201 i < cidx(k+1); i++) | |
| 3202 { | |
| 3203 octave_idx_type iidx = ridx(i); | |
| 3204 work[iidx] = work[iidx] - tmp * data(i); | |
| 3205 } | |
| 5164 | 3206 } |
| 3207 } | |
| 5681 | 3208 double atmp = 0; |
| 3209 for (octave_idx_type i = j; i < nc; i++) | |
| 3210 { | |
| 3211 atmp += fabs(work[i]); | |
| 3212 work[i] = 0.; | |
| 3213 } | |
| 3214 if (atmp > ainvnorm) | |
| 3215 ainvnorm = atmp; | |
| 5164 | 3216 } |
| 5681 | 3217 rcond = 1. / ainvnorm / anorm; |
| 3218 } | |
| 3219 } | |
| 5164 | 3220 |
| 3221 triangular_error: | |
| 3222 if (err != 0) | |
| 3223 { | |
| 3224 if (sing_handler) | |
| 5681 | 3225 { |
| 3226 sing_handler (rcond); | |
| 3227 mattype.mark_as_rectangular (); | |
| 3228 } | |
| 5164 | 3229 else |
| 3230 (*current_liboctave_error_handler) | |
| 3231 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3232 rcond); | |
| 3233 } | |
| 3234 | |
| 3235 volatile double rcond_plus_one = rcond + 1.0; | |
| 3236 | |
| 3237 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3238 { | |
| 3239 err = -2; | |
| 3240 | |
| 3241 if (sing_handler) | |
| 5681 | 3242 { |
| 3243 sing_handler (rcond); | |
| 3244 mattype.mark_as_rectangular (); | |
| 3245 } | |
| 5164 | 3246 else |
| 3247 (*current_liboctave_error_handler) | |
| 3248 ("matrix singular to machine precision, rcond = %g", | |
| 3249 rcond); | |
| 3250 } | |
| 3251 } | |
| 3252 else | |
| 3253 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3254 } | |
| 3255 | |
| 3256 return retval; | |
| 3257 } | |
| 3258 | |
| 3259 ComplexMatrix | |
| 5785 | 3260 SparseMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 3261 octave_idx_type& err, double& rcond, |
| 5681 | 3262 solve_singularity_handler sing_handler, |
| 3263 bool calc_cond) const | |
| 5164 | 3264 { |
| 3265 ComplexMatrix retval; | |
| 3266 | |
| 5275 | 3267 octave_idx_type nr = rows (); |
| 3268 octave_idx_type nc = cols (); | |
| 5630 | 3269 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3270 err = 0; |
| 3271 | |
| 6924 | 3272 if (nr != b.rows ()) |
| 5164 | 3273 (*current_liboctave_error_handler) |
| 3274 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3275 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3276 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 3277 else |
| 3278 { | |
| 3279 // Print spparms("spumoni") info if requested | |
| 3280 int typ = mattype.type (); | |
| 3281 mattype.info (); | |
| 3282 | |
| 5785 | 3283 if (typ == MatrixType::Permuted_Lower || |
| 3284 typ == MatrixType::Lower) | |
| 5164 | 3285 { |
| 3286 double anorm = 0.; | |
| 3287 double ainvnorm = 0.; | |
| 5275 | 3288 octave_idx_type b_nc = b.cols (); |
| 5681 | 3289 rcond = 1.; |
| 3290 | |
| 3291 if (calc_cond) | |
| 3292 { | |
| 3293 // Calculate the 1-norm of matrix for rcond calculation | |
| 3294 for (octave_idx_type j = 0; j < nc; j++) | |
| 3295 { | |
| 3296 double atmp = 0.; | |
| 3297 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3298 atmp += fabs(data(i)); | |
| 3299 if (atmp > anorm) | |
| 3300 anorm = atmp; | |
| 3301 } | |
| 5164 | 3302 } |
| 3303 | |
| 5785 | 3304 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3305 { |
| 5630 | 3306 retval.resize (nc, b_nc); |
| 5681 | 3307 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5322 | 3308 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3309 |
| 5275 | 3310 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3311 { |
| 5630 | 3312 for (octave_idx_type i = 0; i < nm; i++) |
| 3313 cwork[i] = 0.; | |
| 5275 | 3314 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 3315 cwork[perm[i]] = b(i,j); |
| 5164 | 3316 |
| 5630 | 3317 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3318 { |
| 5322 | 3319 if (cwork[k] != 0.) |
| 5164 | 3320 { |
| 5322 | 3321 octave_idx_type minr = nr; |
| 3322 octave_idx_type mini = 0; | |
| 3323 | |
| 3324 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3325 if (perm[ridx(i)] < minr) | |
| 3326 { | |
| 3327 minr = perm[ridx(i)]; | |
| 3328 mini = i; | |
| 3329 } | |
| 3330 | |
| 5681 | 3331 if (minr != k || data(mini) == 0) |
| 5164 | 3332 { |
| 3333 err = -2; | |
| 3334 goto triangular_error; | |
| 3335 } | |
| 3336 | |
| 5322 | 3337 Complex tmp = cwork[k] / data(mini); |
| 3338 cwork[k] = tmp; | |
| 3339 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3340 { |
| 5322 | 3341 if (i == mini) |
| 3342 continue; | |
| 3343 | |
| 3344 octave_idx_type iidx = perm[ridx(i)]; | |
| 3345 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 3346 } |
| 3347 } | |
| 3348 } | |
| 3349 | |
| 5630 | 3350 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3351 retval (i, j) = cwork[i]; |
| 5164 | 3352 } |
| 3353 | |
| 5681 | 3354 if (calc_cond) |
| 3355 { | |
| 3356 // Calculation of 1-norm of inv(*this) | |
| 3357 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3358 for (octave_idx_type i = 0; i < nm; i++) | |
| 3359 work[i] = 0.; | |
| 3360 | |
| 3361 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3362 { |
| 5681 | 3363 work[j] = 1.; |
| 3364 | |
| 3365 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3366 { |
| 5681 | 3367 if (work[k] != 0.) |
| 5164 | 3368 { |
| 5681 | 3369 octave_idx_type minr = nr; |
| 3370 octave_idx_type mini = 0; | |
| 3371 | |
| 3372 for (octave_idx_type i = cidx(k); | |
| 3373 i < cidx(k+1); i++) | |
| 3374 if (perm[ridx(i)] < minr) | |
| 3375 { | |
| 3376 minr = perm[ridx(i)]; | |
| 3377 mini = i; | |
| 3378 } | |
| 3379 | |
| 3380 double tmp = work[k] / data(mini); | |
| 3381 work[k] = tmp; | |
| 3382 for (octave_idx_type i = cidx(k); | |
| 3383 i < cidx(k+1); i++) | |
| 3384 { | |
| 3385 if (i == mini) | |
| 3386 continue; | |
| 3387 | |
| 3388 octave_idx_type iidx = perm[ridx(i)]; | |
| 3389 work[iidx] = work[iidx] - tmp * data(i); | |
| 3390 } | |
| 5164 | 3391 } |
| 3392 } | |
| 5681 | 3393 |
| 3394 double atmp = 0; | |
| 3395 for (octave_idx_type i = j; i < nc; i++) | |
| 3396 { | |
| 3397 atmp += fabs(work[i]); | |
| 3398 work[i] = 0.; | |
| 3399 } | |
| 3400 if (atmp > ainvnorm) | |
| 3401 ainvnorm = atmp; | |
| 5164 | 3402 } |
| 5681 | 3403 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3404 } |
| 3405 } | |
| 3406 else | |
| 3407 { | |
| 5630 | 3408 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 3409 retval.resize (nc, b_nc, 0.); | |
| 5164 | 3410 |
| 5275 | 3411 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3412 { |
| 5630 | 3413 for (octave_idx_type i = 0; i < nr; i++) |
| 3414 cwork[i] = b(i,j); | |
| 3415 for (octave_idx_type i = nr; i < nc; i++) | |
| 3416 cwork[i] = 0.; | |
| 3417 | |
| 3418 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3419 { |
| 5630 | 3420 if (cwork[k] != 0.) |
| 5164 | 3421 { |
| 5681 | 3422 if (ridx(cidx(k)) != k || |
| 3423 data(cidx(k)) == 0.) | |
| 5164 | 3424 { |
| 3425 err = -2; | |
| 3426 goto triangular_error; | |
| 3427 } | |
| 3428 | |
| 5630 | 3429 Complex tmp = cwork[k] / data(cidx(k)); |
| 3430 cwork[k] = tmp; | |
| 5275 | 3431 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3432 { |
| 5275 | 3433 octave_idx_type iidx = ridx(i); |
| 5630 | 3434 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 3435 } |
| 3436 } | |
| 3437 } | |
| 5630 | 3438 |
| 3439 for (octave_idx_type i = 0; i < nc; i++) | |
| 3440 retval.xelem (i, j) = cwork[i]; | |
| 5164 | 3441 } |
| 3442 | |
| 5681 | 3443 if (calc_cond) |
| 3444 { | |
| 3445 // Calculation of 1-norm of inv(*this) | |
| 3446 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3447 for (octave_idx_type i = 0; i < nm; i++) | |
| 3448 work[i] = 0.; | |
| 3449 | |
| 3450 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3451 { |
| 5681 | 3452 work[j] = 1.; |
| 3453 | |
| 3454 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3455 { |
| 5681 | 3456 |
| 3457 if (work[k] != 0.) | |
| 5164 | 3458 { |
| 5681 | 3459 double tmp = work[k] / data(cidx(k)); |
| 3460 work[k] = tmp; | |
| 3461 for (octave_idx_type i = cidx(k)+1; | |
| 3462 i < cidx(k+1); i++) | |
| 3463 { | |
| 3464 octave_idx_type iidx = ridx(i); | |
| 3465 work[iidx] = work[iidx] - tmp * data(i); | |
| 3466 } | |
| 5164 | 3467 } |
| 3468 } | |
| 5681 | 3469 double atmp = 0; |
| 3470 for (octave_idx_type i = j; i < nc; i++) | |
| 3471 { | |
| 3472 atmp += fabs(work[i]); | |
| 3473 work[i] = 0.; | |
| 3474 } | |
| 3475 if (atmp > ainvnorm) | |
| 3476 ainvnorm = atmp; | |
| 5164 | 3477 } |
| 5681 | 3478 rcond = 1. / ainvnorm / anorm; |
| 3479 } | |
| 3480 } | |
| 5164 | 3481 |
| 3482 triangular_error: | |
| 3483 if (err != 0) | |
| 3484 { | |
| 3485 if (sing_handler) | |
| 5681 | 3486 { |
| 3487 sing_handler (rcond); | |
| 3488 mattype.mark_as_rectangular (); | |
| 3489 } | |
| 5164 | 3490 else |
| 3491 (*current_liboctave_error_handler) | |
| 3492 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3493 rcond); | |
| 3494 } | |
| 3495 | |
| 3496 volatile double rcond_plus_one = rcond + 1.0; | |
| 3497 | |
| 3498 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3499 { | |
| 3500 err = -2; | |
| 3501 | |
| 3502 if (sing_handler) | |
| 5681 | 3503 { |
| 3504 sing_handler (rcond); | |
| 3505 mattype.mark_as_rectangular (); | |
| 3506 } | |
| 5164 | 3507 else |
| 3508 (*current_liboctave_error_handler) | |
| 3509 ("matrix singular to machine precision, rcond = %g", | |
| 3510 rcond); | |
| 3511 } | |
| 3512 } | |
| 3513 else | |
| 3514 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3515 } | |
| 3516 | |
| 3517 return retval; | |
| 3518 } | |
| 3519 | |
| 3520 SparseComplexMatrix | |
| 5785 | 3521 SparseMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 3522 octave_idx_type& err, double& rcond, |
| 5681 | 3523 solve_singularity_handler sing_handler, |
| 3524 bool calc_cond) const | |
| 5164 | 3525 { |
| 3526 SparseComplexMatrix retval; | |
| 3527 | |
| 5275 | 3528 octave_idx_type nr = rows (); |
| 3529 octave_idx_type nc = cols (); | |
| 5630 | 3530 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3531 err = 0; |
| 3532 | |
| 6924 | 3533 if (nr != b.rows ()) |
| 5164 | 3534 (*current_liboctave_error_handler) |
| 3535 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3536 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3537 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 3538 else |
| 3539 { | |
| 3540 // Print spparms("spumoni") info if requested | |
| 3541 int typ = mattype.type (); | |
| 3542 mattype.info (); | |
| 3543 | |
| 5785 | 3544 if (typ == MatrixType::Permuted_Lower || |
| 3545 typ == MatrixType::Lower) | |
| 5164 | 3546 { |
| 3547 double anorm = 0.; | |
| 3548 double ainvnorm = 0.; | |
| 5681 | 3549 rcond = 1.; |
| 3550 | |
| 3551 if (calc_cond) | |
| 3552 { | |
| 3553 // Calculate the 1-norm of matrix for rcond calculation | |
| 3554 for (octave_idx_type j = 0; j < nc; j++) | |
| 3555 { | |
| 3556 double atmp = 0.; | |
| 3557 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3558 atmp += fabs(data(i)); | |
| 3559 if (atmp > anorm) | |
| 3560 anorm = atmp; | |
| 3561 } | |
| 5164 | 3562 } |
| 3563 | |
| 5275 | 3564 octave_idx_type b_nc = b.cols (); |
| 5681 | 3565 octave_idx_type b_nz = b.nnz (); |
| 5630 | 3566 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 3567 retval.xcidx(0) = 0; |
| 5275 | 3568 octave_idx_type ii = 0; |
| 3569 octave_idx_type x_nz = b_nz; | |
| 5164 | 3570 |
| 5785 | 3571 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3572 { |
| 5630 | 3573 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5322 | 3574 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3575 |
| 5275 | 3576 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3577 { |
| 5630 | 3578 for (octave_idx_type i = 0; i < nm; i++) |
| 5322 | 3579 cwork[i] = 0.; |
| 5275 | 3580 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 3581 cwork[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 3582 |
| 5630 | 3583 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3584 { |
| 5322 | 3585 if (cwork[k] != 0.) |
| 5164 | 3586 { |
| 5322 | 3587 octave_idx_type minr = nr; |
| 3588 octave_idx_type mini = 0; | |
| 3589 | |
| 3590 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3591 if (perm[ridx(i)] < minr) | |
| 3592 { | |
| 3593 minr = perm[ridx(i)]; | |
| 3594 mini = i; | |
| 3595 } | |
| 3596 | |
| 5681 | 3597 if (minr != k || data(mini) == 0) |
| 5164 | 3598 { |
| 3599 err = -2; | |
| 3600 goto triangular_error; | |
| 3601 } | |
| 3602 | |
| 5322 | 3603 Complex tmp = cwork[k] / data(mini); |
| 3604 cwork[k] = tmp; | |
| 3605 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3606 { |
| 5322 | 3607 if (i == mini) |
| 3608 continue; | |
| 3609 | |
| 3610 octave_idx_type iidx = perm[ridx(i)]; | |
| 3611 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 3612 } |
| 3613 } | |
| 3614 } | |
| 3615 | |
| 3616 // Count non-zeros in work vector and adjust space in | |
| 3617 // retval if needed | |
| 5275 | 3618 octave_idx_type new_nnz = 0; |
| 5630 | 3619 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3620 if (cwork[i] != 0.) |
| 5164 | 3621 new_nnz++; |
| 3622 | |
| 3623 if (ii + new_nnz > x_nz) | |
| 3624 { | |
| 3625 // Resize the sparse matrix | |
| 5275 | 3626 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3627 retval.change_capacity (sz); |
| 3628 x_nz = sz; | |
| 3629 } | |
| 3630 | |
| 5630 | 3631 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3632 if (cwork[i] != 0.) |
| 5164 | 3633 { |
| 3634 retval.xridx(ii) = i; | |
| 5322 | 3635 retval.xdata(ii++) = cwork[i]; |
| 5164 | 3636 } |
| 3637 retval.xcidx(j+1) = ii; | |
| 3638 } | |
| 3639 | |
| 3640 retval.maybe_compress (); | |
| 3641 | |
| 5681 | 3642 if (calc_cond) |
| 3643 { | |
| 3644 // Calculation of 1-norm of inv(*this) | |
| 3645 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3646 for (octave_idx_type i = 0; i < nm; i++) | |
| 3647 work[i] = 0.; | |
| 3648 | |
| 3649 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3650 { |
| 5681 | 3651 work[j] = 1.; |
| 3652 | |
| 3653 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3654 { |
| 5681 | 3655 if (work[k] != 0.) |
| 5164 | 3656 { |
| 5681 | 3657 octave_idx_type minr = nr; |
| 3658 octave_idx_type mini = 0; | |
| 3659 | |
| 3660 for (octave_idx_type i = cidx(k); | |
| 3661 i < cidx(k+1); i++) | |
| 3662 if (perm[ridx(i)] < minr) | |
| 3663 { | |
| 3664 minr = perm[ridx(i)]; | |
| 3665 mini = i; | |
| 3666 } | |
| 3667 | |
| 3668 double tmp = work[k] / data(mini); | |
| 3669 work[k] = tmp; | |
| 3670 for (octave_idx_type i = cidx(k); | |
| 3671 i < cidx(k+1); i++) | |
| 3672 { | |
| 3673 if (i == mini) | |
| 3674 continue; | |
| 3675 | |
| 3676 octave_idx_type iidx = perm[ridx(i)]; | |
| 3677 work[iidx] = work[iidx] - tmp * data(i); | |
| 3678 } | |
| 5164 | 3679 } |
| 3680 } | |
| 5681 | 3681 |
| 3682 double atmp = 0; | |
| 3683 for (octave_idx_type i = j; i < nc; i++) | |
| 3684 { | |
| 3685 atmp += fabs(work[i]); | |
| 3686 work[i] = 0.; | |
| 3687 } | |
| 3688 if (atmp > ainvnorm) | |
| 3689 ainvnorm = atmp; | |
| 5164 | 3690 } |
| 5681 | 3691 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3692 } |
| 3693 } | |
| 3694 else | |
| 3695 { | |
| 5630 | 3696 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 3697 |
| 5275 | 3698 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3699 { |
| 5630 | 3700 for (octave_idx_type i = 0; i < nm; i++) |
| 3701 cwork[i] = 0.; | |
| 5275 | 3702 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5630 | 3703 cwork[b.ridx(i)] = b.data(i); |
| 3704 | |
| 3705 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3706 { |
| 5630 | 3707 if (cwork[k] != 0.) |
| 5164 | 3708 { |
| 5681 | 3709 if (ridx(cidx(k)) != k || |
| 3710 data(cidx(k)) == 0.) | |
| 5164 | 3711 { |
| 3712 err = -2; | |
| 3713 goto triangular_error; | |
| 3714 } | |
| 3715 | |
| 5630 | 3716 Complex tmp = cwork[k] / data(cidx(k)); |
| 3717 cwork[k] = tmp; | |
| 5275 | 3718 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3719 { |
| 5275 | 3720 octave_idx_type iidx = ridx(i); |
| 5630 | 3721 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 3722 } |
| 3723 } | |
| 3724 } | |
| 3725 | |
| 3726 // Count non-zeros in work vector and adjust space in | |
| 3727 // retval if needed | |
| 5275 | 3728 octave_idx_type new_nnz = 0; |
| 5630 | 3729 for (octave_idx_type i = 0; i < nc; i++) |
| 3730 if (cwork[i] != 0.) | |
| 5164 | 3731 new_nnz++; |
| 3732 | |
| 3733 if (ii + new_nnz > x_nz) | |
| 3734 { | |
| 3735 // Resize the sparse matrix | |
| 5275 | 3736 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3737 retval.change_capacity (sz); |
| 3738 x_nz = sz; | |
| 3739 } | |
| 3740 | |
| 5630 | 3741 for (octave_idx_type i = 0; i < nc; i++) |
| 3742 if (cwork[i] != 0.) | |
| 5164 | 3743 { |
| 3744 retval.xridx(ii) = i; | |
| 5630 | 3745 retval.xdata(ii++) = cwork[i]; |
| 5164 | 3746 } |
| 3747 retval.xcidx(j+1) = ii; | |
| 3748 } | |
| 3749 | |
| 3750 retval.maybe_compress (); | |
| 3751 | |
| 5681 | 3752 if (calc_cond) |
| 3753 { | |
| 3754 // Calculation of 1-norm of inv(*this) | |
| 3755 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3756 for (octave_idx_type i = 0; i < nm; i++) | |
| 3757 work[i] = 0.; | |
| 3758 | |
| 3759 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3760 { |
| 5681 | 3761 work[j] = 1.; |
| 3762 | |
| 3763 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3764 { |
| 5681 | 3765 |
| 3766 if (work[k] != 0.) | |
| 5164 | 3767 { |
| 5681 | 3768 double tmp = work[k] / data(cidx(k)); |
| 3769 work[k] = tmp; | |
| 3770 for (octave_idx_type i = cidx(k)+1; | |
| 3771 i < cidx(k+1); i++) | |
| 3772 { | |
| 3773 octave_idx_type iidx = ridx(i); | |
| 3774 work[iidx] = work[iidx] - tmp * data(i); | |
| 3775 } | |
| 5164 | 3776 } |
| 3777 } | |
| 5681 | 3778 double atmp = 0; |
| 3779 for (octave_idx_type i = j; i < nc; i++) | |
| 3780 { | |
| 3781 atmp += fabs(work[i]); | |
| 3782 work[i] = 0.; | |
| 3783 } | |
| 3784 if (atmp > ainvnorm) | |
| 3785 ainvnorm = atmp; | |
| 5164 | 3786 } |
| 5681 | 3787 rcond = 1. / ainvnorm / anorm; |
| 3788 } | |
| 3789 } | |
| 5164 | 3790 |
| 3791 triangular_error: | |
| 3792 if (err != 0) | |
| 3793 { | |
| 3794 if (sing_handler) | |
| 5681 | 3795 { |
| 3796 sing_handler (rcond); | |
| 3797 mattype.mark_as_rectangular (); | |
| 3798 } | |
| 5164 | 3799 else |
| 3800 (*current_liboctave_error_handler) | |
| 3801 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3802 rcond); | |
| 3803 } | |
| 3804 | |
| 3805 volatile double rcond_plus_one = rcond + 1.0; | |
| 3806 | |
| 3807 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3808 { | |
| 3809 err = -2; | |
| 3810 | |
| 3811 if (sing_handler) | |
| 5681 | 3812 { |
| 3813 sing_handler (rcond); | |
| 3814 mattype.mark_as_rectangular (); | |
| 3815 } | |
| 5164 | 3816 else |
| 3817 (*current_liboctave_error_handler) | |
| 3818 ("matrix singular to machine precision, rcond = %g", | |
| 3819 rcond); | |
| 3820 } | |
| 3821 } | |
| 3822 else | |
| 3823 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3824 } | |
| 3825 | |
| 3826 return retval; | |
| 3827 } | |
| 3828 | |
| 3829 Matrix | |
| 5785 | 3830 SparseMatrix::trisolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 3831 octave_idx_type& err, double& rcond, |
| 3832 solve_singularity_handler sing_handler, | |
| 3833 bool calc_cond) const | |
| 5164 | 3834 { |
| 3835 Matrix retval; | |
| 3836 | |
| 5275 | 3837 octave_idx_type nr = rows (); |
| 3838 octave_idx_type nc = cols (); | |
| 5164 | 3839 err = 0; |
| 3840 | |
| 6924 | 3841 if (nr != nc || nr != b.rows ()) |
| 5164 | 3842 (*current_liboctave_error_handler) |
| 3843 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3844 else if (nr == 0 || b.cols () == 0) |
| 3845 retval = Matrix (nc, b.cols (), 0.0); | |
| 5681 | 3846 else if (calc_cond) |
| 3847 (*current_liboctave_error_handler) | |
| 3848 ("calculation of condition number not implemented"); | |
| 5164 | 3849 else |
| 3850 { | |
| 3851 // Print spparms("spumoni") info if requested | |
| 3852 volatile int typ = mattype.type (); | |
| 3853 mattype.info (); | |
| 3854 | |
| 5785 | 3855 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3856 { |
| 3857 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 3858 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 3859 | |
| 3860 if (mattype.is_dense ()) | |
| 3861 { | |
| 5275 | 3862 octave_idx_type ii = 0; |
| 3863 | |
| 3864 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3865 { |
| 3866 D[j] = data(ii++); | |
| 3867 DL[j] = data(ii); | |
| 3868 ii += 2; | |
| 3869 } | |
| 3870 D[nc-1] = data(ii); | |
| 3871 } | |
| 3872 else | |
| 3873 { | |
| 3874 D[0] = 0.; | |
| 5275 | 3875 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3876 { |
| 3877 D[i+1] = 0.; | |
| 3878 DL[i] = 0.; | |
| 3879 } | |
| 3880 | |
| 5275 | 3881 for (octave_idx_type j = 0; j < nc; j++) |
| 3882 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3883 { |
| 3884 if (ridx(i) == j) | |
| 3885 D[j] = data(i); | |
| 3886 else if (ridx(i) == j + 1) | |
| 3887 DL[j] = data(i); | |
| 3888 } | |
| 3889 } | |
| 3890 | |
| 5275 | 3891 octave_idx_type b_nc = b.cols(); |
| 5164 | 3892 retval = b; |
| 3893 double *result = retval.fortran_vec (); | |
| 3894 | |
| 3895 F77_XFCN (dptsv, DPTSV, (nr, b_nc, D, DL, result, | |
| 3896 b.rows(), err)); | |
| 3897 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3898 if (err != 0) |
| 5164 | 3899 { |
| 3900 err = 0; | |
| 3901 mattype.mark_as_unsymmetric (); | |
| 5785 | 3902 typ = MatrixType::Tridiagonal; |
| 5164 | 3903 } |
| 3904 else | |
| 3905 rcond = 1.; | |
| 3906 } | |
| 3907 | |
| 5785 | 3908 if (typ == MatrixType::Tridiagonal) |
| 5164 | 3909 { |
| 3910 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 3911 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 3912 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 3913 | |
| 3914 if (mattype.is_dense ()) | |
| 3915 { | |
| 5275 | 3916 octave_idx_type ii = 0; |
| 3917 | |
| 3918 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3919 { |
| 3920 D[j] = data(ii++); | |
| 3921 DL[j] = data(ii++); | |
| 3922 DU[j] = data(ii++); | |
| 3923 } | |
| 3924 D[nc-1] = data(ii); | |
| 3925 } | |
| 3926 else | |
| 3927 { | |
| 3928 D[0] = 0.; | |
| 5275 | 3929 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3930 { |
| 3931 D[i+1] = 0.; | |
| 3932 DL[i] = 0.; | |
| 3933 DU[i] = 0.; | |
| 3934 } | |
| 3935 | |
| 5275 | 3936 for (octave_idx_type j = 0; j < nc; j++) |
| 3937 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3938 { |
| 3939 if (ridx(i) == j) | |
| 3940 D[j] = data(i); | |
| 3941 else if (ridx(i) == j + 1) | |
| 3942 DL[j] = data(i); | |
| 3943 else if (ridx(i) == j - 1) | |
| 5322 | 3944 DU[j-1] = data(i); |
| 5164 | 3945 } |
| 3946 } | |
| 3947 | |
| 5275 | 3948 octave_idx_type b_nc = b.cols(); |
| 5164 | 3949 retval = b; |
| 3950 double *result = retval.fortran_vec (); | |
| 3951 | |
| 3952 F77_XFCN (dgtsv, DGTSV, (nr, b_nc, DL, D, DU, result, | |
| 3953 b.rows(), err)); | |
| 3954 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3955 if (err != 0) |
| 5164 | 3956 { |
| 3957 rcond = 0.; | |
| 3958 err = -2; | |
| 3959 | |
| 3960 if (sing_handler) | |
| 5681 | 3961 { |
| 3962 sing_handler (rcond); | |
| 3963 mattype.mark_as_rectangular (); | |
| 3964 } | |
| 5164 | 3965 else |
| 3966 (*current_liboctave_error_handler) | |
| 3967 ("matrix singular to machine precision"); | |
| 3968 | |
| 3969 } | |
| 3970 else | |
| 3971 rcond = 1.; | |
| 3972 } | |
| 5785 | 3973 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3974 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 3975 } | |
| 3976 | |
| 3977 return retval; | |
| 3978 } | |
| 3979 | |
| 3980 SparseMatrix | |
| 5785 | 3981 SparseMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 3982 octave_idx_type& err, double& rcond, |
| 3983 solve_singularity_handler sing_handler, | |
| 3984 bool calc_cond) const | |
| 5164 | 3985 { |
| 3986 SparseMatrix retval; | |
| 3987 | |
| 5275 | 3988 octave_idx_type nr = rows (); |
| 3989 octave_idx_type nc = cols (); | |
| 5164 | 3990 err = 0; |
| 3991 | |
| 6924 | 3992 if (nr != nc || nr != b.rows ()) |
| 5164 | 3993 (*current_liboctave_error_handler) |
| 3994 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3995 else if (nr == 0 || b.cols () == 0) |
| 3996 retval = SparseMatrix (nc, b.cols ()); | |
| 5681 | 3997 else if (calc_cond) |
| 3998 (*current_liboctave_error_handler) | |
| 3999 ("calculation of condition number not implemented"); | |
| 5164 | 4000 else |
| 4001 { | |
| 4002 // Print spparms("spumoni") info if requested | |
| 4003 int typ = mattype.type (); | |
| 4004 mattype.info (); | |
| 4005 | |
| 4006 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 4007 if (typ == MatrixType::Tridiagonal || |
| 4008 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 4009 { |
| 4010 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); | |
| 4011 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 4012 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 4013 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 5275 | 4014 Array<octave_idx_type> ipvt (nr); |
| 4015 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4016 |
| 4017 if (mattype.is_dense ()) | |
| 4018 { | |
| 5275 | 4019 octave_idx_type ii = 0; |
| 4020 | |
| 4021 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4022 { |
| 4023 D[j] = data(ii++); | |
| 4024 DL[j] = data(ii++); | |
| 4025 DU[j] = data(ii++); | |
| 4026 } | |
| 4027 D[nc-1] = data(ii); | |
| 4028 } | |
| 4029 else | |
| 4030 { | |
| 4031 D[0] = 0.; | |
| 5275 | 4032 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4033 { |
| 4034 D[i+1] = 0.; | |
| 4035 DL[i] = 0.; | |
| 4036 DU[i] = 0.; | |
| 4037 } | |
| 4038 | |
| 5275 | 4039 for (octave_idx_type j = 0; j < nc; j++) |
| 4040 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4041 { |
| 4042 if (ridx(i) == j) | |
| 4043 D[j] = data(i); | |
| 4044 else if (ridx(i) == j + 1) | |
| 4045 DL[j] = data(i); | |
| 4046 else if (ridx(i) == j - 1) | |
| 5322 | 4047 DU[j-1] = data(i); |
| 5164 | 4048 } |
| 4049 } | |
| 4050 | |
| 4051 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 4052 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4053 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4054 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4055 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4056 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4057 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4058 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4059 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4060 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4061 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4062 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4063 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4064 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4065 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4066 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4067 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4068 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4069 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4070 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4071 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4072 volatile octave_idx_type x_nz = b.nnz (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4073 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4074 retval = SparseMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4075 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4076 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4077 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4078 OCTAVE_LOCAL_BUFFER (double, work, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4079 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4080 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4081 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4082 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4083 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4084 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4085 work[b.ridx(i)] = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4086 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4087 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4088 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4089 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4090 work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4091 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4092 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4093 // Count non-zeros in work vector and adjust |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4094 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4095 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4096 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4097 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4098 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4099 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4100 if (ii + new_nnz > x_nz) |
| 5164 | 4101 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4102 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4103 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4104 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4105 x_nz = sz; |
| 5164 | 4106 } |
| 4107 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4108 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4109 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4110 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4111 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4112 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4113 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4114 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4115 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4116 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4117 retval.maybe_compress (); |
| 5164 | 4118 } |
| 4119 } | |
| 5785 | 4120 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4121 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4122 } | |
| 4123 | |
| 4124 return retval; | |
| 4125 } | |
| 4126 | |
| 4127 ComplexMatrix | |
| 5785 | 4128 SparseMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 4129 octave_idx_type& err, double& rcond, |
| 4130 solve_singularity_handler sing_handler, | |
| 4131 bool calc_cond) const | |
| 5164 | 4132 { |
| 4133 ComplexMatrix retval; | |
| 4134 | |
| 5275 | 4135 octave_idx_type nr = rows (); |
| 4136 octave_idx_type nc = cols (); | |
| 5164 | 4137 err = 0; |
| 4138 | |
| 6924 | 4139 if (nr != nc || nr != b.rows ()) |
| 5164 | 4140 (*current_liboctave_error_handler) |
| 4141 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4142 else if (nr == 0 || b.cols () == 0) |
| 4143 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5681 | 4144 else if (calc_cond) |
| 4145 (*current_liboctave_error_handler) | |
| 4146 ("calculation of condition number not implemented"); | |
| 5164 | 4147 else |
| 4148 { | |
| 4149 // Print spparms("spumoni") info if requested | |
| 4150 volatile int typ = mattype.type (); | |
| 4151 mattype.info (); | |
| 4152 | |
| 5785 | 4153 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4154 { |
| 5322 | 4155 OCTAVE_LOCAL_BUFFER (double, D, nr); |
| 5164 | 4156 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); |
| 4157 | |
| 4158 if (mattype.is_dense ()) | |
| 4159 { | |
| 5275 | 4160 octave_idx_type ii = 0; |
| 4161 | |
| 4162 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4163 { |
| 4164 D[j] = data(ii++); | |
| 4165 DL[j] = data(ii); | |
| 4166 ii += 2; | |
| 4167 } | |
| 4168 D[nc-1] = data(ii); | |
| 4169 } | |
| 4170 else | |
| 4171 { | |
| 4172 D[0] = 0.; | |
| 5275 | 4173 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4174 { |
| 4175 D[i+1] = 0.; | |
| 4176 DL[i] = 0.; | |
| 4177 } | |
| 4178 | |
| 5275 | 4179 for (octave_idx_type j = 0; j < nc; j++) |
| 4180 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4181 { |
| 4182 if (ridx(i) == j) | |
| 4183 D[j] = data(i); | |
| 4184 else if (ridx(i) == j + 1) | |
| 4185 DL[j] = data(i); | |
| 4186 } | |
| 4187 } | |
| 4188 | |
| 5275 | 4189 octave_idx_type b_nr = b.rows (); |
| 4190 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4191 rcond = 1.; |
| 4192 | |
| 4193 retval = b; | |
| 4194 Complex *result = retval.fortran_vec (); | |
| 4195 | |
| 4196 F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, | |
| 4197 b_nr, err)); | |
| 4198 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4199 if (err != 0) |
| 5164 | 4200 { |
| 4201 err = 0; | |
| 4202 mattype.mark_as_unsymmetric (); | |
| 5785 | 4203 typ = MatrixType::Tridiagonal; |
| 5164 | 4204 } |
| 4205 } | |
| 4206 | |
| 5785 | 4207 if (typ == MatrixType::Tridiagonal) |
| 5164 | 4208 { |
| 4209 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); | |
| 4210 OCTAVE_LOCAL_BUFFER (Complex, D, nr); | |
| 4211 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); | |
| 4212 | |
| 4213 if (mattype.is_dense ()) | |
| 4214 { | |
| 5275 | 4215 octave_idx_type ii = 0; |
| 4216 | |
| 4217 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4218 { |
| 4219 D[j] = data(ii++); | |
| 4220 DL[j] = data(ii++); | |
| 4221 DU[j] = data(ii++); | |
| 4222 } | |
| 4223 D[nc-1] = data(ii); | |
| 4224 } | |
| 4225 else | |
| 4226 { | |
| 4227 D[0] = 0.; | |
| 5275 | 4228 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4229 { |
| 4230 D[i+1] = 0.; | |
| 4231 DL[i] = 0.; | |
| 4232 DU[i] = 0.; | |
| 4233 } | |
| 4234 | |
| 5275 | 4235 for (octave_idx_type j = 0; j < nc; j++) |
| 4236 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4237 { |
| 4238 if (ridx(i) == j) | |
| 4239 D[j] = data(i); | |
| 4240 else if (ridx(i) == j + 1) | |
| 4241 DL[j] = data(i); | |
| 4242 else if (ridx(i) == j - 1) | |
| 5322 | 4243 DU[j-1] = data(i); |
| 5164 | 4244 } |
| 4245 } | |
| 4246 | |
| 5275 | 4247 octave_idx_type b_nr = b.rows(); |
| 4248 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4249 rcond = 1.; |
| 4250 | |
| 4251 retval = b; | |
| 4252 Complex *result = retval.fortran_vec (); | |
| 4253 | |
| 4254 F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, | |
| 4255 b_nr, err)); | |
| 4256 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4257 if (err != 0) |
| 5164 | 4258 { |
| 4259 rcond = 0.; | |
| 4260 err = -2; | |
| 4261 | |
| 4262 if (sing_handler) | |
| 5681 | 4263 { |
| 4264 sing_handler (rcond); | |
| 4265 mattype.mark_as_rectangular (); | |
| 4266 } | |
| 5164 | 4267 else |
| 4268 (*current_liboctave_error_handler) | |
| 4269 ("matrix singular to machine precision"); | |
| 4270 } | |
| 4271 } | |
| 5785 | 4272 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4273 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4274 } | |
| 4275 | |
| 4276 return retval; | |
| 4277 } | |
| 4278 | |
| 4279 SparseComplexMatrix | |
| 5785 | 4280 SparseMatrix::trisolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5681 | 4281 octave_idx_type& err, double& rcond, |
| 4282 solve_singularity_handler sing_handler, | |
| 4283 bool calc_cond) const | |
| 5164 | 4284 { |
| 4285 SparseComplexMatrix retval; | |
| 4286 | |
| 5275 | 4287 octave_idx_type nr = rows (); |
| 4288 octave_idx_type nc = cols (); | |
| 5164 | 4289 err = 0; |
| 4290 | |
| 6924 | 4291 if (nr != nc || nr != b.rows ()) |
| 5164 | 4292 (*current_liboctave_error_handler) |
| 4293 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4294 else if (nr == 0 || b.cols () == 0) |
| 4295 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5681 | 4296 else if (calc_cond) |
| 4297 (*current_liboctave_error_handler) | |
| 4298 ("calculation of condition number not implemented"); | |
| 5164 | 4299 else |
| 4300 { | |
| 4301 // Print spparms("spumoni") info if requested | |
| 4302 int typ = mattype.type (); | |
| 4303 mattype.info (); | |
| 4304 | |
| 4305 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 4306 if (typ == MatrixType::Tridiagonal || |
| 4307 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 4308 { |
| 4309 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); | |
| 4310 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 4311 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 4312 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 5275 | 4313 Array<octave_idx_type> ipvt (nr); |
| 4314 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4315 |
| 4316 if (mattype.is_dense ()) | |
| 4317 { | |
| 5275 | 4318 octave_idx_type ii = 0; |
| 4319 | |
| 4320 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4321 { |
| 4322 D[j] = data(ii++); | |
| 4323 DL[j] = data(ii++); | |
| 4324 DU[j] = data(ii++); | |
| 4325 } | |
| 4326 D[nc-1] = data(ii); | |
| 4327 } | |
| 4328 else | |
| 4329 { | |
| 4330 D[0] = 0.; | |
| 5275 | 4331 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4332 { |
| 4333 D[i+1] = 0.; | |
| 4334 DL[i] = 0.; | |
| 4335 DU[i] = 0.; | |
| 4336 } | |
| 4337 | |
| 5275 | 4338 for (octave_idx_type j = 0; j < nc; j++) |
| 4339 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4340 { |
| 4341 if (ridx(i) == j) | |
| 4342 D[j] = data(i); | |
| 4343 else if (ridx(i) == j + 1) | |
| 4344 DL[j] = data(i); | |
| 4345 else if (ridx(i) == j - 1) | |
| 5322 | 4346 DU[j-1] = data(i); |
| 5164 | 4347 } |
| 4348 } | |
| 4349 | |
| 4350 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 4351 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4352 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4353 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4354 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4355 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4356 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4357 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4358 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4359 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4360 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4361 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4362 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4363 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4364 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4365 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4366 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4367 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4368 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4369 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4370 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4371 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4372 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4373 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4374 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4375 // Take a first guess that the number of non-zero terms |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4376 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4377 volatile octave_idx_type x_nz = b.nnz (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4378 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4379 retval = SparseComplexMatrix (b_nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4380 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4381 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4382 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4383 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4384 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4385 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5681 | 4386 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4387 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4388 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4389 Bz[i] = std::imag (c); |
| 5681 | 4390 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4391 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4392 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4393 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4394 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4395 Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4396 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4397 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4398 if (err != 0) |
| 5164 | 4399 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4400 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4401 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4402 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4403 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4404 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4405 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4406 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4407 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4408 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4409 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4410 Bz, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4411 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4412 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4413 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4414 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4415 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4416 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4417 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4418 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4419 break; |
| 5164 | 4420 } |
| 4421 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4422 // Count non-zeros in work vector and adjust |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4423 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4424 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4425 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4426 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4427 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4428 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4429 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4430 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4431 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4432 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4433 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4434 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4435 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4436 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4437 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4438 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4439 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4440 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4441 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4442 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4443 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4444 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4445 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4446 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4447 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4448 retval.maybe_compress (); |
| 5164 | 4449 } |
| 4450 } | |
| 5785 | 4451 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4452 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4453 } | |
| 4454 | |
| 4455 return retval; | |
| 4456 } | |
| 4457 | |
| 4458 Matrix | |
| 5785 | 4459 SparseMatrix::bsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 4460 octave_idx_type& err, double& rcond, |
| 4461 solve_singularity_handler sing_handler, | |
| 4462 bool calc_cond) const | |
| 5164 | 4463 { |
| 4464 Matrix retval; | |
| 4465 | |
| 5275 | 4466 octave_idx_type nr = rows (); |
| 4467 octave_idx_type nc = cols (); | |
| 5164 | 4468 err = 0; |
| 4469 | |
| 6924 | 4470 if (nr != nc || nr != b.rows ()) |
| 5164 | 4471 (*current_liboctave_error_handler) |
| 4472 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4473 else if (nr == 0 || b.cols () == 0) |
| 4474 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 4475 else |
| 4476 { | |
| 4477 // Print spparms("spumoni") info if requested | |
| 4478 volatile int typ = mattype.type (); | |
| 4479 mattype.info (); | |
| 4480 | |
| 5785 | 4481 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4482 { |
| 5275 | 4483 octave_idx_type n_lower = mattype.nlower (); |
| 4484 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4485 Matrix m_band (ldm, nc); |
| 4486 double *tmp_data = m_band.fortran_vec (); | |
| 4487 | |
| 4488 if (! mattype.is_dense ()) | |
| 4489 { | |
| 5275 | 4490 octave_idx_type ii = 0; |
| 4491 | |
| 4492 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4493 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4494 tmp_data[ii++] = 0.; |
| 4495 } | |
| 4496 | |
| 5275 | 4497 for (octave_idx_type j = 0; j < nc; j++) |
| 4498 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4499 { |
| 5275 | 4500 octave_idx_type ri = ridx (i); |
| 5164 | 4501 if (ri >= j) |
| 4502 m_band(ri - j, j) = data(i); | |
| 4503 } | |
| 4504 | |
| 4505 // Calculate the norm of the matrix, for later use. | |
| 5681 | 4506 double anorm; |
| 4507 if (calc_cond) | |
| 4508 anorm = m_band.abs().sum().row(0).max(); | |
| 5164 | 4509 |
| 4510 char job = 'L'; | |
| 4511 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4512 nr, n_lower, tmp_data, ldm, err | |
| 4513 F77_CHAR_ARG_LEN (1))); | |
| 4514 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4515 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4516 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4517 // Matrix is not positive definite!! Fall through to |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4518 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4519 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4520 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4521 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4522 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4523 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4524 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4525 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4526 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4527 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4528 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4529 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4530 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4531 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4532 |
| 7776 | 4533 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4534 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4535 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4536 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4537 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4538 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4539 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4540 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4541 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4542 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4543 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4544 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4545 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4546 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4547 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4548 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4549 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4550 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4551 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4552 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4553 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4554 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4555 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4556 rcond); |
| 5681 | 4557 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4558 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4559 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4560 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4561 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4562 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4563 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4564 retval = b; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4565 double *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4566 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4567 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4568 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4569 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4570 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4571 nr, n_lower, b_nc, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4572 ldm, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4573 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4574 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4575 if (err != 0) |
| 5681 | 4576 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4577 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4578 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4579 err = -1; |
| 5164 | 4580 } |
| 4581 } | |
| 4582 } | |
| 4583 } | |
| 4584 | |
| 5785 | 4585 if (typ == MatrixType::Banded) |
| 5164 | 4586 { |
| 4587 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 4588 octave_idx_type n_upper = mattype.nupper (); |
| 4589 octave_idx_type n_lower = mattype.nlower (); | |
| 4590 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4591 |
| 4592 Matrix m_band (ldm, nc); | |
| 4593 double *tmp_data = m_band.fortran_vec (); | |
| 4594 | |
| 4595 if (! mattype.is_dense ()) | |
| 4596 { | |
| 5275 | 4597 octave_idx_type ii = 0; |
| 4598 | |
| 4599 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4600 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4601 tmp_data[ii++] = 0.; |
| 4602 } | |
| 4603 | |
| 5275 | 4604 for (octave_idx_type j = 0; j < nc; j++) |
| 4605 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4606 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4607 | |
| 5681 | 4608 // Calculate the norm of the matrix, for later use. |
| 4609 double anorm; | |
| 4610 if (calc_cond) | |
| 4611 { | |
| 4612 for (octave_idx_type j = 0; j < nr; j++) | |
| 4613 { | |
| 4614 double atmp = 0.; | |
| 4615 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4616 atmp += fabs(data(i)); | |
| 4617 if (atmp > anorm) | |
| 4618 anorm = atmp; | |
| 4619 } | |
| 4620 } | |
| 4621 | |
| 5275 | 4622 Array<octave_idx_type> ipvt (nr); |
| 4623 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4624 |
| 4625 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 4626 ldm, pipvt, err)); | |
| 4627 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4628 // Throw-away extra info LAPACK gives so as to not |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4629 // change output. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4630 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4631 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4632 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4633 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4634 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4635 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4636 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4637 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4638 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4639 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4640 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4641 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4642 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4643 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4644 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4645 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4646 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4647 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4648 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4649 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4650 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4651 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4652 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4653 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4654 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4655 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4656 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4657 nc, n_lower, n_upper, tmp_data, ldm, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4658 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4659 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4660 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4661 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4662 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4663 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4664 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4665 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4666 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4667 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4668 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4669 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4670 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4671 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4672 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4673 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4674 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4675 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4676 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4677 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4678 rcond); |
| 5681 | 4679 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4680 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4681 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4682 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4683 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4684 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4685 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4686 retval = b; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4687 double *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4688 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4689 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4690 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4691 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4692 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4693 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4694 nr, n_lower, n_upper, b_nc, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4695 ldm, pipvt, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4696 F77_CHAR_ARG_LEN (1))); |
| 5164 | 4697 } |
| 4698 } | |
| 4699 } | |
| 5785 | 4700 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 4701 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4702 } | |
| 4703 | |
| 4704 return retval; | |
| 4705 } | |
| 4706 | |
| 4707 SparseMatrix | |
| 5785 | 4708 SparseMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 4709 octave_idx_type& err, double& rcond, |
| 4710 solve_singularity_handler sing_handler, | |
| 4711 bool calc_cond) const | |
| 5164 | 4712 { |
| 4713 SparseMatrix retval; | |
| 4714 | |
| 5275 | 4715 octave_idx_type nr = rows (); |
| 4716 octave_idx_type nc = cols (); | |
| 5164 | 4717 err = 0; |
| 4718 | |
| 6924 | 4719 if (nr != nc || nr != b.rows ()) |
| 5164 | 4720 (*current_liboctave_error_handler) |
| 4721 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4722 else if (nr == 0 || b.cols () == 0) |
| 4723 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 4724 else |
| 4725 { | |
| 4726 // Print spparms("spumoni") info if requested | |
| 4727 volatile int typ = mattype.type (); | |
| 4728 mattype.info (); | |
| 4729 | |
| 5785 | 4730 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4731 { |
| 6242 | 4732 octave_idx_type n_lower = mattype.nlower (); |
| 4733 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4734 |
| 4735 Matrix m_band (ldm, nc); | |
| 4736 double *tmp_data = m_band.fortran_vec (); | |
| 4737 | |
| 4738 if (! mattype.is_dense ()) | |
| 4739 { | |
| 5275 | 4740 octave_idx_type ii = 0; |
| 4741 | |
| 4742 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4743 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4744 tmp_data[ii++] = 0.; |
| 4745 } | |
| 4746 | |
| 5275 | 4747 for (octave_idx_type j = 0; j < nc; j++) |
| 4748 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4749 { |
| 5275 | 4750 octave_idx_type ri = ridx (i); |
| 5164 | 4751 if (ri >= j) |
| 4752 m_band(ri - j, j) = data(i); | |
| 4753 } | |
| 4754 | |
| 5681 | 4755 // Calculate the norm of the matrix, for later use. |
| 4756 double anorm; | |
| 4757 if (calc_cond) | |
| 4758 anorm = m_band.abs().sum().row(0).max(); | |
| 4759 | |
| 5164 | 4760 char job = 'L'; |
| 4761 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4762 nr, n_lower, tmp_data, ldm, err | |
| 4763 F77_CHAR_ARG_LEN (1))); | |
| 4764 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4765 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4766 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4767 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4768 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4769 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4770 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4771 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4772 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4773 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4774 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4775 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4776 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4777 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4778 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4779 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4780 |
| 7776 | 4781 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4782 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4783 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4784 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4785 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4786 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4787 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4788 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4789 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4790 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4791 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4792 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4793 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4794 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4795 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4796 if (sing_handler) |
| 5681 | 4797 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4798 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4799 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4800 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4801 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4802 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4803 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4804 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4805 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4806 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4807 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4808 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4809 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4810 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4811 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4812 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4813 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4814 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4815 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4816 // Take a first guess that the number of non-zero terms |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4817 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4818 volatile octave_idx_type x_nz = b.nnz (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4819 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4820 retval = SparseMatrix (b_nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4821 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4822 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4823 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4824 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4825 for (octave_idx_type i = 0; i < b_nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4826 Bx[i] = b.elem (i, j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4827 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4828 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4829 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4830 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4831 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4832 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4833 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4834 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4835 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4836 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4837 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4838 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4839 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4840 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4841 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4842 for (octave_idx_type i = 0; i < b_nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4843 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4844 double tmp = Bx[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4845 if (tmp != 0.0) |
| 5681 | 4846 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4847 if (ii == x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4848 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4849 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4850 octave_idx_type sz = x_nz * |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4851 (b_nc - j) / b_nc; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4852 sz = (sz > 10 ? sz : 10) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4853 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4854 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4855 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4856 retval.xdata(ii) = tmp; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4857 retval.xridx(ii++) = i; |
| 5681 | 4858 } |
| 5164 | 4859 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4860 retval.xcidx(j+1) = ii; |
| 5164 | 4861 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4862 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4863 retval.maybe_compress (); |
| 5164 | 4864 } |
| 4865 } | |
| 4866 } | |
| 4867 | |
| 5785 | 4868 if (typ == MatrixType::Banded) |
| 5164 | 4869 { |
| 4870 // Create the storage for the banded form of the sparse matrix | |
| 5275 | 4871 octave_idx_type n_upper = mattype.nupper (); |
| 4872 octave_idx_type n_lower = mattype.nlower (); | |
| 4873 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4874 |
| 4875 Matrix m_band (ldm, nc); | |
| 4876 double *tmp_data = m_band.fortran_vec (); | |
| 4877 | |
| 4878 if (! mattype.is_dense ()) | |
| 4879 { | |
| 5275 | 4880 octave_idx_type ii = 0; |
| 4881 | |
| 4882 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4883 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4884 tmp_data[ii++] = 0.; |
| 4885 } | |
| 4886 | |
| 5275 | 4887 for (octave_idx_type j = 0; j < nc; j++) |
| 4888 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4889 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4890 | |
| 5681 | 4891 // Calculate the norm of the matrix, for later use. |
| 4892 double anorm; | |
| 4893 if (calc_cond) | |
| 4894 { | |
| 4895 for (octave_idx_type j = 0; j < nr; j++) | |
| 4896 { | |
| 4897 double atmp = 0.; | |
| 4898 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4899 atmp += fabs(data(i)); | |
| 4900 if (atmp > anorm) | |
| 4901 anorm = atmp; | |
| 4902 } | |
| 4903 } | |
| 4904 | |
| 5275 | 4905 Array<octave_idx_type> ipvt (nr); |
| 4906 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4907 |
| 4908 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 4909 ldm, pipvt, err)); | |
| 4910 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4911 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4912 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4913 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4914 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4915 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4916 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4917 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4918 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4919 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4920 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4921 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4922 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4923 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4924 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4925 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4926 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4927 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4928 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4929 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4930 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4931 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4932 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4933 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4934 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4935 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4936 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4937 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4938 nc, n_lower, n_upper, tmp_data, ldm, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4939 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4940 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4941 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4942 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4943 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4944 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4945 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4946 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4947 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4948 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4949 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4950 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4951 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4952 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4953 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4954 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4955 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4956 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4957 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4958 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4959 rcond); |
| 5681 | 4960 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4961 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4962 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4963 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4964 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4965 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4966 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4967 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4968 volatile octave_idx_type x_nz = b.nnz (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4969 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4970 retval = SparseMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4971 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4972 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4973 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4974 OCTAVE_LOCAL_BUFFER (double, work, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4975 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4976 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 4977 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4978 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4979 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4980 for (octave_idx_type i = b.cidx(j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4981 i < b.cidx(j+1); i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4982 work[b.ridx(i)] = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4983 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4984 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4985 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4986 nr, n_lower, n_upper, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4987 ldm, pipvt, work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4988 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4989 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4990 // Count non-zeros in work vector and adjust |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4991 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4992 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4993 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4994 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4995 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4996 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4997 if (ii + new_nnz > x_nz) |
| 5164 | 4998 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4999 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5000 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5001 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5002 x_nz = sz; |
| 5164 | 5003 } |
| 5004 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5005 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5006 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5007 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5008 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5009 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5010 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5011 retval.xcidx(j+1) = ii; |
| 5164 | 5012 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5013 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5014 retval.maybe_compress (); |
| 5164 | 5015 } |
| 5016 } | |
| 5017 } | |
| 5785 | 5018 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5019 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5020 } | |
| 5021 | |
| 5022 return retval; | |
| 5023 } | |
| 5024 | |
| 5025 ComplexMatrix | |
| 5785 | 5026 SparseMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 5027 octave_idx_type& err, double& rcond, |
| 5028 solve_singularity_handler sing_handler, | |
| 5029 bool calc_cond) const | |
| 5164 | 5030 { |
| 5031 ComplexMatrix retval; | |
| 5032 | |
| 5275 | 5033 octave_idx_type nr = rows (); |
| 5034 octave_idx_type nc = cols (); | |
| 5164 | 5035 err = 0; |
| 5036 | |
| 6924 | 5037 if (nr != nc || nr != b.rows ()) |
| 5164 | 5038 (*current_liboctave_error_handler) |
| 5039 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5040 else if (nr == 0 || b.cols () == 0) |
| 5041 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 5042 else |
| 5043 { | |
| 5044 // Print spparms("spumoni") info if requested | |
| 5045 volatile int typ = mattype.type (); | |
| 5046 mattype.info (); | |
| 5047 | |
| 5785 | 5048 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 5049 { |
| 5275 | 5050 octave_idx_type n_lower = mattype.nlower (); |
| 5051 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 5052 |
| 5053 Matrix m_band (ldm, nc); | |
| 5054 double *tmp_data = m_band.fortran_vec (); | |
| 5055 | |
| 5056 if (! mattype.is_dense ()) | |
| 5057 { | |
| 5275 | 5058 octave_idx_type ii = 0; |
| 5059 | |
| 5060 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5061 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5062 tmp_data[ii++] = 0.; |
| 5063 } | |
| 5064 | |
| 5275 | 5065 for (octave_idx_type j = 0; j < nc; j++) |
| 5066 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5067 { |
| 5275 | 5068 octave_idx_type ri = ridx (i); |
| 5164 | 5069 if (ri >= j) |
| 5070 m_band(ri - j, j) = data(i); | |
| 5071 } | |
| 5072 | |
| 5681 | 5073 // Calculate the norm of the matrix, for later use. |
| 5074 double anorm; | |
| 5075 if (calc_cond) | |
| 5076 anorm = m_band.abs().sum().row(0).max(); | |
| 5077 | |
| 5164 | 5078 char job = 'L'; |
| 5079 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 5080 nr, n_lower, tmp_data, ldm, err | |
| 5081 F77_CHAR_ARG_LEN (1))); | |
| 5082 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5083 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5084 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5085 // Matrix is not positive definite!! Fall through to |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5086 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5087 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5088 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5089 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5090 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5091 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5092 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5093 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5094 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5095 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5096 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5097 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5098 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5099 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5100 |
| 7776 | 5101 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5102 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5103 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5104 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5105 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5106 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5107 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5108 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5109 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5110 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5111 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5112 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5113 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5114 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5115 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5116 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5117 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5118 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5119 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5120 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5121 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5122 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5123 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5124 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5125 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5126 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5127 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5128 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5129 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5130 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5131 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5132 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5133 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5134 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5135 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5136 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5137 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5138 retval.resize (b_nr, b_nc); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5139 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5140 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5141 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5142 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 5143 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5144 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5145 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5146 Bz[i] = std::imag (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5147 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5148 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5149 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5150 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5151 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5152 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5153 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5154 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5155 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5156 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5157 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5158 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5159 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5160 break; |
| 5164 | 5161 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5162 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5163 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5164 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5165 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5166 ldm, Bz, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5167 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5168 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5169 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5170 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5171 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5172 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5173 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5174 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5175 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5176 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5177 for (octave_idx_type i = 0; i < b_nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5178 retval (i, j) = Complex (Bx[i], Bz[i]); |
| 5164 | 5179 } |
| 5180 } | |
| 5181 } | |
| 5182 } | |
| 5183 | |
| 5785 | 5184 if (typ == MatrixType::Banded) |
| 5164 | 5185 { |
| 5186 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 5187 octave_idx_type n_upper = mattype.nupper (); |
| 5188 octave_idx_type n_lower = mattype.nlower (); | |
| 5189 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 5190 |
| 5191 Matrix m_band (ldm, nc); | |
| 5192 double *tmp_data = m_band.fortran_vec (); | |
| 5193 | |
| 5194 if (! mattype.is_dense ()) | |
| 5195 { | |
| 5275 | 5196 octave_idx_type ii = 0; |
| 5197 | |
| 5198 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5199 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5200 tmp_data[ii++] = 0.; |
| 5201 } | |
| 5202 | |
| 5275 | 5203 for (octave_idx_type j = 0; j < nc; j++) |
| 5204 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5205 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5206 | |
| 5681 | 5207 // Calculate the norm of the matrix, for later use. |
| 5208 double anorm; | |
| 5209 if (calc_cond) | |
| 5210 { | |
| 5211 for (octave_idx_type j = 0; j < nr; j++) | |
| 5212 { | |
| 5213 double atmp = 0.; | |
| 5214 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5215 atmp += fabs(data(i)); | |
| 5216 if (atmp > anorm) | |
| 5217 anorm = atmp; | |
| 5218 } | |
| 5219 } | |
| 5220 | |
| 5275 | 5221 Array<octave_idx_type> ipvt (nr); |
| 5222 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5223 |
| 5224 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5225 ldm, pipvt, err)); | |
| 5226 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5227 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5228 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5229 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5230 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5231 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5232 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5233 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5234 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5235 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5236 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5237 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5238 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5239 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5240 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5241 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5242 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5243 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5244 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5245 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5246 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5247 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5248 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5249 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5250 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5251 |
| 7776 | 5252 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5253 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5254 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5255 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5256 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5257 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5258 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5259 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5260 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5261 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5262 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5263 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 5264 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5265 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5266 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5267 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5268 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5269 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5270 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5271 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5272 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5273 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5274 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5275 rcond); |
| 5681 | 5276 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5277 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5278 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5279 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5280 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5281 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5282 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5283 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5284 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5285 retval.resize (nr,b_nc); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5286 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5287 OCTAVE_LOCAL_BUFFER (double, Bz, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5288 OCTAVE_LOCAL_BUFFER (double, Bx, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5289 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5290 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 5291 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5292 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 5293 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5294 Complex c = b (i, j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5295 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5296 Bz[i] = std::imag (c); |
| 5164 | 5297 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5298 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5299 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5300 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5301 nr, n_lower, n_upper, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5302 ldm, pipvt, Bx, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5303 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5304 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5305 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5306 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5307 nr, n_lower, n_upper, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5308 ldm, pipvt, Bz, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5309 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5310 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5311 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5312 retval (i, j) = Complex (Bx[i], Bz[i]); |
| 5164 | 5313 } |
| 5314 } | |
| 5315 } | |
| 5316 } | |
| 5785 | 5317 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5318 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5319 } | |
| 5320 | |
| 5321 return retval; | |
| 5322 } | |
| 5323 | |
| 5324 SparseComplexMatrix | |
| 5785 | 5325 SparseMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5681 | 5326 octave_idx_type& err, double& rcond, |
| 5327 solve_singularity_handler sing_handler, | |
| 5328 bool calc_cond) const | |
| 5164 | 5329 { |
| 5330 SparseComplexMatrix retval; | |
| 5331 | |
| 5275 | 5332 octave_idx_type nr = rows (); |
| 5333 octave_idx_type nc = cols (); | |
| 5164 | 5334 err = 0; |
| 5335 | |
| 6924 | 5336 if (nr != nc || nr != b.rows ()) |
| 5164 | 5337 (*current_liboctave_error_handler) |
| 5338 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5339 else if (nr == 0 || b.cols () == 0) |
| 5340 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 5341 else |
| 5342 { | |
| 5343 // Print spparms("spumoni") info if requested | |
| 5344 volatile int typ = mattype.type (); | |
| 5345 mattype.info (); | |
| 5346 | |
| 5785 | 5347 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 5348 { |
| 6242 | 5349 octave_idx_type n_lower = mattype.nlower (); |
| 5350 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 5351 |
| 5352 Matrix m_band (ldm, nc); | |
| 5353 double *tmp_data = m_band.fortran_vec (); | |
| 5354 | |
| 5355 if (! mattype.is_dense ()) | |
| 5356 { | |
| 5275 | 5357 octave_idx_type ii = 0; |
| 5358 | |
| 5359 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5360 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5361 tmp_data[ii++] = 0.; |
| 5362 } | |
| 5363 | |
| 5275 | 5364 for (octave_idx_type j = 0; j < nc; j++) |
| 5365 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5366 { |
| 5275 | 5367 octave_idx_type ri = ridx (i); |
| 5164 | 5368 if (ri >= j) |
| 5369 m_band(ri - j, j) = data(i); | |
| 5370 } | |
| 5371 | |
| 5681 | 5372 // Calculate the norm of the matrix, for later use. |
| 5373 double anorm; | |
| 5374 if (calc_cond) | |
| 5375 anorm = m_band.abs().sum().row(0).max(); | |
| 5376 | |
| 5164 | 5377 char job = 'L'; |
| 5378 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 5379 nr, n_lower, tmp_data, ldm, err | |
| 5380 F77_CHAR_ARG_LEN (1))); | |
| 5381 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5382 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5383 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5384 // Matrix is not positive definite!! Fall through to |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5385 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5386 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5387 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5388 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5389 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5390 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5391 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5392 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5393 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5394 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5395 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5396 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5397 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5398 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5399 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5400 |
| 7776 | 5401 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5402 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5403 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5404 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5405 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5406 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5407 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5408 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5409 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5410 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5411 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5412 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 5413 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5414 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5415 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5416 if (sing_handler) |
| 5164 | 5417 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5418 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5419 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5420 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5421 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5422 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5423 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5424 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5425 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5426 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5427 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5428 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5429 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5430 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5431 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5432 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5433 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5434 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5435 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5436 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5437 // Take a first guess that the number of non-zero terms |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5438 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5439 volatile octave_idx_type x_nz = b.nnz (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5440 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5441 retval = SparseComplexMatrix (b_nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5442 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5443 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5444 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5445 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5446 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5447 for (octave_idx_type i = 0; i < b_nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5448 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5449 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5450 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5451 Bz[i] = std::imag (c); |
| 5164 | 5452 } |
| 5453 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5454 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5455 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5456 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5457 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5458 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5459 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5460 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5461 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5462 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5463 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5464 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5465 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5466 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5467 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5468 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5469 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5470 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5471 ldm, Bz, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5472 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5473 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5474 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5475 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5476 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5477 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5478 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5479 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5480 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5481 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5482 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5483 // Count non-zeros in work vector and adjust |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5484 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5485 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5486 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5487 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5488 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5489 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5490 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5491 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5492 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5493 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5494 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5495 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5496 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5497 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5498 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5499 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5500 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5501 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5502 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5503 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5504 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5505 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5506 retval.xcidx(j+1) = ii; |
| 5164 | 5507 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5508 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5509 retval.maybe_compress (); |
| 5164 | 5510 } |
| 5511 } | |
| 5512 } | |
| 5513 | |
| 5785 | 5514 if (typ == MatrixType::Banded) |
| 5164 | 5515 { |
| 5516 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 5517 octave_idx_type n_upper = mattype.nupper (); |
| 5518 octave_idx_type n_lower = mattype.nlower (); | |
| 5519 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 5520 |
| 5521 Matrix m_band (ldm, nc); | |
| 5522 double *tmp_data = m_band.fortran_vec (); | |
| 5523 | |
| 5524 if (! mattype.is_dense ()) | |
| 5525 { | |
| 5275 | 5526 octave_idx_type ii = 0; |
| 5527 | |
| 5528 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5529 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5530 tmp_data[ii++] = 0.; |
| 5531 } | |
| 5532 | |
| 5275 | 5533 for (octave_idx_type j = 0; j < nc; j++) |
| 5534 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5535 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5536 | |
| 5681 | 5537 // Calculate the norm of the matrix, for later use. |
| 5538 double anorm; | |
| 5539 if (calc_cond) | |
| 5540 { | |
| 5541 for (octave_idx_type j = 0; j < nr; j++) | |
| 5542 { | |
| 5543 double atmp = 0.; | |
| 5544 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5545 atmp += fabs(data(i)); | |
| 5546 if (atmp > anorm) | |
| 5547 anorm = atmp; | |
| 5548 } | |
| 5549 } | |
| 5550 | |
| 5275 | 5551 Array<octave_idx_type> ipvt (nr); |
| 5552 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5553 |
| 5554 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5555 ldm, pipvt, err)); | |
| 5556 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5557 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5558 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5559 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5560 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5561 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5562 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5563 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5564 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5565 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5566 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5567 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5568 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5569 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5570 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5571 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5572 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5573 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5574 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5575 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5576 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5577 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5578 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5579 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5580 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5581 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5582 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5583 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5584 nc, n_lower, n_upper, tmp_data, ldm, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5585 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5586 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5587 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5588 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5589 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5590 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5591 volatile double rcond_plus_one = rcond + 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5592 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5593 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5594 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5595 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5596 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5597 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5598 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5599 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5600 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5601 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5602 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5603 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5604 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5605 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5606 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5607 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5608 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5609 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5610 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5611 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5612 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5613 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5614 volatile octave_idx_type x_nz = b.nnz (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5615 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5616 retval = SparseComplexMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5617 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5618 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5619 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5620 OCTAVE_LOCAL_BUFFER (double, Bx, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5621 OCTAVE_LOCAL_BUFFER (double, Bz, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5622 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5623 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5624 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5625 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5626 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5627 Bx[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5628 Bz[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5629 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5630 for (octave_idx_type i = b.cidx(j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5631 i < b.cidx(j+1); i++) |
| 5164 | 5632 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5633 Complex c = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5634 Bx[b.ridx(i)] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5635 Bz[b.ridx(i)] = std::imag (c); |
| 5164 | 5636 } |
| 5637 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5638 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5639 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5640 nr, n_lower, n_upper, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5641 ldm, pipvt, Bx, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5642 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5643 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5644 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5645 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5646 nr, n_lower, n_upper, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5647 ldm, pipvt, Bz, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5648 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5649 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5650 // Count non-zeros in work vector and adjust |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5651 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5652 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5653 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5654 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5655 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5656 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5657 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5658 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5659 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5660 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5661 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5662 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5663 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5664 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5665 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5666 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5667 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5668 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5669 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5670 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5671 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5672 retval.xcidx(j+1) = ii; |
| 5164 | 5673 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5674 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5675 retval.maybe_compress (); |
| 5164 | 5676 } |
| 5677 } | |
| 5678 } | |
| 5785 | 5679 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5680 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5681 } | |
| 5682 | |
| 5683 return retval; | |
| 5684 } | |
| 5685 | |
| 5686 void * | |
| 5681 | 5687 SparseMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control, |
| 5688 Matrix &Info, solve_singularity_handler sing_handler, | |
| 5689 bool calc_cond) const | |
| 5164 | 5690 { |
| 5691 // The return values | |
| 5404 | 5692 void *Numeric = 0; |
| 5164 | 5693 err = 0; |
| 5694 | |
| 5203 | 5695 #ifdef HAVE_UMFPACK |
| 5164 | 5696 // Setup the control parameters |
| 5697 Control = Matrix (UMFPACK_CONTROL, 1); | |
| 5698 double *control = Control.fortran_vec (); | |
| 5322 | 5699 UMFPACK_DNAME (defaults) (control); |
| 5164 | 5700 |
| 5893 | 5701 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 5702 if (!xisnan (tmp)) |
| 5703 Control (UMFPACK_PRL) = tmp; | |
| 5893 | 5704 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 5705 if (!xisnan (tmp)) |
| 5706 { | |
| 5707 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 5708 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 5709 } | |
| 5710 | |
| 5711 // Set whether we are allowed to modify Q or not | |
| 5893 | 5712 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 5713 if (!xisnan (tmp)) |
| 5714 Control (UMFPACK_FIXQ) = tmp; | |
| 5715 | |
| 5322 | 5716 UMFPACK_DNAME (report_control) (control); |
| 5164 | 5717 |
| 5275 | 5718 const octave_idx_type *Ap = cidx (); |
| 5719 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5720 const double *Ax = data (); |
| 5275 | 5721 octave_idx_type nr = rows (); |
| 5722 octave_idx_type nc = cols (); | |
| 5164 | 5723 |
| 5322 | 5724 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control); |
| 5164 | 5725 |
| 5726 void *Symbolic; | |
| 5727 Info = Matrix (1, UMFPACK_INFO); | |
| 5728 double *info = Info.fortran_vec (); | |
| 7520 | 5729 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, Ax, 0, |
| 5164 | 5730 &Symbolic, control, info); |
| 5731 | |
| 5732 if (status < 0) | |
| 5733 { | |
| 5734 (*current_liboctave_error_handler) | |
| 5735 ("SparseMatrix::solve symbolic factorization failed"); | |
| 5736 err = -1; | |
| 5737 | |
| 5322 | 5738 UMFPACK_DNAME (report_status) (control, status); |
| 5739 UMFPACK_DNAME (report_info) (control, info); | |
| 5740 | |
| 5741 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 5742 } |
| 5743 else | |
| 5744 { | |
| 5322 | 5745 UMFPACK_DNAME (report_symbolic) (Symbolic, control); |
| 5746 | |
| 5747 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, | |
| 5748 &Numeric, control, info) ; | |
| 5749 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 5750 |
| 5681 | 5751 if (calc_cond) |
| 5752 rcond = Info (UMFPACK_RCOND); | |
| 5753 else | |
| 5754 rcond = 1.; | |
| 5164 | 5755 volatile double rcond_plus_one = rcond + 1.0; |
| 5756 | |
| 5757 if (status == UMFPACK_WARNING_singular_matrix || | |
| 5758 rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5759 { | |
| 5322 | 5760 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 5761 |
| 5762 err = -2; | |
| 5763 | |
| 5764 if (sing_handler) | |
| 5765 sing_handler (rcond); | |
| 5766 else | |
| 5767 (*current_liboctave_error_handler) | |
| 5768 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5769 rcond); | |
| 5770 | |
| 5771 } | |
| 5610 | 5772 else if (status < 0) |
| 5164 | 5773 { |
| 5774 (*current_liboctave_error_handler) | |
| 5775 ("SparseMatrix::solve numeric factorization failed"); | |
| 5776 | |
| 5322 | 5777 UMFPACK_DNAME (report_status) (control, status); |
| 5778 UMFPACK_DNAME (report_info) (control, info); | |
| 5164 | 5779 |
| 5780 err = -1; | |
| 5781 } | |
| 5782 else | |
| 5783 { | |
| 5322 | 5784 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 5785 } |
| 5786 } | |
| 5787 | |
| 5788 if (err != 0) | |
| 5322 | 5789 UMFPACK_DNAME (free_numeric) (&Numeric); |
| 5164 | 5790 |
| 5203 | 5791 #else |
| 5792 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 5793 #endif | |
| 5794 | |
| 5164 | 5795 return Numeric; |
| 5796 } | |
| 5797 | |
| 5798 Matrix | |
| 5785 | 5799 SparseMatrix::fsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 5800 octave_idx_type& err, double& rcond, |
| 5801 solve_singularity_handler sing_handler, | |
| 5802 bool calc_cond) const | |
| 5164 | 5803 { |
| 5804 Matrix retval; | |
| 5805 | |
| 5275 | 5806 octave_idx_type nr = rows (); |
| 5807 octave_idx_type nc = cols (); | |
| 5164 | 5808 err = 0; |
| 5809 | |
| 6924 | 5810 if (nr != nc || nr != b.rows ()) |
| 5164 | 5811 (*current_liboctave_error_handler) |
| 5812 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5813 else if (nr == 0 || b.cols () == 0) |
| 5814 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 5815 else |
| 5816 { | |
| 5817 // Print spparms("spumoni") info if requested | |
| 5506 | 5818 volatile int typ = mattype.type (); |
| 5164 | 5819 mattype.info (); |
| 5820 | |
| 5785 | 5821 if (typ == MatrixType::Hermitian) |
| 5164 | 5822 { |
| 5506 | 5823 #ifdef HAVE_CHOLMOD |
| 5824 cholmod_common Common; | |
| 5825 cholmod_common *cm = &Common; | |
| 5826 | |
| 5827 // Setup initial parameters | |
| 5828 CHOLMOD_NAME(start) (cm); | |
| 5526 | 5829 cm->prefer_zomplex = false; |
| 5506 | 5830 |
| 5893 | 5831 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 5832 if (spu == 0.) |
| 5833 { | |
| 5834 cm->print = -1; | |
| 7520 | 5835 cm->print_function = 0; |
| 5506 | 5836 } |
| 5837 else | |
| 5838 { | |
| 5760 | 5839 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 5840 cm->print_function =&SparseCholPrint; |
| 5841 } | |
| 5842 | |
| 5843 cm->error_handler = &SparseCholError; | |
| 5844 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 5845 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 5846 | |
| 5526 | 5847 cm->final_ll = true; |
| 5506 | 5848 |
| 5849 cholmod_sparse Astore; | |
| 5850 cholmod_sparse *A = &Astore; | |
| 5851 double dummy; | |
| 5852 A->nrow = nr; | |
| 5853 A->ncol = nc; | |
| 5854 | |
| 5855 A->p = cidx(); | |
| 5856 A->i = ridx(); | |
| 5604 | 5857 A->nzmax = nnz(); |
| 5526 | 5858 A->packed = true; |
| 5859 A->sorted = true; | |
| 7520 | 5860 A->nz = 0; |
| 5506 | 5861 #ifdef IDX_TYPE_LONG |
| 5862 A->itype = CHOLMOD_LONG; | |
| 5863 #else | |
| 5864 A->itype = CHOLMOD_INT; | |
| 5865 #endif | |
| 5866 A->dtype = CHOLMOD_DOUBLE; | |
| 5867 A->stype = 1; | |
| 5868 A->xtype = CHOLMOD_REAL; | |
| 5869 | |
| 5870 if (nr < 1) | |
| 5871 A->x = &dummy; | |
| 5872 else | |
| 5873 A->x = data(); | |
| 5874 | |
| 5875 cholmod_dense Bstore; | |
| 5876 cholmod_dense *B = &Bstore; | |
| 5877 B->nrow = b.rows(); | |
| 5878 B->ncol = b.cols(); | |
| 5879 B->d = B->nrow; | |
| 5880 B->nzmax = B->nrow * B->ncol; | |
| 5881 B->dtype = CHOLMOD_DOUBLE; | |
| 5882 B->xtype = CHOLMOD_REAL; | |
| 5883 if (nc < 1 || b.cols() < 1) | |
| 5884 B->x = &dummy; | |
| 5885 else | |
| 5886 // We won't alter it, honest :-) | |
| 5887 B->x = const_cast<double *>(b.fortran_vec()); | |
| 5888 | |
| 5889 cholmod_factor *L; | |
| 5890 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5891 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 5892 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 5893 if (calc_cond) |
| 5894 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 5895 else | |
| 5896 rcond = 1.0; | |
| 5897 | |
| 5506 | 5898 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5899 | |
| 5900 if (rcond == 0.0) | |
| 5901 { | |
| 5902 // Either its indefinite or singular. Try UMFPACK | |
| 5903 mattype.mark_as_unsymmetric (); | |
| 5785 | 5904 typ = MatrixType::Full; |
| 5506 | 5905 } |
| 5906 else | |
| 5907 { | |
| 5908 volatile double rcond_plus_one = rcond + 1.0; | |
| 5909 | |
| 5910 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5911 { | |
| 5912 err = -2; | |
| 5913 | |
| 5914 if (sing_handler) | |
| 5681 | 5915 { |
| 5916 sing_handler (rcond); | |
| 5917 mattype.mark_as_rectangular (); | |
| 5918 } | |
| 5506 | 5919 else |
| 5920 (*current_liboctave_error_handler) | |
| 5921 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5922 rcond); | |
| 5923 | |
| 5924 return retval; | |
| 5925 } | |
| 5926 | |
| 5927 cholmod_dense *X; | |
| 5928 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5929 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 5930 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5931 | |
| 5932 retval.resize (b.rows (), b.cols()); | |
| 5933 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 5934 { | |
| 5935 octave_idx_type jr = j * b.rows(); | |
| 5936 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 5937 retval.xelem(i,j) = static_cast<double *>(X->x)[jr + i]; | |
| 5938 } | |
| 5939 | |
| 5940 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5941 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 5942 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 5943 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 5944 static char tmp[] = " "; |
| 5945 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 5946 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5947 } | |
| 5948 #else | |
| 5164 | 5949 (*current_liboctave_warning_handler) |
| 5506 | 5950 ("CHOLMOD not installed"); |
| 5164 | 5951 |
| 5952 mattype.mark_as_unsymmetric (); | |
| 5785 | 5953 typ = MatrixType::Full; |
| 5506 | 5954 #endif |
| 5164 | 5955 } |
| 5956 | |
| 5785 | 5957 if (typ == MatrixType::Full) |
| 5164 | 5958 { |
| 5203 | 5959 #ifdef HAVE_UMFPACK |
| 5164 | 5960 Matrix Control, Info; |
| 5961 void *Numeric = | |
| 5681 | 5962 factorize (err, rcond, Control, Info, sing_handler, calc_cond); |
| 5164 | 5963 |
| 5964 if (err == 0) | |
| 5965 { | |
| 5966 const double *Bx = b.fortran_vec (); | |
| 5967 retval.resize (b.rows (), b.cols()); | |
| 5968 double *result = retval.fortran_vec (); | |
| 5275 | 5969 octave_idx_type b_nr = b.rows (); |
| 5970 octave_idx_type b_nc = b.cols (); | |
| 5164 | 5971 int status = 0; |
| 5972 double *control = Control.fortran_vec (); | |
| 5973 double *info = Info.fortran_vec (); | |
| 5275 | 5974 const octave_idx_type *Ap = cidx (); |
| 5975 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5976 const double *Ax = data (); |
| 5977 | |
| 5275 | 5978 for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) |
| 5164 | 5979 { |
| 5322 | 5980 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 5981 Ai, Ax, &result[iidx], &Bx[iidx], | |
| 5164 | 5982 Numeric, control, info); |
| 5983 if (status < 0) | |
| 5984 { | |
| 5985 (*current_liboctave_error_handler) | |
| 5986 ("SparseMatrix::solve solve failed"); | |
| 5987 | |
| 5322 | 5988 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 5989 |
| 5990 err = -1; | |
| 5991 | |
| 5992 break; | |
| 5993 } | |
| 5994 } | |
| 5995 | |
| 5322 | 5996 UMFPACK_DNAME (report_info) (control, info); |
| 5164 | 5997 |
| 5322 | 5998 UMFPACK_DNAME (free_numeric) (&Numeric); |
| 5164 | 5999 } |
| 5681 | 6000 else |
| 6001 mattype.mark_as_rectangular (); | |
| 6002 | |
| 5203 | 6003 #else |
| 6004 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6005 #endif | |
| 5164 | 6006 } |
| 5785 | 6007 else if (typ != MatrixType::Hermitian) |
| 5164 | 6008 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6009 } | |
| 6010 | |
| 6011 return retval; | |
| 6012 } | |
| 6013 | |
| 6014 SparseMatrix | |
| 5785 | 6015 SparseMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 6016 octave_idx_type& err, double& rcond, |
| 6017 solve_singularity_handler sing_handler, | |
| 6018 bool calc_cond) const | |
| 5164 | 6019 { |
| 6020 SparseMatrix retval; | |
| 6021 | |
| 5275 | 6022 octave_idx_type nr = rows (); |
| 6023 octave_idx_type nc = cols (); | |
| 5164 | 6024 err = 0; |
| 6025 | |
| 6924 | 6026 if (nr != nc || nr != b.rows ()) |
| 5164 | 6027 (*current_liboctave_error_handler) |
| 6028 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6029 else if (nr == 0 || b.cols () == 0) |
| 6030 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 6031 else |
| 6032 { | |
| 6033 // Print spparms("spumoni") info if requested | |
| 5506 | 6034 volatile int typ = mattype.type (); |
| 5164 | 6035 mattype.info (); |
| 6036 | |
| 5785 | 6037 if (typ == MatrixType::Hermitian) |
| 5164 | 6038 { |
| 5506 | 6039 #ifdef HAVE_CHOLMOD |
| 6040 cholmod_common Common; | |
| 6041 cholmod_common *cm = &Common; | |
| 6042 | |
| 6043 // Setup initial parameters | |
| 6044 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6045 cm->prefer_zomplex = false; |
| 5506 | 6046 |
| 5893 | 6047 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6048 if (spu == 0.) |
| 6049 { | |
| 6050 cm->print = -1; | |
| 7520 | 6051 cm->print_function = 0; |
| 5506 | 6052 } |
| 6053 else | |
| 6054 { | |
| 5760 | 6055 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6056 cm->print_function =&SparseCholPrint; |
| 6057 } | |
| 6058 | |
| 6059 cm->error_handler = &SparseCholError; | |
| 6060 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6061 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6062 | |
| 5526 | 6063 cm->final_ll = true; |
| 5506 | 6064 |
| 6065 cholmod_sparse Astore; | |
| 6066 cholmod_sparse *A = &Astore; | |
| 6067 double dummy; | |
| 6068 A->nrow = nr; | |
| 6069 A->ncol = nc; | |
| 6070 | |
| 6071 A->p = cidx(); | |
| 6072 A->i = ridx(); | |
| 5604 | 6073 A->nzmax = nnz(); |
| 5526 | 6074 A->packed = true; |
| 6075 A->sorted = true; | |
| 7520 | 6076 A->nz = 0; |
| 5506 | 6077 #ifdef IDX_TYPE_LONG |
| 6078 A->itype = CHOLMOD_LONG; | |
| 6079 #else | |
| 6080 A->itype = CHOLMOD_INT; | |
| 6081 #endif | |
| 6082 A->dtype = CHOLMOD_DOUBLE; | |
| 6083 A->stype = 1; | |
| 6084 A->xtype = CHOLMOD_REAL; | |
| 6085 | |
| 6086 if (nr < 1) | |
| 6087 A->x = &dummy; | |
| 6088 else | |
| 6089 A->x = data(); | |
| 6090 | |
| 6091 cholmod_sparse Bstore; | |
| 6092 cholmod_sparse *B = &Bstore; | |
| 6093 B->nrow = b.rows(); | |
| 6094 B->ncol = b.cols(); | |
| 6095 B->p = b.cidx(); | |
| 6096 B->i = b.ridx(); | |
| 5604 | 6097 B->nzmax = b.nnz(); |
| 5526 | 6098 B->packed = true; |
| 6099 B->sorted = true; | |
| 7520 | 6100 B->nz = 0; |
| 5506 | 6101 #ifdef IDX_TYPE_LONG |
| 6102 B->itype = CHOLMOD_LONG; | |
| 6103 #else | |
| 6104 B->itype = CHOLMOD_INT; | |
| 6105 #endif | |
| 6106 B->dtype = CHOLMOD_DOUBLE; | |
| 6107 B->stype = 0; | |
| 6108 B->xtype = CHOLMOD_REAL; | |
| 6109 | |
| 6110 if (b.rows() < 1 || b.cols() < 1) | |
| 6111 B->x = &dummy; | |
| 6112 else | |
| 6113 B->x = b.data(); | |
| 6114 | |
| 6115 cholmod_factor *L; | |
| 6116 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6117 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6118 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6119 if (calc_cond) |
| 6120 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6121 else | |
| 6122 rcond = 1.; | |
| 5506 | 6123 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6124 | |
| 6125 if (rcond == 0.0) | |
| 6126 { | |
| 6127 // Either its indefinite or singular. Try UMFPACK | |
| 6128 mattype.mark_as_unsymmetric (); | |
| 5785 | 6129 typ = MatrixType::Full; |
| 5506 | 6130 } |
| 6131 else | |
| 6132 { | |
| 6133 volatile double rcond_plus_one = rcond + 1.0; | |
| 6134 | |
| 6135 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6136 { | |
| 6137 err = -2; | |
| 6138 | |
| 6139 if (sing_handler) | |
| 5681 | 6140 { |
| 6141 sing_handler (rcond); | |
| 6142 mattype.mark_as_rectangular (); | |
| 6143 } | |
| 5506 | 6144 else |
| 6145 (*current_liboctave_error_handler) | |
| 6146 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6147 rcond); | |
| 6148 | |
| 6149 return retval; | |
| 6150 } | |
| 6151 | |
| 6152 cholmod_sparse *X; | |
| 6153 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6154 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 6155 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6156 | |
| 6157 retval = SparseMatrix (static_cast<octave_idx_type>(X->nrow), | |
| 6158 static_cast<octave_idx_type>(X->ncol), | |
| 6159 static_cast<octave_idx_type>(X->nzmax)); | |
| 6160 for (octave_idx_type j = 0; | |
| 6161 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 6162 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 6163 for (octave_idx_type j = 0; | |
| 6164 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 6165 { | |
| 6166 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 6167 retval.xdata(j) = static_cast<double *>(X->x)[j]; | |
| 6168 } | |
| 6169 | |
| 6170 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6171 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 6172 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6173 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6174 static char tmp[] = " "; |
| 6175 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6176 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6177 } | |
| 6178 #else | |
| 5164 | 6179 (*current_liboctave_warning_handler) |
| 5506 | 6180 ("CHOLMOD not installed"); |
| 5164 | 6181 |
| 6182 mattype.mark_as_unsymmetric (); | |
| 5785 | 6183 typ = MatrixType::Full; |
| 5506 | 6184 #endif |
| 5164 | 6185 } |
| 6186 | |
| 5785 | 6187 if (typ == MatrixType::Full) |
| 5164 | 6188 { |
| 5203 | 6189 #ifdef HAVE_UMFPACK |
| 5164 | 6190 Matrix Control, Info; |
| 6191 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6192 sing_handler, calc_cond); |
| 5164 | 6193 |
| 6194 if (err == 0) | |
| 6195 { | |
| 5275 | 6196 octave_idx_type b_nr = b.rows (); |
| 6197 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6198 int status = 0; |
| 6199 double *control = Control.fortran_vec (); | |
| 6200 double *info = Info.fortran_vec (); | |
| 5275 | 6201 const octave_idx_type *Ap = cidx (); |
| 6202 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6203 const double *Ax = data (); |
| 6204 | |
| 6205 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6206 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6207 | |
| 6208 // Take a first guess that the number of non-zero terms | |
| 6209 // will be as many as in b | |
| 5681 | 6210 octave_idx_type x_nz = b.nnz (); |
| 5275 | 6211 octave_idx_type ii = 0; |
| 5164 | 6212 retval = SparseMatrix (b_nr, b_nc, x_nz); |
| 6213 | |
| 6214 retval.xcidx(0) = 0; | |
| 5275 | 6215 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6216 { |
| 6217 | |
| 5275 | 6218 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6219 Bx[i] = b.elem (i, j); |
| 6220 | |
| 5322 | 6221 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6222 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6223 info); |
| 6224 if (status < 0) | |
| 6225 { | |
| 6226 (*current_liboctave_error_handler) | |
| 6227 ("SparseMatrix::solve solve failed"); | |
| 6228 | |
| 5322 | 6229 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6230 |
| 6231 err = -1; | |
| 6232 | |
| 6233 break; | |
| 6234 } | |
| 6235 | |
| 5275 | 6236 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6237 { |
| 6238 double tmp = Xx[i]; | |
| 6239 if (tmp != 0.0) | |
| 6240 { | |
| 6241 if (ii == x_nz) | |
| 6242 { | |
| 6243 // Resize the sparse matrix | |
| 5275 | 6244 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6245 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6246 retval.change_capacity (sz); | |
| 6247 x_nz = sz; | |
| 6248 } | |
| 6249 retval.xdata(ii) = tmp; | |
| 6250 retval.xridx(ii++) = i; | |
| 6251 } | |
| 6252 } | |
| 6253 retval.xcidx(j+1) = ii; | |
| 6254 } | |
| 6255 | |
| 6256 retval.maybe_compress (); | |
| 6257 | |
| 5322 | 6258 UMFPACK_DNAME (report_info) (control, info); |
| 6259 | |
| 6260 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6261 } |
| 5681 | 6262 else |
| 6263 mattype.mark_as_rectangular (); | |
| 6264 | |
| 5203 | 6265 #else |
| 6266 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6267 #endif | |
| 5164 | 6268 } |
| 5785 | 6269 else if (typ != MatrixType::Hermitian) |
| 5164 | 6270 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6271 } | |
| 6272 | |
| 6273 return retval; | |
| 6274 } | |
| 6275 | |
| 6276 ComplexMatrix | |
| 5785 | 6277 SparseMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 6278 octave_idx_type& err, double& rcond, |
| 6279 solve_singularity_handler sing_handler, | |
| 6280 bool calc_cond) const | |
| 5164 | 6281 { |
| 6282 ComplexMatrix retval; | |
| 6283 | |
| 5275 | 6284 octave_idx_type nr = rows (); |
| 6285 octave_idx_type nc = cols (); | |
| 5164 | 6286 err = 0; |
| 6287 | |
| 6924 | 6288 if (nr != nc || nr != b.rows ()) |
| 5164 | 6289 (*current_liboctave_error_handler) |
| 6290 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6291 else if (nr == 0 || b.cols () == 0) |
| 6292 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 6293 else |
| 6294 { | |
| 6295 // Print spparms("spumoni") info if requested | |
| 5506 | 6296 volatile int typ = mattype.type (); |
| 5164 | 6297 mattype.info (); |
| 6298 | |
| 5785 | 6299 if (typ == MatrixType::Hermitian) |
| 5164 | 6300 { |
| 5506 | 6301 #ifdef HAVE_CHOLMOD |
| 6302 cholmod_common Common; | |
| 6303 cholmod_common *cm = &Common; | |
| 6304 | |
| 6305 // Setup initial parameters | |
| 6306 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6307 cm->prefer_zomplex = false; |
| 5506 | 6308 |
| 5893 | 6309 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6310 if (spu == 0.) |
| 6311 { | |
| 6312 cm->print = -1; | |
| 7520 | 6313 cm->print_function = 0; |
| 5506 | 6314 } |
| 6315 else | |
| 6316 { | |
| 5760 | 6317 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6318 cm->print_function =&SparseCholPrint; |
| 6319 } | |
| 6320 | |
| 6321 cm->error_handler = &SparseCholError; | |
| 6322 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6323 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6324 | |
| 5526 | 6325 cm->final_ll = true; |
| 5506 | 6326 |
| 6327 cholmod_sparse Astore; | |
| 6328 cholmod_sparse *A = &Astore; | |
| 6329 double dummy; | |
| 6330 A->nrow = nr; | |
| 6331 A->ncol = nc; | |
| 6332 | |
| 6333 A->p = cidx(); | |
| 6334 A->i = ridx(); | |
| 5604 | 6335 A->nzmax = nnz(); |
| 5526 | 6336 A->packed = true; |
| 6337 A->sorted = true; | |
| 7520 | 6338 A->nz = 0; |
| 5506 | 6339 #ifdef IDX_TYPE_LONG |
| 6340 A->itype = CHOLMOD_LONG; | |
| 6341 #else | |
| 6342 A->itype = CHOLMOD_INT; | |
| 6343 #endif | |
| 6344 A->dtype = CHOLMOD_DOUBLE; | |
| 6345 A->stype = 1; | |
| 6346 A->xtype = CHOLMOD_REAL; | |
| 6347 | |
| 6348 if (nr < 1) | |
| 6349 A->x = &dummy; | |
| 6350 else | |
| 6351 A->x = data(); | |
| 6352 | |
| 6353 cholmod_dense Bstore; | |
| 6354 cholmod_dense *B = &Bstore; | |
| 6355 B->nrow = b.rows(); | |
| 6356 B->ncol = b.cols(); | |
| 6357 B->d = B->nrow; | |
| 6358 B->nzmax = B->nrow * B->ncol; | |
| 6359 B->dtype = CHOLMOD_DOUBLE; | |
| 6360 B->xtype = CHOLMOD_COMPLEX; | |
| 6361 if (nc < 1 || b.cols() < 1) | |
| 6362 B->x = &dummy; | |
| 6363 else | |
| 6364 // We won't alter it, honest :-) | |
| 6365 B->x = const_cast<Complex *>(b.fortran_vec()); | |
| 6366 | |
| 6367 cholmod_factor *L; | |
| 6368 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6369 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6370 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6371 if (calc_cond) |
| 6372 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6373 else | |
| 6374 rcond = 1.0; | |
| 5506 | 6375 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6376 | |
| 6377 if (rcond == 0.0) | |
| 6378 { | |
| 6379 // Either its indefinite or singular. Try UMFPACK | |
| 6380 mattype.mark_as_unsymmetric (); | |
| 5785 | 6381 typ = MatrixType::Full; |
| 5506 | 6382 } |
| 6383 else | |
| 6384 { | |
| 6385 volatile double rcond_plus_one = rcond + 1.0; | |
| 6386 | |
| 6387 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6388 { | |
| 6389 err = -2; | |
| 6390 | |
| 6391 if (sing_handler) | |
| 5681 | 6392 { |
| 6393 sing_handler (rcond); | |
| 6394 mattype.mark_as_rectangular (); | |
| 6395 } | |
| 5506 | 6396 else |
| 6397 (*current_liboctave_error_handler) | |
| 6398 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6399 rcond); | |
| 6400 | |
| 6401 return retval; | |
| 6402 } | |
| 6403 | |
| 6404 cholmod_dense *X; | |
| 6405 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6406 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 6407 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6408 | |
| 6409 retval.resize (b.rows (), b.cols()); | |
| 6410 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 6411 { | |
| 6412 octave_idx_type jr = j * b.rows(); | |
| 6413 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 6414 retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; | |
| 6415 } | |
| 6416 | |
| 6417 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6418 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 6419 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6420 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6421 static char tmp[] = " "; |
| 6422 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6423 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6424 } | |
| 6425 #else | |
| 5164 | 6426 (*current_liboctave_warning_handler) |
| 5506 | 6427 ("CHOLMOD not installed"); |
| 5164 | 6428 |
| 6429 mattype.mark_as_unsymmetric (); | |
| 5785 | 6430 typ = MatrixType::Full; |
| 5506 | 6431 #endif |
| 5164 | 6432 } |
| 6433 | |
| 5785 | 6434 if (typ == MatrixType::Full) |
| 5164 | 6435 { |
| 5203 | 6436 #ifdef HAVE_UMFPACK |
| 5164 | 6437 Matrix Control, Info; |
| 6438 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6439 sing_handler, calc_cond); |
| 5164 | 6440 |
| 6441 if (err == 0) | |
| 6442 { | |
| 5275 | 6443 octave_idx_type b_nr = b.rows (); |
| 6444 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6445 int status = 0; |
| 6446 double *control = Control.fortran_vec (); | |
| 6447 double *info = Info.fortran_vec (); | |
| 5275 | 6448 const octave_idx_type *Ap = cidx (); |
| 6449 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6450 const double *Ax = data (); |
| 6451 | |
| 6452 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6453 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 6454 | |
| 6455 retval.resize (b_nr, b_nc); | |
| 6456 | |
| 6457 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6458 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); | |
| 6459 | |
| 5275 | 6460 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6461 { |
| 5275 | 6462 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6463 { |
| 6464 Complex c = b (i,j); | |
| 5261 | 6465 Bx[i] = std::real (c); |
| 6466 Bz[i] = std::imag (c); | |
| 5164 | 6467 } |
| 6468 | |
| 5322 | 6469 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6470 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6471 info); |
| 5322 | 6472 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, |
| 6473 Ap, Ai, Ax, Xz, Bz, Numeric, | |
| 5164 | 6474 control, info) ; |
| 6475 | |
| 6476 if (status < 0 || status2 < 0) | |
| 6477 { | |
| 6478 (*current_liboctave_error_handler) | |
| 6479 ("SparseMatrix::solve solve failed"); | |
| 6480 | |
| 5322 | 6481 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6482 |
| 6483 err = -1; | |
| 6484 | |
| 6485 break; | |
| 6486 } | |
| 6487 | |
| 5275 | 6488 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6489 retval (i, j) = Complex (Xx[i], Xz[i]); |
| 6490 } | |
| 6491 | |
| 5322 | 6492 UMFPACK_DNAME (report_info) (control, info); |
| 6493 | |
| 6494 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6495 } |
| 5681 | 6496 else |
| 6497 mattype.mark_as_rectangular (); | |
| 6498 | |
| 5203 | 6499 #else |
| 6500 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6501 #endif | |
| 5164 | 6502 } |
| 5785 | 6503 else if (typ != MatrixType::Hermitian) |
| 5164 | 6504 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6505 } | |
| 6506 | |
| 6507 return retval; | |
| 6508 } | |
| 6509 | |
| 6510 SparseComplexMatrix | |
| 5785 | 6511 SparseMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6512 octave_idx_type& err, double& rcond, |
| 5681 | 6513 solve_singularity_handler sing_handler, |
| 6514 bool calc_cond) const | |
| 5164 | 6515 { |
| 6516 SparseComplexMatrix retval; | |
| 6517 | |
| 5275 | 6518 octave_idx_type nr = rows (); |
| 6519 octave_idx_type nc = cols (); | |
| 5164 | 6520 err = 0; |
| 6521 | |
| 6924 | 6522 if (nr != nc || nr != b.rows ()) |
| 5164 | 6523 (*current_liboctave_error_handler) |
| 6524 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6525 else if (nr == 0 || b.cols () == 0) |
| 6526 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 6527 else |
| 6528 { | |
| 6529 // Print spparms("spumoni") info if requested | |
| 5506 | 6530 volatile int typ = mattype.type (); |
| 5164 | 6531 mattype.info (); |
| 6532 | |
| 5785 | 6533 if (typ == MatrixType::Hermitian) |
| 5164 | 6534 { |
| 5506 | 6535 #ifdef HAVE_CHOLMOD |
| 6536 cholmod_common Common; | |
| 6537 cholmod_common *cm = &Common; | |
| 6538 | |
| 6539 // Setup initial parameters | |
| 6540 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6541 cm->prefer_zomplex = false; |
| 5506 | 6542 |
| 5893 | 6543 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6544 if (spu == 0.) |
| 6545 { | |
| 6546 cm->print = -1; | |
| 7520 | 6547 cm->print_function = 0; |
| 5506 | 6548 } |
| 6549 else | |
| 6550 { | |
| 5760 | 6551 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6552 cm->print_function =&SparseCholPrint; |
| 6553 } | |
| 6554 | |
| 6555 cm->error_handler = &SparseCholError; | |
| 6556 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6557 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6558 | |
| 5526 | 6559 cm->final_ll = true; |
| 5506 | 6560 |
| 6561 cholmod_sparse Astore; | |
| 6562 cholmod_sparse *A = &Astore; | |
| 6563 double dummy; | |
| 6564 A->nrow = nr; | |
| 6565 A->ncol = nc; | |
| 6566 | |
| 6567 A->p = cidx(); | |
| 6568 A->i = ridx(); | |
| 5604 | 6569 A->nzmax = nnz(); |
| 5526 | 6570 A->packed = true; |
| 6571 A->sorted = true; | |
| 7520 | 6572 A->nz = 0; |
| 5506 | 6573 #ifdef IDX_TYPE_LONG |
| 6574 A->itype = CHOLMOD_LONG; | |
| 6575 #else | |
| 6576 A->itype = CHOLMOD_INT; | |
| 6577 #endif | |
| 6578 A->dtype = CHOLMOD_DOUBLE; | |
| 6579 A->stype = 1; | |
| 6580 A->xtype = CHOLMOD_REAL; | |
| 6581 | |
| 6582 if (nr < 1) | |
| 6583 A->x = &dummy; | |
| 6584 else | |
| 6585 A->x = data(); | |
| 6586 | |
| 6587 cholmod_sparse Bstore; | |
| 6588 cholmod_sparse *B = &Bstore; | |
| 6589 B->nrow = b.rows(); | |
| 6590 B->ncol = b.cols(); | |
| 6591 B->p = b.cidx(); | |
| 6592 B->i = b.ridx(); | |
| 5604 | 6593 B->nzmax = b.nnz(); |
| 5526 | 6594 B->packed = true; |
| 6595 B->sorted = true; | |
| 7520 | 6596 B->nz = 0; |
| 5506 | 6597 #ifdef IDX_TYPE_LONG |
| 6598 B->itype = CHOLMOD_LONG; | |
| 6599 #else | |
| 6600 B->itype = CHOLMOD_INT; | |
| 6601 #endif | |
| 6602 B->dtype = CHOLMOD_DOUBLE; | |
| 6603 B->stype = 0; | |
| 6604 B->xtype = CHOLMOD_COMPLEX; | |
| 6605 | |
| 6606 if (b.rows() < 1 || b.cols() < 1) | |
| 6607 B->x = &dummy; | |
| 6608 else | |
| 6609 B->x = b.data(); | |
| 6610 | |
| 6611 cholmod_factor *L; | |
| 6612 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6613 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6614 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6615 if (calc_cond) |
| 6616 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6617 else | |
| 6618 rcond = 1.0; | |
| 5506 | 6619 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6620 | |
| 6621 if (rcond == 0.0) | |
| 6622 { | |
| 6623 // Either its indefinite or singular. Try UMFPACK | |
| 6624 mattype.mark_as_unsymmetric (); | |
| 5785 | 6625 typ = MatrixType::Full; |
| 5506 | 6626 } |
| 6627 else | |
| 6628 { | |
| 6629 volatile double rcond_plus_one = rcond + 1.0; | |
| 6630 | |
| 6631 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6632 { | |
| 6633 err = -2; | |
| 6634 | |
| 6635 if (sing_handler) | |
| 5681 | 6636 { |
| 6637 sing_handler (rcond); | |
| 6638 mattype.mark_as_rectangular (); | |
| 6639 } | |
| 5506 | 6640 else |
| 6641 (*current_liboctave_error_handler) | |
| 6642 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6643 rcond); | |
| 6644 | |
| 6645 return retval; | |
| 6646 } | |
| 6647 | |
| 6648 cholmod_sparse *X; | |
| 6649 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6650 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 6651 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6652 | |
| 6653 retval = SparseComplexMatrix | |
| 6654 (static_cast<octave_idx_type>(X->nrow), | |
| 6655 static_cast<octave_idx_type>(X->ncol), | |
| 6656 static_cast<octave_idx_type>(X->nzmax)); | |
| 6657 for (octave_idx_type j = 0; | |
| 6658 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 6659 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 6660 for (octave_idx_type j = 0; | |
| 6661 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 6662 { | |
| 6663 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 6664 retval.xdata(j) = static_cast<Complex *>(X->x)[j]; | |
| 6665 } | |
| 6666 | |
| 6667 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6668 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 6669 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6670 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6671 static char tmp[] = " "; |
| 6672 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6673 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6674 } | |
| 6675 #else | |
| 5164 | 6676 (*current_liboctave_warning_handler) |
| 5506 | 6677 ("CHOLMOD not installed"); |
| 5164 | 6678 |
| 6679 mattype.mark_as_unsymmetric (); | |
| 5785 | 6680 typ = MatrixType::Full; |
| 5506 | 6681 #endif |
| 5164 | 6682 } |
| 6683 | |
| 5785 | 6684 if (typ == MatrixType::Full) |
| 5164 | 6685 { |
| 5203 | 6686 #ifdef HAVE_UMFPACK |
| 5164 | 6687 Matrix Control, Info; |
| 6688 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6689 sing_handler, calc_cond); |
| 5164 | 6690 |
| 6691 if (err == 0) | |
| 6692 { | |
| 5275 | 6693 octave_idx_type b_nr = b.rows (); |
| 6694 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6695 int status = 0; |
| 6696 double *control = Control.fortran_vec (); | |
| 6697 double *info = Info.fortran_vec (); | |
| 5275 | 6698 const octave_idx_type *Ap = cidx (); |
| 6699 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6700 const double *Ax = data (); |
| 6701 | |
| 6702 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6703 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 6704 | |
| 6705 // Take a first guess that the number of non-zero terms | |
| 6706 // will be as many as in b | |
| 5681 | 6707 octave_idx_type x_nz = b.nnz (); |
| 5275 | 6708 octave_idx_type ii = 0; |
| 5164 | 6709 retval = SparseComplexMatrix (b_nr, b_nc, x_nz); |
| 6710 | |
| 6711 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6712 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); | |
| 6713 | |
| 6714 retval.xcidx(0) = 0; | |
| 5275 | 6715 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6716 { |
| 5275 | 6717 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6718 { |
| 6719 Complex c = b (i,j); | |
| 5261 | 6720 Bx[i] = std::real (c); |
| 6721 Bz[i] = std::imag (c); | |
| 5164 | 6722 } |
| 6723 | |
| 5322 | 6724 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6725 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6726 info); |
| 5322 | 6727 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, |
| 6728 Ap, Ai, Ax, Xz, Bz, Numeric, | |
| 5164 | 6729 control, info) ; |
| 6730 | |
| 6731 if (status < 0 || status2 < 0) | |
| 6732 { | |
| 6733 (*current_liboctave_error_handler) | |
| 6734 ("SparseMatrix::solve solve failed"); | |
| 6735 | |
| 5322 | 6736 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6737 |
| 6738 err = -1; | |
| 6739 | |
| 6740 break; | |
| 6741 } | |
| 6742 | |
| 5275 | 6743 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6744 { |
| 6745 Complex tmp = Complex (Xx[i], Xz[i]); | |
| 6746 if (tmp != 0.0) | |
| 6747 { | |
| 6748 if (ii == x_nz) | |
| 6749 { | |
| 6750 // Resize the sparse matrix | |
| 5275 | 6751 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6752 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6753 retval.change_capacity (sz); | |
| 6754 x_nz = sz; | |
| 6755 } | |
| 6756 retval.xdata(ii) = tmp; | |
| 6757 retval.xridx(ii++) = i; | |
| 6758 } | |
| 6759 } | |
| 6760 retval.xcidx(j+1) = ii; | |
| 6761 } | |
| 6762 | |
| 6763 retval.maybe_compress (); | |
| 6764 | |
| 5322 | 6765 UMFPACK_DNAME (report_info) (control, info); |
| 6766 | |
| 6767 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6768 } |
| 5681 | 6769 else |
| 6770 mattype.mark_as_rectangular (); | |
| 5203 | 6771 #else |
| 6772 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6773 #endif | |
| 5164 | 6774 } |
| 5785 | 6775 else if (typ != MatrixType::Hermitian) |
| 5164 | 6776 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6777 } | |
| 6778 | |
| 6779 return retval; | |
| 6780 } | |
| 6781 | |
| 6782 Matrix | |
| 5785 | 6783 SparseMatrix::solve (MatrixType &mattype, const Matrix& b) const |
| 5164 | 6784 { |
| 5275 | 6785 octave_idx_type info; |
| 5164 | 6786 double rcond; |
| 6787 return solve (mattype, b, info, rcond, 0); | |
| 6788 } | |
| 6789 | |
| 6790 Matrix | |
| 5785 | 6791 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, |
| 5697 | 6792 octave_idx_type& info) const |
| 5164 | 6793 { |
| 6794 double rcond; | |
| 6795 return solve (mattype, b, info, rcond, 0); | |
| 6796 } | |
| 6797 | |
| 6798 Matrix | |
| 5785 | 6799 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, |
| 5164 | 6800 double& rcond) const |
| 6801 { | |
| 6802 return solve (mattype, b, info, rcond, 0); | |
| 6803 } | |
| 6804 | |
| 6805 Matrix | |
| 5785 | 6806 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, |
| 5697 | 6807 double& rcond, solve_singularity_handler sing_handler, |
| 6808 bool singular_fallback) const | |
| 5164 | 6809 { |
| 5681 | 6810 Matrix retval; |
| 5322 | 6811 int typ = mattype.type (false); |
| 5164 | 6812 |
| 5785 | 6813 if (typ == MatrixType::Unknown) |
| 5164 | 6814 typ = mattype.type (*this); |
| 6815 | |
| 5681 | 6816 // Only calculate the condition number for CHOLMOD/UMFPACK |
| 5785 | 6817 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6818 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6819 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6820 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6821 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6822 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6823 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6824 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6825 else if (typ == MatrixType::Tridiagonal || |
| 6826 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6827 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6828 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6829 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6830 else if (typ != MatrixType::Rectangular) |
| 5164 | 6831 { |
| 5681 | 6832 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6833 return Matrix (); |
| 6834 } | |
| 5681 | 6835 |
| 6836 // Rectangular or one of the above solvers flags a singular matrix | |
| 5785 | 6837 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) |
| 5681 | 6838 { |
| 6839 rcond = 1.; | |
| 6840 #ifdef USE_QRSOLVE | |
| 6841 retval = qrsolve (*this, b, err); | |
| 6842 #else | |
| 6843 retval = dmsolve<Matrix, SparseMatrix, Matrix> (*this, b, err); | |
| 6844 #endif | |
| 6845 } | |
| 6846 | |
| 6847 return retval; | |
| 5164 | 6848 } |
| 6849 | |
| 6850 SparseMatrix | |
| 5785 | 6851 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b) const |
| 5164 | 6852 { |
| 5275 | 6853 octave_idx_type info; |
| 5164 | 6854 double rcond; |
| 6855 return solve (mattype, b, info, rcond, 0); | |
| 6856 } | |
| 6857 | |
| 6858 SparseMatrix | |
| 5785 | 6859 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6860 octave_idx_type& info) const |
| 5164 | 6861 { |
| 6862 double rcond; | |
| 6863 return solve (mattype, b, info, rcond, 0); | |
| 6864 } | |
| 6865 | |
| 6866 SparseMatrix | |
| 5785 | 6867 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6868 octave_idx_type& info, double& rcond) const |
| 5164 | 6869 { |
| 6870 return solve (mattype, b, info, rcond, 0); | |
| 6871 } | |
| 6872 | |
| 6873 SparseMatrix | |
| 5785 | 6874 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6875 octave_idx_type& err, double& rcond, |
| 5697 | 6876 solve_singularity_handler sing_handler, |
| 6877 bool singular_fallback) const | |
| 5164 | 6878 { |
| 5681 | 6879 SparseMatrix retval; |
| 5322 | 6880 int typ = mattype.type (false); |
| 5164 | 6881 |
| 5785 | 6882 if (typ == MatrixType::Unknown) |
| 5164 | 6883 typ = mattype.type (*this); |
| 6884 | |
| 5785 | 6885 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6886 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6887 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6888 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6889 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6890 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6891 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6892 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6893 else if (typ == MatrixType::Tridiagonal || |
| 6894 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6895 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6896 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6897 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6898 else if (typ != MatrixType::Rectangular) |
| 5164 | 6899 { |
| 5681 | 6900 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6901 return SparseMatrix (); |
| 6902 } | |
| 5681 | 6903 |
| 5785 | 6904 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) |
| 5681 | 6905 { |
| 6906 rcond = 1.; | |
| 6907 #ifdef USE_QRSOLVE | |
| 6908 retval = qrsolve (*this, b, err); | |
| 6909 #else | |
| 6910 retval = dmsolve<SparseMatrix, SparseMatrix, | |
| 6911 SparseMatrix> (*this, b, err); | |
| 6912 #endif | |
| 6913 } | |
| 6914 | |
| 6915 return retval; | |
| 5164 | 6916 } |
| 6917 | |
| 6918 ComplexMatrix | |
| 5785 | 6919 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b) const |
| 5164 | 6920 { |
| 5275 | 6921 octave_idx_type info; |
| 5164 | 6922 double rcond; |
| 6923 return solve (mattype, b, info, rcond, 0); | |
| 6924 } | |
| 6925 | |
| 6926 ComplexMatrix | |
| 5785 | 6927 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6928 octave_idx_type& info) const |
| 5164 | 6929 { |
| 6930 double rcond; | |
| 6931 return solve (mattype, b, info, rcond, 0); | |
| 6932 } | |
| 6933 | |
| 6934 ComplexMatrix | |
| 5785 | 6935 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6936 octave_idx_type& info, double& rcond) const |
| 5164 | 6937 { |
| 6938 return solve (mattype, b, info, rcond, 0); | |
| 6939 } | |
| 6940 | |
| 6941 ComplexMatrix | |
| 5785 | 6942 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6943 octave_idx_type& err, double& rcond, |
| 5697 | 6944 solve_singularity_handler sing_handler, |
| 6945 bool singular_fallback) const | |
| 5164 | 6946 { |
| 5681 | 6947 ComplexMatrix retval; |
| 5322 | 6948 int typ = mattype.type (false); |
| 5164 | 6949 |
| 5785 | 6950 if (typ == MatrixType::Unknown) |
| 5164 | 6951 typ = mattype.type (*this); |
| 6952 | |
| 5785 | 6953 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6954 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6955 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6956 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6957 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6958 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6959 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6960 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6961 else if (typ == MatrixType::Tridiagonal || |
| 6962 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6963 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6964 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6965 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6966 else if (typ != MatrixType::Rectangular) |
| 5164 | 6967 { |
| 5681 | 6968 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6969 return ComplexMatrix (); |
| 6970 } | |
| 5681 | 6971 |
| 5785 | 6972 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6973 { |
| 6974 rcond = 1.; | |
| 6975 #ifdef USE_QRSOLVE | |
| 6976 retval = qrsolve (*this, b, err); | |
| 6977 #else | |
| 6978 retval = dmsolve<ComplexMatrix, SparseMatrix, | |
| 6979 ComplexMatrix> (*this, b, err); | |
| 6980 #endif | |
| 6981 } | |
| 6982 | |
| 6983 return retval; | |
| 5164 | 6984 } |
| 6985 | |
| 6986 SparseComplexMatrix | |
| 5785 | 6987 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b) const |
| 5164 | 6988 { |
| 5275 | 6989 octave_idx_type info; |
| 5164 | 6990 double rcond; |
| 6991 return solve (mattype, b, info, rcond, 0); | |
| 6992 } | |
| 6993 | |
| 6994 SparseComplexMatrix | |
| 5785 | 6995 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6996 octave_idx_type& info) const |
| 5164 | 6997 { |
| 6998 double rcond; | |
| 6999 return solve (mattype, b, info, rcond, 0); | |
| 7000 } | |
| 7001 | |
| 7002 SparseComplexMatrix | |
| 5785 | 7003 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 7004 octave_idx_type& info, double& rcond) const |
| 5164 | 7005 { |
| 7006 return solve (mattype, b, info, rcond, 0); | |
| 7007 } | |
| 7008 | |
| 7009 SparseComplexMatrix | |
| 5785 | 7010 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 7011 octave_idx_type& err, double& rcond, |
| 5697 | 7012 solve_singularity_handler sing_handler, |
| 7013 bool singular_fallback) const | |
| 5164 | 7014 { |
| 5681 | 7015 SparseComplexMatrix retval; |
| 5322 | 7016 int typ = mattype.type (false); |
| 5164 | 7017 |
| 5785 | 7018 if (typ == MatrixType::Unknown) |
| 5164 | 7019 typ = mattype.type (*this); |
| 7020 | |
| 5785 | 7021 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 7022 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7023 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 7024 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7025 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 7026 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7027 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 7028 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7029 else if (typ == MatrixType::Tridiagonal || |
| 7030 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 7031 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7032 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 7033 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 7034 else if (typ != MatrixType::Rectangular) |
| 5164 | 7035 { |
| 5681 | 7036 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 7037 return SparseComplexMatrix (); |
| 7038 } | |
| 5681 | 7039 |
| 5785 | 7040 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 7041 { |
| 7042 rcond = 1.; | |
| 7043 #ifdef USE_QRSOLVE | |
| 7044 retval = qrsolve (*this, b, err); | |
| 7045 #else | |
| 7046 retval = dmsolve<SparseComplexMatrix, SparseMatrix, | |
| 7047 SparseComplexMatrix> (*this, b, err); | |
| 7048 #endif | |
| 7049 } | |
| 7050 | |
| 7051 return retval; | |
| 5164 | 7052 } |
| 7053 | |
| 7054 ColumnVector | |
| 5785 | 7055 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b) const |
| 5164 | 7056 { |
| 5275 | 7057 octave_idx_type info; double rcond; |
| 5164 | 7058 return solve (mattype, b, info, rcond); |
| 7059 } | |
| 7060 | |
| 7061 ColumnVector | |
| 5785 | 7062 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info) const |
| 5164 | 7063 { |
| 7064 double rcond; | |
| 7065 return solve (mattype, b, info, rcond); | |
| 7066 } | |
| 7067 | |
| 7068 ColumnVector | |
| 5785 | 7069 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond) const |
| 5164 | 7070 { |
| 7071 return solve (mattype, b, info, rcond, 0); | |
| 7072 } | |
| 7073 | |
| 7074 ColumnVector | |
| 5785 | 7075 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7076 solve_singularity_handler sing_handler) const |
| 7077 { | |
| 7078 Matrix tmp (b); | |
| 5275 | 7079 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7080 } |
| 7081 | |
| 7082 ComplexColumnVector | |
| 5785 | 7083 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b) const |
| 5164 | 7084 { |
| 5275 | 7085 octave_idx_type info; |
| 5164 | 7086 double rcond; |
| 7087 return solve (mattype, b, info, rcond, 0); | |
| 7088 } | |
| 7089 | |
| 7090 ComplexColumnVector | |
| 5785 | 7091 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info) const |
| 5164 | 7092 { |
| 7093 double rcond; | |
| 7094 return solve (mattype, b, info, rcond, 0); | |
| 7095 } | |
| 7096 | |
| 7097 ComplexColumnVector | |
| 5785 | 7098 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7099 double& rcond) const |
| 7100 { | |
| 7101 return solve (mattype, b, info, rcond, 0); | |
| 7102 } | |
| 7103 | |
| 7104 ComplexColumnVector | |
| 5785 | 7105 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7106 solve_singularity_handler sing_handler) const |
| 7107 { | |
| 7108 ComplexMatrix tmp (b); | |
| 5275 | 7109 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7110 } |
| 7111 | |
| 7112 Matrix | |
| 7113 SparseMatrix::solve (const Matrix& b) const | |
| 7114 { | |
| 5275 | 7115 octave_idx_type info; |
| 5164 | 7116 double rcond; |
| 7117 return solve (b, info, rcond, 0); | |
| 7118 } | |
| 7119 | |
| 7120 Matrix | |
| 5275 | 7121 SparseMatrix::solve (const Matrix& b, octave_idx_type& info) const |
| 5164 | 7122 { |
| 7123 double rcond; | |
| 7124 return solve (b, info, rcond, 0); | |
| 7125 } | |
| 7126 | |
| 7127 Matrix | |
| 5275 | 7128 SparseMatrix::solve (const Matrix& b, octave_idx_type& info, |
| 5164 | 7129 double& rcond) const |
| 7130 { | |
| 7131 return solve (b, info, rcond, 0); | |
| 7132 } | |
| 7133 | |
| 7134 Matrix | |
| 5275 | 7135 SparseMatrix::solve (const Matrix& b, octave_idx_type& err, |
| 5164 | 7136 double& rcond, |
| 7137 solve_singularity_handler sing_handler) const | |
| 7138 { | |
| 5785 | 7139 MatrixType mattype (*this); |
| 5164 | 7140 return solve (mattype, b, err, rcond, sing_handler); |
| 7141 } | |
| 7142 | |
| 7143 SparseMatrix | |
| 7144 SparseMatrix::solve (const SparseMatrix& b) const | |
| 7145 { | |
| 5275 | 7146 octave_idx_type info; |
| 5164 | 7147 double rcond; |
| 7148 return solve (b, info, rcond, 0); | |
| 7149 } | |
| 7150 | |
| 7151 SparseMatrix | |
| 7152 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7153 octave_idx_type& info) const |
| 5164 | 7154 { |
| 7155 double rcond; | |
| 7156 return solve (b, info, rcond, 0); | |
| 7157 } | |
| 7158 | |
| 7159 SparseMatrix | |
| 7160 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7161 octave_idx_type& info, double& rcond) const |
| 5164 | 7162 { |
| 7163 return solve (b, info, rcond, 0); | |
| 7164 } | |
| 7165 | |
| 7166 SparseMatrix | |
| 7167 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7168 octave_idx_type& err, double& rcond, |
| 5164 | 7169 solve_singularity_handler sing_handler) const |
| 7170 { | |
| 5785 | 7171 MatrixType mattype (*this); |
| 5164 | 7172 return solve (mattype, b, err, rcond, sing_handler); |
| 7173 } | |
| 7174 | |
| 7175 ComplexMatrix | |
| 7176 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7177 octave_idx_type& info) const |
| 5164 | 7178 { |
| 7179 double rcond; | |
| 7180 return solve (b, info, rcond, 0); | |
| 7181 } | |
| 7182 | |
| 7183 ComplexMatrix | |
| 7184 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7185 octave_idx_type& info, double& rcond) const |
| 5164 | 7186 { |
| 7187 return solve (b, info, rcond, 0); | |
| 7188 } | |
| 7189 | |
| 7190 ComplexMatrix | |
| 7191 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7192 octave_idx_type& err, double& rcond, |
| 5164 | 7193 solve_singularity_handler sing_handler) const |
| 7194 { | |
| 5785 | 7195 MatrixType mattype (*this); |
| 5164 | 7196 return solve (mattype, b, err, rcond, sing_handler); |
| 7197 } | |
| 7198 | |
| 7199 SparseComplexMatrix | |
| 7200 SparseMatrix::solve (const SparseComplexMatrix& b) const | |
| 7201 { | |
| 5275 | 7202 octave_idx_type info; |
| 5164 | 7203 double rcond; |
| 7204 return solve (b, info, rcond, 0); | |
| 7205 } | |
| 7206 | |
| 7207 SparseComplexMatrix | |
| 7208 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7209 octave_idx_type& info) const |
| 5164 | 7210 { |
| 7211 double rcond; | |
| 7212 return solve (b, info, rcond, 0); | |
| 7213 } | |
| 7214 | |
| 7215 SparseComplexMatrix | |
| 7216 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7217 octave_idx_type& info, double& rcond) const |
| 5164 | 7218 { |
| 7219 return solve (b, info, rcond, 0); | |
| 7220 } | |
| 7221 | |
| 7222 SparseComplexMatrix | |
| 7223 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7224 octave_idx_type& err, double& rcond, |
| 5164 | 7225 solve_singularity_handler sing_handler) const |
| 7226 { | |
| 5785 | 7227 MatrixType mattype (*this); |
| 5164 | 7228 return solve (mattype, b, err, rcond, sing_handler); |
| 7229 } | |
| 7230 | |
| 7231 ColumnVector | |
| 7232 SparseMatrix::solve (const ColumnVector& b) const | |
| 7233 { | |
| 5275 | 7234 octave_idx_type info; double rcond; |
| 5164 | 7235 return solve (b, info, rcond); |
| 7236 } | |
| 7237 | |
| 7238 ColumnVector | |
| 5275 | 7239 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info) const |
| 5164 | 7240 { |
| 7241 double rcond; | |
| 7242 return solve (b, info, rcond); | |
| 7243 } | |
| 7244 | |
| 7245 ColumnVector | |
| 5275 | 7246 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond) const |
| 5164 | 7247 { |
| 7248 return solve (b, info, rcond, 0); | |
| 7249 } | |
| 7250 | |
| 7251 ColumnVector | |
| 5275 | 7252 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7253 solve_singularity_handler sing_handler) const |
| 7254 { | |
| 7255 Matrix tmp (b); | |
| 5275 | 7256 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7257 } |
| 7258 | |
| 7259 ComplexColumnVector | |
| 7260 SparseMatrix::solve (const ComplexColumnVector& b) const | |
| 7261 { | |
| 5275 | 7262 octave_idx_type info; |
| 5164 | 7263 double rcond; |
| 7264 return solve (b, info, rcond, 0); | |
| 7265 } | |
| 7266 | |
| 7267 ComplexColumnVector | |
| 5275 | 7268 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const |
| 5164 | 7269 { |
| 7270 double rcond; | |
| 7271 return solve (b, info, rcond, 0); | |
| 7272 } | |
| 7273 | |
| 7274 ComplexColumnVector | |
| 5275 | 7275 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7276 double& rcond) const |
| 7277 { | |
| 7278 return solve (b, info, rcond, 0); | |
| 7279 } | |
| 7280 | |
| 7281 ComplexColumnVector | |
| 5275 | 7282 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7283 solve_singularity_handler sing_handler) const |
| 7284 { | |
| 7285 ComplexMatrix tmp (b); | |
| 5275 | 7286 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7287 } |
| 7288 | |
| 7289 // other operations. | |
| 7290 | |
| 7291 bool | |
| 7292 SparseMatrix::any_element_is_negative (bool neg_zero) const | |
| 7293 { | |
| 5681 | 7294 octave_idx_type nel = nnz (); |
| 5164 | 7295 |
| 7296 if (neg_zero) | |
| 7297 { | |
| 5275 | 7298 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7299 if (lo_ieee_signbit (data (i))) |
| 7300 return true; | |
| 7301 } | |
| 7302 else | |
| 7303 { | |
| 5275 | 7304 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7305 if (data (i) < 0) |
| 7306 return true; | |
| 7307 } | |
| 7308 | |
| 7309 return false; | |
| 7310 } | |
| 7311 | |
| 7312 bool | |
|
7922
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7313 SparseMatrix::any_element_is_nan (void) const |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7314 { |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7315 octave_idx_type nel = nnz (); |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7316 |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7317 for (octave_idx_type i = 0; i < nel; i++) |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7318 { |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7319 double val = data (i); |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7320 if (xisnan (val)) |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7321 return true; |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7322 } |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7323 |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7324 return false; |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7325 } |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7326 |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7327 bool |
| 5164 | 7328 SparseMatrix::any_element_is_inf_or_nan (void) const |
| 7329 { | |
| 5681 | 7330 octave_idx_type nel = nnz (); |
| 5275 | 7331 |
| 7332 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7333 { |
| 7334 double val = data (i); | |
| 7335 if (xisinf (val) || xisnan (val)) | |
| 7336 return true; | |
| 7337 } | |
| 7338 | |
| 7339 return false; | |
| 7340 } | |
| 7341 | |
| 7342 bool | |
| 6989 | 7343 SparseMatrix::all_elements_are_zero (void) const |
| 7344 { | |
| 7345 octave_idx_type nel = nnz (); | |
| 7346 | |
| 7347 for (octave_idx_type i = 0; i < nel; i++) | |
| 7348 if (data (i) != 0) | |
| 7349 return false; | |
| 7350 | |
| 7351 return true; | |
| 7352 } | |
| 7353 | |
| 7354 bool | |
| 5164 | 7355 SparseMatrix::all_elements_are_int_or_inf_or_nan (void) const |
| 7356 { | |
| 5681 | 7357 octave_idx_type nel = nnz (); |
| 5275 | 7358 |
| 7359 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7360 { |
| 7361 double val = data (i); | |
| 7362 if (xisnan (val) || D_NINT (val) == val) | |
| 7363 continue; | |
| 7364 else | |
| 7365 return false; | |
| 7366 } | |
| 7367 | |
| 7368 return true; | |
| 7369 } | |
| 7370 | |
| 7371 // Return nonzero if any element of M is not an integer. Also extract | |
| 7372 // the largest and smallest values and return them in MAX_VAL and MIN_VAL. | |
| 7373 | |
| 7374 bool | |
| 7375 SparseMatrix::all_integers (double& max_val, double& min_val) const | |
| 7376 { | |
| 5681 | 7377 octave_idx_type nel = nnz (); |
| 5164 | 7378 |
| 7379 if (nel == 0) | |
| 7380 return false; | |
| 7381 | |
| 7382 max_val = data (0); | |
| 7383 min_val = data (0); | |
| 7384 | |
| 5275 | 7385 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7386 { |
| 7387 double val = data (i); | |
| 7388 | |
| 7389 if (val > max_val) | |
| 7390 max_val = val; | |
| 7391 | |
| 7392 if (val < min_val) | |
| 7393 min_val = val; | |
| 7394 | |
| 7395 if (D_NINT (val) != val) | |
| 7396 return false; | |
| 7397 } | |
| 7398 | |
| 7399 return true; | |
| 7400 } | |
| 7401 | |
| 7402 bool | |
| 7403 SparseMatrix::too_large_for_float (void) const | |
| 7404 { | |
| 5681 | 7405 octave_idx_type nel = nnz (); |
| 5275 | 7406 |
| 7407 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7408 { |
| 7409 double val = data (i); | |
| 7410 | |
| 7411 if (val > FLT_MAX || val < FLT_MIN) | |
| 7412 return true; | |
| 7413 } | |
| 7414 | |
| 7415 return false; | |
| 7416 } | |
| 7417 | |
| 7418 SparseBoolMatrix | |
| 7419 SparseMatrix::operator ! (void) const | |
| 7420 { | |
| 5275 | 7421 octave_idx_type nr = rows (); |
| 7422 octave_idx_type nc = cols (); | |
| 5681 | 7423 octave_idx_type nz1 = nnz (); |
| 5275 | 7424 octave_idx_type nz2 = nr*nc - nz1; |
| 5164 | 7425 |
| 7426 SparseBoolMatrix r (nr, nc, nz2); | |
| 7427 | |
| 5275 | 7428 octave_idx_type ii = 0; |
| 7429 octave_idx_type jj = 0; | |
| 5164 | 7430 r.cidx (0) = 0; |
| 5275 | 7431 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 7432 { |
| 5275 | 7433 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 7434 { |
| 7435 if (jj < cidx(i+1) && ridx(jj) == j) | |
| 7436 jj++; | |
| 7437 else | |
| 7438 { | |
| 7439 r.data(ii) = true; | |
| 7440 r.ridx(ii++) = j; | |
| 7441 } | |
| 7442 } | |
| 7443 r.cidx (i+1) = ii; | |
| 7444 } | |
| 7445 | |
| 7446 return r; | |
| 7447 } | |
| 7448 | |
| 5775 | 7449 // FIXME Do these really belong here? Maybe they should be |
| 5164 | 7450 // in a base class? |
| 7451 | |
| 7452 SparseBoolMatrix | |
| 7453 SparseMatrix::all (int dim) const | |
| 7454 { | |
| 7455 SPARSE_ALL_OP (dim); | |
| 7456 } | |
| 7457 | |
| 7458 SparseBoolMatrix | |
| 7459 SparseMatrix::any (int dim) const | |
| 7460 { | |
| 7461 SPARSE_ANY_OP (dim); | |
| 7462 } | |
| 7463 | |
| 7464 SparseMatrix | |
| 7465 SparseMatrix::cumprod (int dim) const | |
| 7466 { | |
| 7467 SPARSE_CUMPROD (SparseMatrix, double, cumprod); | |
| 7468 } | |
| 7469 | |
| 7470 SparseMatrix | |
| 7471 SparseMatrix::cumsum (int dim) const | |
| 7472 { | |
| 7473 SPARSE_CUMSUM (SparseMatrix, double, cumsum); | |
| 7474 } | |
| 7475 | |
| 7476 SparseMatrix | |
| 7477 SparseMatrix::prod (int dim) const | |
| 7478 { | |
| 7269 | 7479 if ((rows() == 1 && dim == -1) || dim == 1) |
| 7480 return transpose (). prod (0). transpose(); | |
| 7481 else | |
| 7482 { | |
| 7483 SPARSE_REDUCTION_OP (SparseMatrix, double, *=, | |
| 7484 (cidx(j+1) - cidx(j) < nc ? 0.0 : 1.0), 1.0); | |
| 7485 } | |
| 5164 | 7486 } |
| 7487 | |
| 7488 SparseMatrix | |
| 7489 SparseMatrix::sum (int dim) const | |
| 7490 { | |
| 7491 SPARSE_REDUCTION_OP (SparseMatrix, double, +=, 0.0, 0.0); | |
| 7492 } | |
| 7493 | |
| 7494 SparseMatrix | |
| 7495 SparseMatrix::sumsq (int dim) const | |
| 7496 { | |
| 7497 #define ROW_EXPR \ | |
| 7269 | 7498 double d = data (i); \ |
| 7499 tmp[ridx(i)] += d * d | |
| 5164 | 7500 |
| 7501 #define COL_EXPR \ | |
| 7269 | 7502 double d = data (i); \ |
| 5164 | 7503 tmp[j] += d * d |
| 7504 | |
| 7505 SPARSE_BASE_REDUCTION_OP (SparseMatrix, double, ROW_EXPR, COL_EXPR, | |
| 7506 0.0, 0.0); | |
| 7507 | |
| 7508 #undef ROW_EXPR | |
| 7509 #undef COL_EXPR | |
| 7510 } | |
| 7511 | |
| 7512 SparseMatrix | |
| 7513 SparseMatrix::abs (void) const | |
| 7514 { | |
| 5681 | 7515 octave_idx_type nz = nnz (); |
| 5164 | 7516 |
| 7517 SparseMatrix retval (*this); | |
| 7518 | |
| 5275 | 7519 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7520 retval.data(i) = fabs(retval.data(i)); |
| 7521 | |
| 7522 return retval; | |
| 7523 } | |
| 7524 | |
| 7525 SparseMatrix | |
| 5275 | 7526 SparseMatrix::diag (octave_idx_type k) const |
| 5164 | 7527 { |
|
7620
36594d5bbe13
Move diag function into the octave_value class
David Bateman <dbateman@free.fr>
parents:
7602
diff
changeset
|
7528 return MSparse<double>::diag (k); |
| 5164 | 7529 } |
| 7530 | |
| 7531 Matrix | |
| 7532 SparseMatrix::matrix_value (void) const | |
| 7533 { | |
| 5275 | 7534 octave_idx_type nr = rows (); |
| 7535 octave_idx_type nc = cols (); | |
| 5164 | 7536 |
| 7537 Matrix retval (nr, nc, 0.0); | |
| 5275 | 7538 for (octave_idx_type j = 0; j < nc; j++) |
| 7539 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 7540 retval.elem (ridx(i), j) = data (i); |
| 7541 | |
| 7542 return retval; | |
| 7543 } | |
| 7544 | |
|
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7545 SparseMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7546 SparseMatrix::map (dmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7547 { |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
7548 return MSparse<double>::map<double> (func_ptr (fcn)); |
|
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7549 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7550 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7551 SparseComplexMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7552 SparseMatrix::map (cmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7553 { |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
7554 return MSparse<double>::map<Complex> (func_ptr (fcn)); |
|
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7555 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7556 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7557 SparseBoolMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7558 SparseMatrix::map (bmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7559 { |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
7560 return MSparse<double>::map<bool> (func_ptr (fcn)); |
|
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7561 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7562 |
| 5164 | 7563 std::ostream& |
| 7564 operator << (std::ostream& os, const SparseMatrix& a) | |
| 7565 { | |
| 5275 | 7566 octave_idx_type nc = a.cols (); |
| 5164 | 7567 |
| 7568 // add one to the printed indices to go from | |
| 7569 // zero-based to one-based arrays | |
| 5275 | 7570 for (octave_idx_type j = 0; j < nc; j++) { |
| 5164 | 7571 OCTAVE_QUIT; |
| 5275 | 7572 for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) { |
| 5164 | 7573 os << a.ridx(i) + 1 << " " << j + 1 << " "; |
| 7574 octave_write_double (os, a.data(i)); | |
| 7575 os << "\n"; | |
| 7576 } | |
| 7577 } | |
| 7578 | |
| 7579 return os; | |
| 7580 } | |
| 7581 | |
| 7582 std::istream& | |
| 7583 operator >> (std::istream& is, SparseMatrix& a) | |
| 7584 { | |
| 5275 | 7585 octave_idx_type nr = a.rows (); |
| 7586 octave_idx_type nc = a.cols (); | |
| 5604 | 7587 octave_idx_type nz = a.nzmax (); |
| 5164 | 7588 |
| 7589 if (nr < 1 || nc < 1) | |
| 7590 is.clear (std::ios::badbit); | |
| 7591 else | |
| 7592 { | |
| 5275 | 7593 octave_idx_type itmp, jtmp, jold = 0; |
| 5164 | 7594 double tmp; |
| 5275 | 7595 octave_idx_type ii = 0; |
| 5164 | 7596 |
| 7597 a.cidx (0) = 0; | |
| 5275 | 7598 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7599 { |
| 7600 is >> itmp; | |
| 7601 itmp--; | |
| 7602 is >> jtmp; | |
| 7603 jtmp--; | |
| 7604 tmp = octave_read_double (is); | |
| 7605 | |
| 7606 if (is) | |
| 7607 { | |
| 7608 if (jold != jtmp) | |
| 7609 { | |
| 5275 | 7610 for (octave_idx_type j = jold; j < jtmp; j++) |
| 5164 | 7611 a.cidx(j+1) = ii; |
| 7612 | |
| 7613 jold = jtmp; | |
| 7614 } | |
| 7615 a.data (ii) = tmp; | |
| 7616 a.ridx (ii++) = itmp; | |
| 7617 } | |
| 7618 else | |
| 7619 goto done; | |
| 7620 } | |
| 7621 | |
| 5275 | 7622 for (octave_idx_type j = jold; j < nc; j++) |
| 5164 | 7623 a.cidx(j+1) = ii; |
| 7624 } | |
| 7625 | |
| 7626 done: | |
| 7627 | |
| 7628 return is; | |
| 7629 } | |
| 7630 | |
| 7631 SparseMatrix | |
| 7632 SparseMatrix::squeeze (void) const | |
| 7633 { | |
| 7634 return MSparse<double>::squeeze (); | |
| 7635 } | |
| 7636 | |
| 7637 SparseMatrix | |
| 7638 SparseMatrix::index (idx_vector& i, int resize_ok) const | |
| 7639 { | |
| 7640 return MSparse<double>::index (i, resize_ok); | |
| 7641 } | |
| 7642 | |
| 7643 SparseMatrix | |
| 7644 SparseMatrix::index (idx_vector& i, idx_vector& j, int resize_ok) const | |
| 7645 { | |
| 7646 return MSparse<double>::index (i, j, resize_ok); | |
| 7647 } | |
| 7648 | |
| 7649 SparseMatrix | |
| 7650 SparseMatrix::index (Array<idx_vector>& ra_idx, int resize_ok) const | |
| 7651 { | |
| 7652 return MSparse<double>::index (ra_idx, resize_ok); | |
| 7653 } | |
| 7654 | |
| 7655 SparseMatrix | |
| 7656 SparseMatrix::reshape (const dim_vector& new_dims) const | |
| 7657 { | |
| 7658 return MSparse<double>::reshape (new_dims); | |
| 7659 } | |
| 7660 | |
| 7661 SparseMatrix | |
| 5275 | 7662 SparseMatrix::permute (const Array<octave_idx_type>& vec, bool inv) const |
| 5164 | 7663 { |
| 7664 return MSparse<double>::permute (vec, inv); | |
| 7665 } | |
| 7666 | |
| 7667 SparseMatrix | |
| 5275 | 7668 SparseMatrix::ipermute (const Array<octave_idx_type>& vec) const |
| 5164 | 7669 { |
| 7670 return MSparse<double>::ipermute (vec); | |
| 7671 } | |
| 7672 | |
| 7673 // matrix by matrix -> matrix operations | |
| 7674 | |
| 7675 SparseMatrix | |
| 7676 operator * (const SparseMatrix& m, const SparseMatrix& a) | |
| 7677 { | |
| 5681 | 7678 SPARSE_SPARSE_MUL (SparseMatrix, double, double); |
| 5164 | 7679 } |
| 7680 | |
| 5429 | 7681 Matrix |
| 7682 operator * (const Matrix& m, const SparseMatrix& a) | |
| 7683 { | |
| 5681 | 7684 FULL_SPARSE_MUL (Matrix, double, 0.); |
| 5429 | 7685 } |
| 7686 | |
| 7687 Matrix | |
|
7802
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7688 mul_trans (const Matrix& m, const SparseMatrix& a) |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7689 { |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7690 FULL_SPARSE_MUL_TRANS (Matrix, double, 0., ); |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7691 } |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7692 |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7693 Matrix |
| 5429 | 7694 operator * (const SparseMatrix& m, const Matrix& a) |
| 7695 { | |
| 5681 | 7696 SPARSE_FULL_MUL (Matrix, double, 0.); |
| 5429 | 7697 } |
| 7698 | |
|
7802
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7699 Matrix |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7700 trans_mul (const SparseMatrix& m, const Matrix& a) |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7701 { |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7702 SPARSE_FULL_TRANS_MUL (Matrix, double, 0., ); |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7703 } |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7704 |
|
8964
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7705 // diag * sparse and sparse * diag |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7706 |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7707 SparseMatrix |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7708 operator * (const DiagMatrix& d, const SparseMatrix& a) |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7709 { |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7710 return octave_impl::do_mul_dm_sm<SparseMatrix> (d, a); |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7711 } |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7712 |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7713 SparseMatrix |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7714 operator * (const SparseMatrix& a, const DiagMatrix& d) |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7715 { |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7716 return octave_impl::do_mul_sm_dm<SparseMatrix> (a, d); |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7717 } |
|
f4f4d65faaa0
Implement sparse * diagonal and diagonal * sparse operations, double-prec only.
Jason Riedy <jason@acm.org>
parents:
8951
diff
changeset
|
7718 |
|
8966
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7719 SparseMatrix |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7720 operator + (const DiagMatrix& d, const SparseMatrix& a) |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7721 { |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7722 return octave_impl::do_add_dm_sm<SparseMatrix> (d, a); |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7723 } |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7724 |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7725 SparseMatrix |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7726 operator - (const DiagMatrix& d, const SparseMatrix& a) |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7727 { |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7728 return octave_impl::do_sub_dm_sm<SparseMatrix> (d, a); |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7729 } |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7730 |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7731 SparseMatrix |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7732 operator + (const SparseMatrix& a, const DiagMatrix& d) |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7733 { |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7734 return octave_impl::do_add_sm_dm<SparseMatrix> (a, d); |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7735 } |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7736 |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7737 SparseMatrix |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7738 operator - (const SparseMatrix& a, const DiagMatrix& d) |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7739 { |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7740 return octave_impl::do_sub_sm_dm<SparseMatrix> (a, d); |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7741 } |
|
1bba53c0a38d
Implement diag + sparse, diag - sparse, sparse + diag, sparse - diag.
Jason Riedy <jason@acm.org>
parents:
8964
diff
changeset
|
7742 |
| 5775 | 7743 // FIXME -- it would be nice to share code among the min/max |
| 5164 | 7744 // functions below. |
| 7745 | |
| 7746 #define EMPTY_RETURN_CHECK(T) \ | |
| 7747 if (nr == 0 || nc == 0) \ | |
| 7748 return T (nr, nc); | |
| 7749 | |
| 7750 SparseMatrix | |
| 7751 min (double d, const SparseMatrix& m) | |
| 7752 { | |
| 7753 SparseMatrix result; | |
| 7754 | |
| 5275 | 7755 octave_idx_type nr = m.rows (); |
| 7756 octave_idx_type nc = m.columns (); | |
| 5164 | 7757 |
| 7758 EMPTY_RETURN_CHECK (SparseMatrix); | |
| 7759 | |
| 7760 // Count the number of non-zero elements | |
| 7761 if (d < 0.) | |
| 7762 { | |
| 7763 result = SparseMatrix (nr, nc, d); | |
| 5275 | 7764 for (octave_idx_type j = 0; j < nc; j++) |
| 7765 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7766 { |
| 7767 double tmp = xmin (d, m.data (i)); | |
| 7768 if (tmp != 0.) | |
| 7769 { | |
| 5275 | 7770 octave_idx_type idx = m.ridx(i) + j * nr; |
| 5164 | 7771 result.xdata(idx) = tmp; |
| 7772 result.xridx(idx) = m.ridx(i); | |
| 7773 } | |
| 7774 } | |
| 7775 } | |
| 7776 else | |
| 7777 { | |
| 5275 | 7778 octave_idx_type nel = 0; |
| 7779 for (octave_idx_type j = 0; j < nc; j++) | |
| 7780 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7781 if (xmin (d, m.data (i)) != 0.) |
| 7782 nel++; | |
| 7783 | |
| 7784 result = SparseMatrix (nr, nc, nel); | |
| 7785 | |
| 5275 | 7786 octave_idx_type ii = 0; |
| 5164 | 7787 result.xcidx(0) = 0; |
| 5275 | 7788 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 7789 { |
| 5275 | 7790 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
| 5164 | 7791 { |
| 7792 double tmp = xmin (d, m.data (i)); | |
| 7793 | |
| 7794 if (tmp != 0.) | |
| 7795 { | |
| 7796 result.xdata(ii) = tmp; | |
| 7797 result.xridx(ii++) = m.ridx(i); | |
| 7798 } | |
| 7799 } | |
| 7800 result.xcidx(j+1) = ii; | |
| 7801 } | |
| 7802 } | |
| 7803 | |
| 7804 return result; | |
| 7805 } | |
| 7806 | |
| 7807 SparseMatrix | |
| 7808 min (const SparseMatrix& m, double d) | |
| 7809 { | |
| 7810 return min (d, m); | |
| 7811 } | |
| 7812 | |
| 7813 SparseMatrix | |
| 7814 min (const SparseMatrix& a, const SparseMatrix& b) | |
| 7815 { | |
| 7816 SparseMatrix r; | |
| 7817 | |
| 7818 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 7819 { | |
| 5275 | 7820 octave_idx_type a_nr = a.rows (); |
| 7821 octave_idx_type a_nc = a.cols (); | |
| 7822 | |
| 7823 octave_idx_type b_nr = b.rows (); | |
| 7824 octave_idx_type b_nc = b.cols (); | |
| 5164 | 7825 |
| 7826 if (a_nr != b_nr || a_nc != b_nc) | |
| 7827 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 7828 else | |
| 7829 { | |
| 5681 | 7830 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 7831 |
| 5275 | 7832 octave_idx_type jx = 0; |
| 5164 | 7833 r.cidx (0) = 0; |
| 5275 | 7834 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 7835 { |
| 5275 | 7836 octave_idx_type ja = a.cidx(i); |
| 7837 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 7838 bool ja_lt_max= ja < ja_max; |
| 7839 | |
| 5275 | 7840 octave_idx_type jb = b.cidx(i); |
| 7841 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 7842 bool jb_lt_max = jb < jb_max; |
| 7843 | |
| 7844 while (ja_lt_max || jb_lt_max ) | |
| 7845 { | |
| 7846 OCTAVE_QUIT; | |
| 7847 if ((! jb_lt_max) || | |
| 7848 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 7849 { | |
| 7850 double tmp = xmin (a.data(ja), 0.); | |
| 7851 if (tmp != 0.) | |
| 7852 { | |
| 7853 r.ridx(jx) = a.ridx(ja); | |
| 7854 r.data(jx) = tmp; | |
| 7855 jx++; | |
| 7856 } | |
| 7857 ja++; | |
| 7858 ja_lt_max= ja < ja_max; | |
| 7859 } | |
| 7860 else if (( !ja_lt_max ) || | |
| 7861 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 7862 { | |
| 7863 double tmp = xmin (0., b.data(jb)); | |
| 7864 if (tmp != 0.) | |
| 7865 { | |
| 7866 r.ridx(jx) = b.ridx(jb); | |
| 7867 r.data(jx) = tmp; | |
| 7868 jx++; | |
| 7869 } | |
| 7870 jb++; | |
| 7871 jb_lt_max= jb < jb_max; | |
| 7872 } | |
| 7873 else | |
| 7874 { | |
| 7875 double tmp = xmin (a.data(ja), b.data(jb)); | |
| 7876 if (tmp != 0.) | |
| 7877 { | |
| 7878 r.data(jx) = tmp; | |
| 7879 r.ridx(jx) = a.ridx(ja); | |
| 7880 jx++; | |
| 7881 } | |
| 7882 ja++; | |
| 7883 ja_lt_max= ja < ja_max; | |
| 7884 jb++; | |
| 7885 jb_lt_max= jb < jb_max; | |
| 7886 } | |
| 7887 } | |
| 7888 r.cidx(i+1) = jx; | |
| 7889 } | |
| 7890 | |
| 7891 r.maybe_compress (); | |
| 7892 } | |
| 7893 } | |
| 7894 else | |
| 7895 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 7896 | |
| 7897 return r; | |
| 7898 } | |
| 7899 | |
| 7900 SparseMatrix | |
| 7901 max (double d, const SparseMatrix& m) | |
| 7902 { | |
| 7903 SparseMatrix result; | |
| 7904 | |
| 5275 | 7905 octave_idx_type nr = m.rows (); |
| 7906 octave_idx_type nc = m.columns (); | |
| 5164 | 7907 |
| 7908 EMPTY_RETURN_CHECK (SparseMatrix); | |
| 7909 | |
| 7910 // Count the number of non-zero elements | |
| 7911 if (d > 0.) | |
| 7912 { | |
| 7913 result = SparseMatrix (nr, nc, d); | |
| 5275 | 7914 for (octave_idx_type j = 0; j < nc; j++) |
| 7915 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7916 { |
| 7917 double tmp = xmax (d, m.data (i)); | |
| 7918 | |
| 7919 if (tmp != 0.) | |
| 7920 { | |
| 5275 | 7921 octave_idx_type idx = m.ridx(i) + j * nr; |
| 5164 | 7922 result.xdata(idx) = tmp; |
| 7923 result.xridx(idx) = m.ridx(i); | |
| 7924 } | |
| 7925 } | |
| 7926 } | |
| 7927 else | |
| 7928 { | |
| 5275 | 7929 octave_idx_type nel = 0; |
| 7930 for (octave_idx_type j = 0; j < nc; j++) | |
| 7931 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7932 if (xmax (d, m.data (i)) != 0.) |
| 7933 nel++; | |
| 7934 | |
| 7935 result = SparseMatrix (nr, nc, nel); | |
| 7936 | |
| 5275 | 7937 octave_idx_type ii = 0; |
| 5164 | 7938 result.xcidx(0) = 0; |
| 5275 | 7939 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 7940 { |
| 5275 | 7941 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
| 5164 | 7942 { |
| 7943 double tmp = xmax (d, m.data (i)); | |
| 7944 if (tmp != 0.) | |
| 7945 { | |
| 7946 result.xdata(ii) = tmp; | |
| 7947 result.xridx(ii++) = m.ridx(i); | |
| 7948 } | |
| 7949 } | |
| 7950 result.xcidx(j+1) = ii; | |
| 7951 } | |
| 7952 } | |
| 7953 | |
| 7954 return result; | |
| 7955 } | |
| 7956 | |
| 7957 SparseMatrix | |
| 7958 max (const SparseMatrix& m, double d) | |
| 7959 { | |
| 7960 return max (d, m); | |
| 7961 } | |
| 7962 | |
| 7963 SparseMatrix | |
| 7964 max (const SparseMatrix& a, const SparseMatrix& b) | |
| 7965 { | |
| 7966 SparseMatrix r; | |
| 7967 | |
| 7968 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 7969 { | |
| 5275 | 7970 octave_idx_type a_nr = a.rows (); |
| 7971 octave_idx_type a_nc = a.cols (); | |
| 7972 | |
| 7973 octave_idx_type b_nr = b.rows (); | |
| 7974 octave_idx_type b_nc = b.cols (); | |
| 5164 | 7975 |
| 7976 if (a_nr != b_nr || a_nc != b_nc) | |
| 7977 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 7978 else | |
| 7979 { | |
| 5681 | 7980 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 7981 |
| 5275 | 7982 octave_idx_type jx = 0; |
| 5164 | 7983 r.cidx (0) = 0; |
| 5275 | 7984 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 7985 { |
| 5275 | 7986 octave_idx_type ja = a.cidx(i); |
| 7987 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 7988 bool ja_lt_max= ja < ja_max; |
| 7989 | |
| 5275 | 7990 octave_idx_type jb = b.cidx(i); |
| 7991 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 7992 bool jb_lt_max = jb < jb_max; |
| 7993 | |
| 7994 while (ja_lt_max || jb_lt_max ) | |
| 7995 { | |
| 7996 OCTAVE_QUIT; | |
| 7997 if ((! jb_lt_max) || | |
| 7998 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 7999 { | |
| 8000 double tmp = xmax (a.data(ja), 0.); | |
| 8001 if (tmp != 0.) | |
| 8002 { | |
| 8003 r.ridx(jx) = a.ridx(ja); | |
| 8004 r.data(jx) = tmp; | |
| 8005 jx++; | |
| 8006 } | |
| 8007 ja++; | |
| 8008 ja_lt_max= ja < ja_max; | |
| 8009 } | |
| 8010 else if (( !ja_lt_max ) || | |
| 8011 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 8012 { | |
| 8013 double tmp = xmax (0., b.data(jb)); | |
| 8014 if (tmp != 0.) | |
| 8015 { | |
| 8016 r.ridx(jx) = b.ridx(jb); | |
| 8017 r.data(jx) = tmp; | |
| 8018 jx++; | |
| 8019 } | |
| 8020 jb++; | |
| 8021 jb_lt_max= jb < jb_max; | |
| 8022 } | |
| 8023 else | |
| 8024 { | |
| 8025 double tmp = xmax (a.data(ja), b.data(jb)); | |
| 8026 if (tmp != 0.) | |
| 8027 { | |
| 8028 r.data(jx) = tmp; | |
| 8029 r.ridx(jx) = a.ridx(ja); | |
| 8030 jx++; | |
| 8031 } | |
| 8032 ja++; | |
| 8033 ja_lt_max= ja < ja_max; | |
| 8034 jb++; | |
| 8035 jb_lt_max= jb < jb_max; | |
| 8036 } | |
| 8037 } | |
| 8038 r.cidx(i+1) = jx; | |
| 8039 } | |
| 8040 | |
| 8041 r.maybe_compress (); | |
| 8042 } | |
| 8043 } | |
| 8044 else | |
| 8045 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 8046 | |
| 8047 return r; | |
| 8048 } | |
| 8049 | |
| 8050 SPARSE_SMS_CMP_OPS (SparseMatrix, 0.0, , double, 0.0, ) | |
| 8051 SPARSE_SMS_BOOL_OPS (SparseMatrix, double, 0.0) | |
| 8052 | |
| 8053 SPARSE_SSM_CMP_OPS (double, 0.0, , SparseMatrix, 0.0, ) | |
| 8054 SPARSE_SSM_BOOL_OPS (double, SparseMatrix, 0.0) | |
| 8055 | |
| 8056 SPARSE_SMSM_CMP_OPS (SparseMatrix, 0.0, , SparseMatrix, 0.0, ) | |
| 8057 SPARSE_SMSM_BOOL_OPS (SparseMatrix, SparseMatrix, 0.0) | |
| 8058 | |
| 8059 /* | |
| 8060 ;;; Local Variables: *** | |
| 8061 ;;; mode: C++ *** | |
| 8062 ;;; End: *** | |
| 8063 */ |