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