Mercurial > octave-nkf
annotate liboctave/dSparse.cc @ 8967:5bbbf482909a
fix omissions adjusting JR's patches
| author | Jaroslav Hajek <highegg@gmail.com> |
|---|---|
| date | Thu, 12 Mar 2009 11:46:56 +0100 |
| parents | 1bba53c0a38d |
| children | 91d53dc37f79 |
| 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 { |
|
8967
5bbbf482909a
fix omissions adjusting JR's patches
Jaroslav Hajek <highegg@gmail.com>
parents:
8966
diff
changeset
|
7710 return do_mul_dm_sm<SparseMatrix> (d, a); |
|
8964
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 { |
|
8967
5bbbf482909a
fix omissions adjusting JR's patches
Jaroslav Hajek <highegg@gmail.com>
parents:
8966
diff
changeset
|
7716 return do_mul_sm_dm<SparseMatrix> (a, d); |
|
8964
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 { |
|
8967
5bbbf482909a
fix omissions adjusting JR's patches
Jaroslav Hajek <highegg@gmail.com>
parents:
8966
diff
changeset
|
7722 return do_add_dm_sm<SparseMatrix> (d, a); |
|
8966
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 { |
|
8967
5bbbf482909a
fix omissions adjusting JR's patches
Jaroslav Hajek <highegg@gmail.com>
parents:
8966
diff
changeset
|
7728 return do_sub_dm_sm<SparseMatrix> (d, a); |
|
8966
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 { |
|
8967
5bbbf482909a
fix omissions adjusting JR's patches
Jaroslav Hajek <highegg@gmail.com>
parents:
8966
diff
changeset
|
7734 return do_add_sm_dm<SparseMatrix> (a, d); |
|
8966
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 { |
|
8967
5bbbf482909a
fix omissions adjusting JR's patches
Jaroslav Hajek <highegg@gmail.com>
parents:
8966
diff
changeset
|
7740 return do_sub_sm_dm<SparseMatrix> (a, d); |
|
8966
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 */ |