Mercurial > hg > octave-nkf
annotate liboctave/dSparse.cc @ 8920:eb63fbe60fab
update copyright notices
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Sat, 07 Mar 2009 10:41:27 -0500 |
| parents | 6e9f26506804 |
| children | 5bce1357edd6 |
| rev | line source |
|---|---|
| 5164 | 1 /* |
| 2 | |
| 8920 | 3 Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 David Bateman |
| 7016 | 4 Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Andy Adler |
| 5 | |
| 6 This file is part of Octave. | |
| 5164 | 7 |
| 8 Octave is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
| 11 option) any later version. | |
| 5164 | 12 |
| 13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 7016 | 19 along with Octave; see the file COPYING. If not, see |
| 20 <http://www.gnu.org/licenses/>. | |
| 5164 | 21 |
| 22 */ | |
| 23 | |
| 24 #ifdef HAVE_CONFIG_H | |
| 25 #include <config.h> | |
| 26 #endif | |
| 27 | |
| 28 #include <cfloat> | |
| 29 | |
| 30 #include <iostream> | |
| 31 #include <vector> | |
| 32 | |
| 33 #include "quit.h" | |
| 34 #include "lo-ieee.h" | |
| 35 #include "lo-mappers.h" | |
| 36 #include "f77-fcn.h" | |
| 37 #include "dRowVector.h" | |
|
8377
25bc2d31e1bf
improve OCTAVE_LOCAL_BUFFER
Jaroslav Hajek <highegg@gmail.com>
parents:
8366
diff
changeset
|
38 #include "oct-locbuf.h" |
| 5164 | 39 |
| 40 #include "CSparse.h" | |
| 41 #include "boolSparse.h" | |
| 42 #include "dSparse.h" | |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
43 #include "functor.h" |
| 5164 | 44 #include "oct-spparms.h" |
| 45 #include "SparsedbleLU.h" | |
| 5785 | 46 #include "MatrixType.h" |
| 5451 | 47 #include "oct-sparse.h" |
| 5506 | 48 #include "sparse-util.h" |
| 49 #include "SparsedbleCHOL.h" | |
| 5610 | 50 #include "SparseQR.h" |
| 5164 | 51 |
| 5681 | 52 // Define whether to use a basic QR solver or one that uses a Dulmange |
| 53 // Mendelsohn factorization to seperate the problem into under-determined, | |
| 54 // well-determined and over-determined parts and solves them seperately | |
| 55 #ifndef USE_QRSOLVE | |
| 56 #include "sparse-dmsolve.cc" | |
| 57 #endif | |
| 58 | |
| 5164 | 59 // Fortran functions we call. |
| 60 extern "C" | |
| 61 { | |
| 62 F77_RET_T | |
| 6242 | 63 F77_FUNC (dgbtrf, DGBTRF) (const octave_idx_type&, const octave_idx_type&, |
| 64 const octave_idx_type&, const octave_idx_type&, | |
| 65 double*, const octave_idx_type&, | |
| 66 octave_idx_type*, octave_idx_type&); | |
| 5164 | 67 |
| 68 F77_RET_T | |
| 5275 | 69 F77_FUNC (dgbtrs, DGBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 70 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
| 71 const double*, const octave_idx_type&, | |
| 72 const octave_idx_type*, double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 73 F77_CHAR_ARG_LEN_DECL); |
| 74 | |
| 75 F77_RET_T | |
| 5275 | 76 F77_FUNC (dgbcon, DGBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 77 const octave_idx_type&, const octave_idx_type&, double*, | |
| 78 const octave_idx_type&, const octave_idx_type*, const double&, | |
| 79 double&, double*, octave_idx_type*, octave_idx_type& | |
| 5164 | 80 F77_CHAR_ARG_LEN_DECL); |
| 81 | |
| 82 F77_RET_T | |
| 5275 | 83 F77_FUNC (dpbtrf, DPBTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 84 const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 85 F77_CHAR_ARG_LEN_DECL); |
| 86 | |
| 87 F77_RET_T | |
| 5275 | 88 F77_FUNC (dpbtrs, DPBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 89 const octave_idx_type&, const octave_idx_type&, double*, const octave_idx_type&, | |
| 90 double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 91 F77_CHAR_ARG_LEN_DECL); |
| 92 | |
| 93 F77_RET_T | |
| 5275 | 94 F77_FUNC (dpbcon, DPBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 95 const octave_idx_type&, double*, const octave_idx_type&, | |
| 96 const double&, double&, double*, octave_idx_type*, octave_idx_type& | |
| 5164 | 97 F77_CHAR_ARG_LEN_DECL); |
| 98 F77_RET_T | |
| 5275 | 99 F77_FUNC (dptsv, DPTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, |
| 100 double*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 101 |
| 102 F77_RET_T | |
| 5275 | 103 F77_FUNC (dgtsv, DGTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, |
| 104 double*, double*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 105 |
| 106 F77_RET_T | |
| 5275 | 107 F77_FUNC (dgttrf, DGTTRF) (const octave_idx_type&, double*, double*, double*, double*, |
| 108 octave_idx_type*, octave_idx_type&); | |
| 5164 | 109 |
| 110 F77_RET_T | |
| 5275 | 111 F77_FUNC (dgttrs, DGTTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 112 const octave_idx_type&, const double*, const double*, | |
| 113 const double*, const double*, const octave_idx_type*, | |
| 114 double *, const octave_idx_type&, octave_idx_type& | |
| 5164 | 115 F77_CHAR_ARG_LEN_DECL); |
| 116 | |
| 117 F77_RET_T | |
| 5322 | 118 F77_FUNC (zptsv, ZPTSV) (const octave_idx_type&, const octave_idx_type&, double*, Complex*, |
| 5275 | 119 Complex*, const octave_idx_type&, octave_idx_type&); |
| 5164 | 120 |
| 121 F77_RET_T | |
| 5275 | 122 F77_FUNC (zgtsv, ZGTSV) (const octave_idx_type&, const octave_idx_type&, Complex*, Complex*, |
| 123 Complex*, Complex*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 124 |
| 125 } | |
| 126 | |
| 127 SparseMatrix::SparseMatrix (const SparseBoolMatrix &a) | |
| 5681 | 128 : MSparse<double> (a.rows (), a.cols (), a.nnz ()) |
| 5164 | 129 { |
| 5275 | 130 octave_idx_type nc = cols (); |
| 5681 | 131 octave_idx_type nz = a.nnz (); |
| 5275 | 132 |
| 133 for (octave_idx_type i = 0; i < nc + 1; i++) | |
| 5164 | 134 cidx (i) = a.cidx (i); |
| 135 | |
| 5275 | 136 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 137 { |
| 138 data (i) = a.data (i); | |
| 139 ridx (i) = a.ridx (i); | |
| 140 } | |
| 141 } | |
| 142 | |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
143 SparseMatrix::SparseMatrix (const DiagMatrix& a) |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
144 : 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
|
145 { |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
146 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
|
147 for (octave_idx_type i = 0; i < l; i++) |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
148 { |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
149 cidx (i) = j; |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
150 if (a(i, i) != 0.0) |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
151 { |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
152 data (j) = a(i, i); |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
153 ridx (j) = i; |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
154 j++; |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
155 } |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
156 } |
|
8910
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
157 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
|
158 cidx(i) = j; |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
159 } |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
160 |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
161 SparseMatrix::SparseMatrix (const PermMatrix& a) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
162 : 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
|
163 { |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
164 octave_idx_type n = a.rows (); |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
165 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
|
166 cidx (i) = i; |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
167 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
|
168 |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
169 if (a.is_row_perm ()) |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
170 { |
|
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 ridx (i) = pv (i); |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
173 } |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
174 else |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
175 { |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
176 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
|
177 ridx (pv (i)) = i; |
|
6e9f26506804
optimize diag -> sparse and perm -> sparse conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8377
diff
changeset
|
178 } |
|
8366
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
179 } |
|
8b1a2555c4e2
implement diagonal matrix objects
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
180 |
| 5164 | 181 bool |
| 182 SparseMatrix::operator == (const SparseMatrix& a) const | |
| 183 { | |
| 5275 | 184 octave_idx_type nr = rows (); |
| 185 octave_idx_type nc = cols (); | |
| 5681 | 186 octave_idx_type nz = nnz (); |
| 5275 | 187 octave_idx_type nr_a = a.rows (); |
| 188 octave_idx_type nc_a = a.cols (); | |
| 5681 | 189 octave_idx_type nz_a = a.nnz (); |
| 5164 | 190 |
| 191 if (nr != nr_a || nc != nc_a || nz != nz_a) | |
| 192 return false; | |
| 193 | |
| 5275 | 194 for (octave_idx_type i = 0; i < nc + 1; i++) |
| 5164 | 195 if (cidx(i) != a.cidx(i)) |
| 196 return false; | |
| 197 | |
| 5275 | 198 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 199 if (data(i) != a.data(i) || ridx(i) != a.ridx(i)) |
| 200 return false; | |
| 201 | |
| 202 return true; | |
| 203 } | |
| 204 | |
| 205 bool | |
| 206 SparseMatrix::operator != (const SparseMatrix& a) const | |
| 207 { | |
| 208 return !(*this == a); | |
| 209 } | |
| 210 | |
| 211 bool | |
| 212 SparseMatrix::is_symmetric (void) const | |
| 213 { | |
| 6207 | 214 octave_idx_type nr = rows (); |
| 215 octave_idx_type nc = cols (); | |
| 216 | |
| 217 if (nr == nc && nr > 0) | |
| 5164 | 218 { |
| 6207 | 219 for (octave_idx_type j = 0; j < nc; j++) |
| 220 { | |
| 221 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 222 { | |
| 223 octave_idx_type ri = ridx(i); | |
| 224 | |
| 225 if (ri != j) | |
| 226 { | |
| 227 bool found = false; | |
| 228 | |
| 229 for (octave_idx_type k = cidx(ri); k < cidx(ri+1); k++) | |
| 230 { | |
| 231 if (ridx(k) == j) | |
| 232 { | |
| 233 if (data(i) == data(k)) | |
| 234 found = true; | |
| 235 break; | |
| 236 } | |
| 237 } | |
| 238 | |
| 239 if (! found) | |
| 240 return false; | |
| 241 } | |
| 242 } | |
| 243 } | |
| 5164 | 244 |
| 245 return true; | |
| 246 } | |
| 247 | |
| 248 return false; | |
| 249 } | |
| 250 | |
| 251 SparseMatrix& | |
| 5275 | 252 SparseMatrix::insert (const SparseMatrix& a, octave_idx_type r, octave_idx_type c) |
| 5164 | 253 { |
| 254 MSparse<double>::insert (a, r, c); | |
| 255 return *this; | |
| 256 } | |
| 257 | |
| 6823 | 258 SparseMatrix& |
| 259 SparseMatrix::insert (const SparseMatrix& a, const Array<octave_idx_type>& indx) | |
| 260 { | |
| 261 MSparse<double>::insert (a, indx); | |
| 262 return *this; | |
| 263 } | |
| 264 | |
| 5164 | 265 SparseMatrix |
| 266 SparseMatrix::max (int dim) const | |
| 267 { | |
| 5275 | 268 Array2<octave_idx_type> dummy_idx; |
| 5164 | 269 return max (dummy_idx, dim); |
| 270 } | |
| 271 | |
| 272 SparseMatrix | |
| 5275 | 273 SparseMatrix::max (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 274 { |
| 275 SparseMatrix result; | |
| 276 dim_vector dv = dims (); | |
| 277 | |
| 278 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 279 return result; | |
| 280 | |
| 5275 | 281 octave_idx_type nr = dv(0); |
| 282 octave_idx_type nc = dv(1); | |
| 5164 | 283 |
| 284 if (dim == 0) | |
| 285 { | |
| 286 idx_arg.resize (1, nc); | |
| 5275 | 287 octave_idx_type nel = 0; |
| 288 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 289 { |
| 290 double tmp_max = octave_NaN; | |
| 5275 | 291 octave_idx_type idx_j = 0; |
| 292 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 293 { |
| 294 if (ridx(i) != idx_j) | |
| 295 break; | |
| 296 else | |
| 297 idx_j++; | |
| 298 } | |
| 299 | |
| 300 if (idx_j != nr) | |
| 301 tmp_max = 0.; | |
| 302 | |
| 5275 | 303 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 304 { |
| 305 double tmp = data (i); | |
| 306 | |
| 5389 | 307 if (xisnan (tmp)) |
| 5164 | 308 continue; |
| 5389 | 309 else if (xisnan (tmp_max) || tmp > tmp_max) |
| 5164 | 310 { |
| 311 idx_j = ridx (i); | |
| 312 tmp_max = tmp; | |
| 313 } | |
| 314 | |
| 315 } | |
| 316 | |
| 5389 | 317 idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; |
| 5164 | 318 if (tmp_max != 0.) |
| 319 nel++; | |
| 320 } | |
| 321 | |
| 322 result = SparseMatrix (1, nc, nel); | |
| 323 | |
| 5275 | 324 octave_idx_type ii = 0; |
| 5164 | 325 result.xcidx (0) = 0; |
| 5275 | 326 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 327 { |
| 328 double tmp = elem (idx_arg(j), j); | |
| 329 if (tmp != 0.) | |
| 330 { | |
| 331 result.xdata (ii) = tmp; | |
| 332 result.xridx (ii++) = 0; | |
| 333 } | |
| 334 result.xcidx (j+1) = ii; | |
| 335 | |
| 336 } | |
| 337 } | |
| 338 else | |
| 339 { | |
| 340 idx_arg.resize (nr, 1, 0); | |
| 341 | |
| 5275 | 342 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 343 idx_arg.elem(ridx(i)) = -1; |
| 344 | |
| 5275 | 345 for (octave_idx_type j = 0; j < nc; j++) |
| 346 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 347 { |
| 348 if (idx_arg.elem(i) != -1) | |
| 349 continue; | |
| 350 bool found = false; | |
| 5275 | 351 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 352 if (ridx(k) == i) |
| 353 { | |
| 354 found = true; | |
| 355 break; | |
| 356 } | |
| 357 | |
| 358 if (!found) | |
| 359 idx_arg.elem(i) = j; | |
| 360 | |
| 361 } | |
| 362 | |
| 5275 | 363 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 364 { |
| 5275 | 365 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 366 { |
| 5275 | 367 octave_idx_type ir = ridx (i); |
| 368 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 369 double tmp = data (i); |
| 370 | |
| 5389 | 371 if (xisnan (tmp)) |
| 5164 | 372 continue; |
| 373 else if (ix == -1 || tmp > elem (ir, ix)) | |
| 374 idx_arg.elem (ir) = j; | |
| 375 } | |
| 376 } | |
| 377 | |
| 5275 | 378 octave_idx_type nel = 0; |
| 379 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 380 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 381 nel++; | |
| 382 | |
| 383 result = SparseMatrix (nr, 1, nel); | |
| 384 | |
| 5275 | 385 octave_idx_type ii = 0; |
| 5164 | 386 result.xcidx (0) = 0; |
| 387 result.xcidx (1) = nel; | |
| 5275 | 388 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 389 { |
| 390 if (idx_arg(j) == -1) | |
| 391 { | |
| 392 idx_arg(j) = 0; | |
| 393 result.xdata (ii) = octave_NaN; | |
| 394 result.xridx (ii++) = j; | |
| 395 } | |
| 396 else | |
| 397 { | |
| 398 double tmp = elem (j, idx_arg(j)); | |
| 399 if (tmp != 0.) | |
| 400 { | |
| 401 result.xdata (ii) = tmp; | |
| 402 result.xridx (ii++) = j; | |
| 403 } | |
| 404 } | |
| 405 } | |
| 406 } | |
| 407 | |
| 408 return result; | |
| 409 } | |
| 410 | |
| 411 SparseMatrix | |
| 412 SparseMatrix::min (int dim) const | |
| 413 { | |
| 5275 | 414 Array2<octave_idx_type> dummy_idx; |
| 5164 | 415 return min (dummy_idx, dim); |
| 416 } | |
| 417 | |
| 418 SparseMatrix | |
| 5275 | 419 SparseMatrix::min (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 420 { |
| 421 SparseMatrix result; | |
| 422 dim_vector dv = dims (); | |
| 423 | |
| 424 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 425 return result; | |
| 426 | |
| 5275 | 427 octave_idx_type nr = dv(0); |
| 428 octave_idx_type nc = dv(1); | |
| 5164 | 429 |
| 430 if (dim == 0) | |
| 431 { | |
| 432 idx_arg.resize (1, nc); | |
| 5275 | 433 octave_idx_type nel = 0; |
| 434 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 435 { |
| 436 double tmp_min = octave_NaN; | |
| 5275 | 437 octave_idx_type idx_j = 0; |
| 438 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 439 { |
| 440 if (ridx(i) != idx_j) | |
| 441 break; | |
| 442 else | |
| 443 idx_j++; | |
| 444 } | |
| 445 | |
| 446 if (idx_j != nr) | |
| 447 tmp_min = 0.; | |
| 448 | |
| 5275 | 449 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 450 { |
| 451 double tmp = data (i); | |
| 452 | |
| 5389 | 453 if (xisnan (tmp)) |
| 5164 | 454 continue; |
| 5389 | 455 else if (xisnan (tmp_min) || tmp < tmp_min) |
| 5164 | 456 { |
| 457 idx_j = ridx (i); | |
| 458 tmp_min = tmp; | |
| 459 } | |
| 460 | |
| 461 } | |
| 462 | |
| 5389 | 463 idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; |
| 5164 | 464 if (tmp_min != 0.) |
| 465 nel++; | |
| 466 } | |
| 467 | |
| 468 result = SparseMatrix (1, nc, nel); | |
| 469 | |
| 5275 | 470 octave_idx_type ii = 0; |
| 5164 | 471 result.xcidx (0) = 0; |
| 5275 | 472 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 473 { |
| 474 double tmp = elem (idx_arg(j), j); | |
| 475 if (tmp != 0.) | |
| 476 { | |
| 477 result.xdata (ii) = tmp; | |
| 478 result.xridx (ii++) = 0; | |
| 479 } | |
| 480 result.xcidx (j+1) = ii; | |
| 481 | |
| 482 } | |
| 483 } | |
| 484 else | |
| 485 { | |
| 486 idx_arg.resize (nr, 1, 0); | |
| 487 | |
| 5275 | 488 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 489 idx_arg.elem(ridx(i)) = -1; |
| 490 | |
| 5275 | 491 for (octave_idx_type j = 0; j < nc; j++) |
| 492 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 493 { |
| 494 if (idx_arg.elem(i) != -1) | |
| 495 continue; | |
| 496 bool found = false; | |
| 5275 | 497 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 498 if (ridx(k) == i) |
| 499 { | |
| 500 found = true; | |
| 501 break; | |
| 502 } | |
| 503 | |
| 504 if (!found) | |
| 505 idx_arg.elem(i) = j; | |
| 506 | |
| 507 } | |
| 508 | |
| 5275 | 509 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 510 { |
| 5275 | 511 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 512 { |
| 5275 | 513 octave_idx_type ir = ridx (i); |
| 514 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 515 double tmp = data (i); |
| 516 | |
| 5389 | 517 if (xisnan (tmp)) |
| 5164 | 518 continue; |
| 519 else if (ix == -1 || tmp < elem (ir, ix)) | |
| 520 idx_arg.elem (ir) = j; | |
| 521 } | |
| 522 } | |
| 523 | |
| 5275 | 524 octave_idx_type nel = 0; |
| 525 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 526 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 527 nel++; | |
| 528 | |
| 529 result = SparseMatrix (nr, 1, nel); | |
| 530 | |
| 5275 | 531 octave_idx_type ii = 0; |
| 5164 | 532 result.xcidx (0) = 0; |
| 533 result.xcidx (1) = nel; | |
| 5275 | 534 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 535 { |
| 536 if (idx_arg(j) == -1) | |
| 537 { | |
| 538 idx_arg(j) = 0; | |
| 539 result.xdata (ii) = octave_NaN; | |
| 540 result.xridx (ii++) = j; | |
| 541 } | |
| 542 else | |
| 543 { | |
| 544 double tmp = elem (j, idx_arg(j)); | |
| 545 if (tmp != 0.) | |
| 546 { | |
| 547 result.xdata (ii) = tmp; | |
| 548 result.xridx (ii++) = j; | |
| 549 } | |
| 550 } | |
| 551 } | |
| 552 } | |
| 553 | |
| 554 return result; | |
| 555 } | |
| 556 | |
|
8303
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
557 RowVector |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
558 SparseMatrix::row (octave_idx_type i) const |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
559 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
560 octave_idx_type nc = columns (); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
561 RowVector retval (nc, 0); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
562 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
563 for (octave_idx_type j = 0; j < nc; j++) |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
564 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
|
565 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
566 if (ridx (k) == i) |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
567 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
568 retval(j) = data (k); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
569 break; |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
570 } |
|
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 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
573 return retval; |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
574 } |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
575 |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
576 ColumnVector |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
577 SparseMatrix::column (octave_idx_type i) const |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
578 { |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
579 octave_idx_type nr = rows (); |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
580 ColumnVector retval (nr); |
|
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 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
|
583 retval(ridx (k)) = data (k); |
|
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 return retval; |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
586 } |
|
b11c31849b44
improve norm computation capabilities
Jaroslav Hajek <highegg@gmail.com>
parents:
7922
diff
changeset
|
587 |
| 5164 | 588 SparseMatrix |
| 5275 | 589 SparseMatrix::concat (const SparseMatrix& rb, const Array<octave_idx_type>& ra_idx) |
| 5164 | 590 { |
| 591 // Don't use numel to avoid all possiblity of an overflow | |
| 592 if (rb.rows () > 0 && rb.cols () > 0) | |
| 593 insert (rb, ra_idx(0), ra_idx(1)); | |
| 594 return *this; | |
| 595 } | |
| 596 | |
| 597 SparseComplexMatrix | |
| 5275 | 598 SparseMatrix::concat (const SparseComplexMatrix& rb, const Array<octave_idx_type>& ra_idx) |
| 5164 | 599 { |
| 600 SparseComplexMatrix retval (*this); | |
| 601 if (rb.rows () > 0 && rb.cols () > 0) | |
| 602 retval.insert (rb, ra_idx(0), ra_idx(1)); | |
| 603 return retval; | |
| 604 } | |
| 605 | |
| 606 SparseMatrix | |
| 607 real (const SparseComplexMatrix& a) | |
| 608 { | |
| 5275 | 609 octave_idx_type nr = a.rows (); |
| 610 octave_idx_type nc = a.cols (); | |
| 5681 | 611 octave_idx_type nz = a.nnz (); |
| 5164 | 612 SparseMatrix r (nr, nc, nz); |
| 613 | |
| 5275 | 614 for (octave_idx_type i = 0; i < nc +1; i++) |
| 5164 | 615 r.cidx(i) = a.cidx(i); |
| 616 | |
| 5275 | 617 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 618 { |
| 5261 | 619 r.data(i) = std::real (a.data(i)); |
| 5164 | 620 r.ridx(i) = a.ridx(i); |
| 621 } | |
| 622 | |
| 623 return r; | |
| 624 } | |
| 625 | |
| 626 SparseMatrix | |
| 627 imag (const SparseComplexMatrix& a) | |
| 628 { | |
| 5275 | 629 octave_idx_type nr = a.rows (); |
| 630 octave_idx_type nc = a.cols (); | |
| 5681 | 631 octave_idx_type nz = a.nnz (); |
| 5164 | 632 SparseMatrix r (nr, nc, nz); |
| 633 | |
| 5275 | 634 for (octave_idx_type i = 0; i < nc +1; i++) |
| 5164 | 635 r.cidx(i) = a.cidx(i); |
| 636 | |
| 5275 | 637 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 638 { |
| 5261 | 639 r.data(i) = std::imag (a.data(i)); |
| 5164 | 640 r.ridx(i) = a.ridx(i); |
| 641 } | |
| 642 | |
| 643 return r; | |
| 644 } | |
| 645 | |
| 646 SparseMatrix | |
| 647 atan2 (const double& x, const SparseMatrix& y) | |
| 648 { | |
| 5275 | 649 octave_idx_type nr = y.rows (); |
| 650 octave_idx_type nc = y.cols (); | |
| 5164 | 651 |
| 652 if (x == 0.) | |
| 653 return SparseMatrix (nr, nc); | |
| 654 else | |
| 655 { | |
| 656 // Its going to be basically full, so this is probably the | |
| 657 // best way to handle it. | |
| 658 Matrix tmp (nr, nc, atan2 (x, 0.)); | |
| 659 | |
| 5275 | 660 for (octave_idx_type j = 0; j < nc; j++) |
| 661 for (octave_idx_type i = y.cidx (j); i < y.cidx (j+1); i++) | |
| 5164 | 662 tmp.elem (y.ridx(i), j) = atan2 (x, y.data(i)); |
| 663 | |
| 664 return SparseMatrix (tmp); | |
| 665 } | |
| 666 } | |
| 667 | |
| 668 SparseMatrix | |
| 669 atan2 (const SparseMatrix& x, const double& y) | |
| 670 { | |
| 5275 | 671 octave_idx_type nr = x.rows (); |
| 672 octave_idx_type nc = x.cols (); | |
| 5681 | 673 octave_idx_type nz = x.nnz (); |
| 5164 | 674 |
| 675 SparseMatrix retval (nr, nc, nz); | |
| 676 | |
| 5275 | 677 octave_idx_type ii = 0; |
| 5164 | 678 retval.xcidx(0) = 0; |
| 5275 | 679 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 680 { |
| 5275 | 681 for (octave_idx_type j = x.cidx(i); j < x.cidx(i+1); j++) |
| 5164 | 682 { |
| 683 double tmp = atan2 (x.data(j), y); | |
| 684 if (tmp != 0.) | |
| 685 { | |
| 686 retval.xdata (ii) = tmp; | |
| 687 retval.xridx (ii++) = x.ridx (j); | |
| 688 } | |
| 689 } | |
| 690 retval.xcidx (i+1) = ii; | |
| 691 } | |
| 692 | |
| 693 if (ii != nz) | |
| 694 { | |
| 695 SparseMatrix retval2 (nr, nc, ii); | |
| 5275 | 696 for (octave_idx_type i = 0; i < nc+1; i++) |
| 5164 | 697 retval2.xcidx (i) = retval.cidx (i); |
| 5275 | 698 for (octave_idx_type i = 0; i < ii; i++) |
| 5164 | 699 { |
| 700 retval2.xdata (i) = retval.data (i); | |
| 701 retval2.xridx (i) = retval.ridx (i); | |
| 702 } | |
| 703 return retval2; | |
| 704 } | |
| 705 else | |
| 706 return retval; | |
| 707 } | |
| 708 | |
| 709 SparseMatrix | |
| 710 atan2 (const SparseMatrix& x, const SparseMatrix& y) | |
| 711 { | |
| 712 SparseMatrix r; | |
| 713 | |
| 714 if ((x.rows() == y.rows()) && (x.cols() == y.cols())) | |
| 715 { | |
| 5275 | 716 octave_idx_type x_nr = x.rows (); |
| 717 octave_idx_type x_nc = x.cols (); | |
| 718 | |
| 719 octave_idx_type y_nr = y.rows (); | |
| 720 octave_idx_type y_nc = y.cols (); | |
| 5164 | 721 |
| 722 if (x_nr != y_nr || x_nc != y_nc) | |
| 723 gripe_nonconformant ("atan2", x_nr, x_nc, y_nr, y_nc); | |
| 724 else | |
| 725 { | |
| 5681 | 726 r = SparseMatrix (x_nr, x_nc, (x.nnz () + y.nnz ())); |
| 5164 | 727 |
| 5275 | 728 octave_idx_type jx = 0; |
| 5164 | 729 r.cidx (0) = 0; |
| 5275 | 730 for (octave_idx_type i = 0 ; i < x_nc ; i++) |
| 5164 | 731 { |
| 5275 | 732 octave_idx_type ja = x.cidx(i); |
| 733 octave_idx_type ja_max = x.cidx(i+1); | |
| 5164 | 734 bool ja_lt_max= ja < ja_max; |
| 735 | |
| 5275 | 736 octave_idx_type jb = y.cidx(i); |
| 737 octave_idx_type jb_max = y.cidx(i+1); | |
| 5164 | 738 bool jb_lt_max = jb < jb_max; |
| 739 | |
| 740 while (ja_lt_max || jb_lt_max ) | |
| 741 { | |
| 742 OCTAVE_QUIT; | |
| 743 if ((! jb_lt_max) || | |
| 744 (ja_lt_max && (x.ridx(ja) < y.ridx(jb)))) | |
| 745 { | |
| 746 r.ridx(jx) = x.ridx(ja); | |
| 747 r.data(jx) = atan2 (x.data(ja), 0.); | |
| 748 jx++; | |
| 749 ja++; | |
| 750 ja_lt_max= ja < ja_max; | |
| 751 } | |
| 752 else if (( !ja_lt_max ) || | |
| 753 (jb_lt_max && (y.ridx(jb) < x.ridx(ja)) ) ) | |
| 754 { | |
| 755 jb++; | |
| 756 jb_lt_max= jb < jb_max; | |
| 757 } | |
| 758 else | |
| 759 { | |
| 760 double tmp = atan2 (x.data(ja), y.data(jb)); | |
| 761 if (tmp != 0.) | |
| 762 { | |
| 763 r.data(jx) = tmp; | |
| 764 r.ridx(jx) = x.ridx(ja); | |
| 765 jx++; | |
| 766 } | |
| 767 ja++; | |
| 768 ja_lt_max= ja < ja_max; | |
| 769 jb++; | |
| 770 jb_lt_max= jb < jb_max; | |
| 771 } | |
| 772 } | |
| 773 r.cidx(i+1) = jx; | |
| 774 } | |
| 775 | |
| 776 r.maybe_compress (); | |
| 777 } | |
| 778 } | |
| 779 else | |
| 780 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 781 | |
| 782 return r; | |
| 783 } | |
| 784 | |
| 785 SparseMatrix | |
| 786 SparseMatrix::inverse (void) const | |
| 787 { | |
| 5275 | 788 octave_idx_type info; |
| 5164 | 789 double rcond; |
| 5785 | 790 MatrixType mattype (*this); |
| 5506 | 791 return inverse (mattype, info, rcond, 0, 0); |
| 792 } | |
| 793 | |
| 794 SparseMatrix | |
| 5785 | 795 SparseMatrix::inverse (MatrixType& mattype) const |
| 5506 | 796 { |
| 797 octave_idx_type info; | |
| 798 double rcond; | |
| 799 return inverse (mattype, info, rcond, 0, 0); | |
| 5164 | 800 } |
| 801 | |
| 802 SparseMatrix | |
| 5785 | 803 SparseMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const |
| 5164 | 804 { |
| 805 double rcond; | |
| 5506 | 806 return inverse (mattype, info, rcond, 0, 0); |
| 807 } | |
| 808 | |
| 809 SparseMatrix | |
| 5785 | 810 SparseMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 811 double& rcond, const bool, |
| 5506 | 812 const bool calccond) const |
| 813 { | |
| 814 SparseMatrix retval; | |
| 815 | |
| 816 octave_idx_type nr = rows (); | |
| 817 octave_idx_type nc = cols (); | |
| 818 info = 0; | |
| 819 | |
| 820 if (nr == 0 || nc == 0 || nr != nc) | |
| 821 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 822 else | |
| 823 { | |
| 824 // Print spparms("spumoni") info if requested | |
| 825 int typ = mattyp.type (); | |
| 826 mattyp.info (); | |
| 827 | |
| 5785 | 828 if (typ == MatrixType::Diagonal || |
| 829 typ == MatrixType::Permuted_Diagonal) | |
| 5506 | 830 { |
| 5785 | 831 if (typ == MatrixType::Permuted_Diagonal) |
| 5506 | 832 retval = transpose(); |
| 833 else | |
| 834 retval = *this; | |
| 835 | |
| 836 // Force make_unique to be called | |
| 837 double *v = retval.data(); | |
| 838 | |
| 839 if (calccond) | |
| 840 { | |
| 841 double dmax = 0., dmin = octave_Inf; | |
| 842 for (octave_idx_type i = 0; i < nr; i++) | |
| 843 { | |
| 844 double tmp = fabs(v[i]); | |
| 845 if (tmp > dmax) | |
| 846 dmax = tmp; | |
| 847 if (tmp < dmin) | |
| 848 dmin = tmp; | |
| 849 } | |
| 850 rcond = dmin / dmax; | |
| 851 } | |
| 852 | |
| 853 for (octave_idx_type i = 0; i < nr; i++) | |
| 854 v[i] = 1.0 / v[i]; | |
| 855 } | |
| 856 else | |
| 857 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 858 } | |
| 859 | |
| 860 return retval; | |
| 861 } | |
| 862 | |
| 863 SparseMatrix | |
| 5785 | 864 SparseMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 865 double& rcond, const bool, |
| 5506 | 866 const bool calccond) const |
| 867 { | |
| 868 SparseMatrix retval; | |
| 869 | |
| 870 octave_idx_type nr = rows (); | |
| 871 octave_idx_type nc = cols (); | |
| 872 info = 0; | |
| 873 | |
| 874 if (nr == 0 || nc == 0 || nr != nc) | |
| 875 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 876 else | |
| 877 { | |
| 878 // Print spparms("spumoni") info if requested | |
| 879 int typ = mattyp.type (); | |
| 880 mattyp.info (); | |
| 881 | |
| 5785 | 882 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper || |
| 883 typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) | |
| 5506 | 884 { |
| 885 double anorm = 0.; | |
| 886 double ainvnorm = 0.; | |
| 887 | |
| 888 if (calccond) | |
| 889 { | |
| 890 // Calculate the 1-norm of matrix for rcond calculation | |
| 891 for (octave_idx_type j = 0; j < nr; j++) | |
| 892 { | |
| 893 double atmp = 0.; | |
| 894 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 895 atmp += fabs(data(i)); | |
| 896 if (atmp > anorm) | |
| 897 anorm = atmp; | |
| 898 } | |
| 899 } | |
| 900 | |
| 5785 | 901 if (typ == MatrixType::Upper || typ == MatrixType::Lower) |
| 5506 | 902 { |
| 5681 | 903 octave_idx_type nz = nnz (); |
| 5506 | 904 octave_idx_type cx = 0; |
| 905 octave_idx_type nz2 = nz; | |
| 906 retval = SparseMatrix (nr, nc, nz2); | |
| 907 | |
| 908 for (octave_idx_type i = 0; i < nr; i++) | |
| 909 { | |
| 910 OCTAVE_QUIT; | |
| 911 // place the 1 in the identity position | |
| 912 octave_idx_type cx_colstart = cx; | |
| 913 | |
| 914 if (cx == nz2) | |
| 915 { | |
| 916 nz2 *= 2; | |
| 917 retval.change_capacity (nz2); | |
| 918 } | |
| 919 | |
| 920 retval.xcidx(i) = cx; | |
| 921 retval.xridx(cx) = i; | |
| 922 retval.xdata(cx) = 1.0; | |
| 923 cx++; | |
| 924 | |
| 925 // iterate accross columns of input matrix | |
| 926 for (octave_idx_type j = i+1; j < nr; j++) | |
| 927 { | |
| 928 double v = 0.; | |
| 929 // iterate to calculate sum | |
| 930 octave_idx_type colXp = retval.xcidx(i); | |
| 931 octave_idx_type colUp = cidx(j); | |
| 932 octave_idx_type rpX, rpU; | |
| 5876 | 933 |
| 934 if (cidx(j) == cidx(j+1)) | |
| 935 { | |
| 936 (*current_liboctave_error_handler) | |
| 937 ("division by zero"); | |
| 938 goto inverse_singular; | |
| 939 } | |
| 940 | |
| 5506 | 941 do |
| 942 { | |
| 943 OCTAVE_QUIT; | |
| 944 rpX = retval.xridx(colXp); | |
| 945 rpU = ridx(colUp); | |
| 946 | |
| 947 if (rpX < rpU) | |
| 948 colXp++; | |
| 949 else if (rpX > rpU) | |
| 950 colUp++; | |
| 951 else | |
| 952 { | |
| 953 v -= retval.xdata(colXp) * data(colUp); | |
| 954 colXp++; | |
| 955 colUp++; | |
| 956 } | |
| 957 } while ((rpX<j) && (rpU<j) && | |
| 958 (colXp<cx) && (colUp<nz)); | |
| 959 | |
| 960 // get A(m,m) | |
| 5876 | 961 if (typ == MatrixType::Upper) |
| 962 colUp = cidx(j+1) - 1; | |
| 963 else | |
| 5877 | 964 colUp = cidx(j); |
| 5506 | 965 double pivot = data(colUp); |
| 5877 | 966 if (pivot == 0. || ridx(colUp) != j) |
| 5876 | 967 { |
| 968 (*current_liboctave_error_handler) | |
| 969 ("division by zero"); | |
| 970 goto inverse_singular; | |
| 971 } | |
| 5506 | 972 |
| 973 if (v != 0.) | |
| 974 { | |
| 975 if (cx == nz2) | |
| 976 { | |
| 977 nz2 *= 2; | |
| 978 retval.change_capacity (nz2); | |
| 979 } | |
| 980 | |
| 981 retval.xridx(cx) = j; | |
| 982 retval.xdata(cx) = v / pivot; | |
| 983 cx++; | |
| 984 } | |
| 985 } | |
| 986 | |
| 987 // get A(m,m) | |
| 5876 | 988 octave_idx_type colUp; |
| 989 if (typ == MatrixType::Upper) | |
| 990 colUp = cidx(i+1) - 1; | |
| 991 else | |
| 5877 | 992 colUp = cidx(i); |
| 5506 | 993 double pivot = data(colUp); |
| 5877 | 994 if (pivot == 0. || ridx(colUp) != i) |
| 5876 | 995 { |
| 996 (*current_liboctave_error_handler) ("division by zero"); | |
| 997 goto inverse_singular; | |
| 998 } | |
| 5506 | 999 |
| 1000 if (pivot != 1.0) | |
| 1001 for (octave_idx_type j = cx_colstart; j < cx; j++) | |
| 1002 retval.xdata(j) /= pivot; | |
| 1003 } | |
| 1004 retval.xcidx(nr) = cx; | |
| 1005 retval.maybe_compress (); | |
| 1006 } | |
| 1007 else | |
| 1008 { | |
| 5681 | 1009 octave_idx_type nz = nnz (); |
| 5506 | 1010 octave_idx_type cx = 0; |
| 1011 octave_idx_type nz2 = nz; | |
| 1012 retval = SparseMatrix (nr, nc, nz2); | |
| 1013 | |
| 1014 OCTAVE_LOCAL_BUFFER (double, work, nr); | |
| 1015 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); | |
| 1016 | |
| 1017 octave_idx_type *perm = mattyp.triangular_perm(); | |
| 5785 | 1018 if (typ == MatrixType::Permuted_Upper) |
| 5506 | 1019 { |
| 1020 for (octave_idx_type i = 0; i < nr; i++) | |
| 1021 rperm[perm[i]] = i; | |
| 1022 } | |
| 1023 else | |
| 1024 { | |
| 1025 for (octave_idx_type i = 0; i < nr; i++) | |
| 1026 rperm[i] = perm[i]; | |
| 1027 for (octave_idx_type i = 0; i < nr; i++) | |
| 1028 perm[rperm[i]] = i; | |
| 1029 } | |
| 1030 | |
| 1031 for (octave_idx_type i = 0; i < nr; i++) | |
| 1032 { | |
| 1033 OCTAVE_QUIT; | |
| 1034 octave_idx_type iidx = rperm[i]; | |
| 1035 | |
| 1036 for (octave_idx_type j = 0; j < nr; j++) | |
| 1037 work[j] = 0.; | |
| 1038 | |
| 1039 // place the 1 in the identity position | |
| 1040 work[iidx] = 1.0; | |
| 1041 | |
| 1042 // iterate accross columns of input matrix | |
| 1043 for (octave_idx_type j = iidx+1; j < nr; j++) | |
| 1044 { | |
| 1045 double v = 0.; | |
| 1046 octave_idx_type jidx = perm[j]; | |
| 1047 // iterate to calculate sum | |
| 1048 for (octave_idx_type k = cidx(jidx); | |
| 1049 k < cidx(jidx+1); k++) | |
| 1050 { | |
| 1051 OCTAVE_QUIT; | |
| 1052 v -= work[ridx(k)] * data(k); | |
| 1053 } | |
| 1054 | |
| 1055 // get A(m,m) | |
| 5876 | 1056 double pivot; |
| 1057 if (typ == MatrixType::Permuted_Upper) | |
| 1058 pivot = data(cidx(jidx+1) - 1); | |
| 1059 else | |
| 5877 | 1060 pivot = data(cidx(jidx)); |
| 5506 | 1061 if (pivot == 0.) |
| 5876 | 1062 { |
| 1063 (*current_liboctave_error_handler) | |
| 1064 ("division by zero"); | |
| 1065 goto inverse_singular; | |
| 1066 } | |
| 5506 | 1067 |
| 1068 work[j] = v / pivot; | |
| 1069 } | |
| 1070 | |
| 1071 // get A(m,m) | |
| 5876 | 1072 octave_idx_type colUp; |
| 1073 if (typ == MatrixType::Permuted_Upper) | |
| 1074 colUp = cidx(perm[iidx]+1) - 1; | |
| 1075 else | |
| 5877 | 1076 colUp = cidx(perm[iidx]); |
| 5876 | 1077 |
| 5506 | 1078 double pivot = data(colUp); |
| 5876 | 1079 if (pivot == 0.) |
| 1080 { | |
| 1081 (*current_liboctave_error_handler) | |
| 1082 ("division by zero"); | |
| 1083 goto inverse_singular; | |
| 1084 } | |
| 5506 | 1085 |
| 1086 octave_idx_type new_cx = cx; | |
| 1087 for (octave_idx_type j = iidx; j < nr; j++) | |
| 1088 if (work[j] != 0.0) | |
| 1089 { | |
| 1090 new_cx++; | |
| 1091 if (pivot != 1.0) | |
| 1092 work[j] /= pivot; | |
| 1093 } | |
| 1094 | |
| 1095 if (cx < new_cx) | |
| 1096 { | |
| 1097 nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2); | |
| 1098 retval.change_capacity (nz2); | |
| 1099 } | |
| 1100 | |
| 1101 retval.xcidx(i) = cx; | |
| 1102 for (octave_idx_type j = iidx; j < nr; j++) | |
| 1103 if (work[j] != 0.) | |
| 1104 { | |
| 1105 retval.xridx(cx) = j; | |
| 1106 retval.xdata(cx++) = work[j]; | |
| 1107 } | |
| 1108 } | |
| 1109 | |
| 1110 retval.xcidx(nr) = cx; | |
| 1111 retval.maybe_compress (); | |
| 1112 } | |
| 1113 | |
| 1114 if (calccond) | |
| 1115 { | |
| 1116 // Calculate the 1-norm of inverse matrix for rcond calculation | |
| 1117 for (octave_idx_type j = 0; j < nr; j++) | |
| 1118 { | |
| 1119 double atmp = 0.; | |
| 1120 for (octave_idx_type i = retval.cidx(j); | |
| 1121 i < retval.cidx(j+1); i++) | |
| 1122 atmp += fabs(retval.data(i)); | |
| 1123 if (atmp > ainvnorm) | |
| 1124 ainvnorm = atmp; | |
| 1125 } | |
| 1126 | |
| 1127 rcond = 1. / ainvnorm / anorm; | |
| 1128 } | |
| 1129 } | |
| 1130 else | |
| 1131 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1132 } | |
| 1133 | |
| 1134 return retval; | |
| 5876 | 1135 |
| 1136 inverse_singular: | |
| 1137 return SparseMatrix(); | |
| 5164 | 1138 } |
| 1139 | |
| 1140 SparseMatrix | |
| 5785 | 1141 SparseMatrix::inverse (MatrixType &mattype, octave_idx_type& info, |
| 5610 | 1142 double& rcond, int, int calc_cond) const |
| 5506 | 1143 { |
| 1144 int typ = mattype.type (false); | |
| 1145 SparseMatrix ret; | |
| 1146 | |
| 5785 | 1147 if (typ == MatrixType::Unknown) |
| 5506 | 1148 typ = mattype.type (*this); |
| 1149 | |
| 5785 | 1150 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5506 | 1151 ret = dinverse (mattype, info, rcond, true, calc_cond); |
| 5785 | 1152 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5506 | 1153 ret = tinverse (mattype, info, rcond, true, calc_cond).transpose(); |
| 5785 | 1154 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 6185 | 1155 { |
| 1156 MatrixType newtype = mattype.transpose(); | |
| 1157 ret = transpose().tinverse (newtype, info, rcond, true, calc_cond); | |
| 1158 } | |
| 6840 | 1159 else |
| 5506 | 1160 { |
| 1161 if (mattype.is_hermitian()) | |
| 1162 { | |
| 5785 | 1163 MatrixType tmp_typ (MatrixType::Upper); |
| 5506 | 1164 SparseCHOL fact (*this, info, false); |
| 1165 rcond = fact.rcond(); | |
| 1166 if (info == 0) | |
| 1167 { | |
| 1168 double rcond2; | |
| 1169 SparseMatrix Q = fact.Q(); | |
| 1170 SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, | |
| 1171 info, rcond2, true, false); | |
| 1172 ret = Q * InvL.transpose() * InvL * Q.transpose(); | |
| 1173 } | |
| 1174 else | |
| 1175 { | |
| 1176 // Matrix is either singular or not positive definite | |
| 1177 mattype.mark_as_unsymmetric (); | |
| 5785 | 1178 typ = MatrixType::Full; |
| 5506 | 1179 } |
| 1180 } | |
| 1181 | |
| 1182 if (!mattype.is_hermitian()) | |
| 1183 { | |
| 1184 octave_idx_type n = rows(); | |
| 1185 ColumnVector Qinit(n); | |
| 1186 for (octave_idx_type i = 0; i < n; i++) | |
| 1187 Qinit(i) = i; | |
| 1188 | |
| 5785 | 1189 MatrixType tmp_typ (MatrixType::Upper); |
|
7515
f3c00dc0912b
Eliminate the rest of the dispatched sparse functions
David Bateman <dbateman@free.fr>
parents:
7503
diff
changeset
|
1190 SparseLU fact (*this, Qinit, Matrix(), false, false); |
| 5506 | 1191 rcond = fact.rcond(); |
| 1192 double rcond2; | |
| 1193 SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, | |
| 1194 info, rcond2, true, false); | |
| 1195 SparseMatrix InvU = fact.U().tinverse(tmp_typ, info, rcond2, | |
| 1196 true, false).transpose(); | |
| 1197 ret = fact.Pc().transpose() * InvU * InvL * fact.Pr(); | |
| 1198 } | |
| 1199 } | |
| 1200 | |
| 1201 return ret; | |
| 5164 | 1202 } |
| 1203 | |
| 1204 DET | |
| 1205 SparseMatrix::determinant (void) const | |
| 1206 { | |
| 5275 | 1207 octave_idx_type info; |
| 5164 | 1208 double rcond; |
| 1209 return determinant (info, rcond, 0); | |
| 1210 } | |
| 1211 | |
| 1212 DET | |
| 5275 | 1213 SparseMatrix::determinant (octave_idx_type& info) const |
| 5164 | 1214 { |
| 1215 double rcond; | |
| 1216 return determinant (info, rcond, 0); | |
| 1217 } | |
| 1218 | |
| 1219 DET | |
| 5275 | 1220 SparseMatrix::determinant (octave_idx_type& err, double& rcond, int) const |
| 5164 | 1221 { |
| 1222 DET retval; | |
| 1223 | |
| 5203 | 1224 #ifdef HAVE_UMFPACK |
| 5275 | 1225 octave_idx_type nr = rows (); |
| 1226 octave_idx_type nc = cols (); | |
| 5164 | 1227 |
| 1228 if (nr == 0 || nc == 0 || nr != nc) | |
| 1229 { | |
| 8335 | 1230 retval = DET (1.0); |
| 5164 | 1231 } |
| 1232 else | |
| 1233 { | |
| 1234 err = 0; | |
| 1235 | |
| 1236 // Setup the control parameters | |
| 1237 Matrix Control (UMFPACK_CONTROL, 1); | |
| 1238 double *control = Control.fortran_vec (); | |
| 5322 | 1239 UMFPACK_DNAME (defaults) (control); |
| 5164 | 1240 |
| 5893 | 1241 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 1242 if (!xisnan (tmp)) |
| 1243 Control (UMFPACK_PRL) = tmp; | |
| 1244 | |
| 5893 | 1245 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 1246 if (!xisnan (tmp)) |
| 1247 { | |
| 1248 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 1249 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 1250 } | |
| 1251 | |
| 1252 // Set whether we are allowed to modify Q or not | |
| 5893 | 1253 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 1254 if (!xisnan (tmp)) |
| 1255 Control (UMFPACK_FIXQ) = tmp; | |
| 1256 | |
| 1257 // Turn-off UMFPACK scaling for LU | |
| 1258 Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; | |
| 1259 | |
| 5322 | 1260 UMFPACK_DNAME (report_control) (control); |
| 5164 | 1261 |
| 5275 | 1262 const octave_idx_type *Ap = cidx (); |
| 1263 const octave_idx_type *Ai = ridx (); | |
| 5164 | 1264 const double *Ax = data (); |
| 1265 | |
| 5322 | 1266 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control); |
| 5164 | 1267 |
| 1268 void *Symbolic; | |
| 1269 Matrix Info (1, UMFPACK_INFO); | |
| 1270 double *info = Info.fortran_vec (); | |
| 5322 | 1271 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, |
| 7520 | 1272 Ax, 0, &Symbolic, control, info); |
| 5164 | 1273 |
| 1274 if (status < 0) | |
| 1275 { | |
| 1276 (*current_liboctave_error_handler) | |
| 1277 ("SparseMatrix::determinant symbolic factorization failed"); | |
| 1278 | |
| 5322 | 1279 UMFPACK_DNAME (report_status) (control, status); |
| 1280 UMFPACK_DNAME (report_info) (control, info); | |
| 1281 | |
| 1282 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 1283 } |
| 1284 else | |
| 1285 { | |
| 5322 | 1286 UMFPACK_DNAME (report_symbolic) (Symbolic, control); |
| 5164 | 1287 |
| 1288 void *Numeric; | |
| 5322 | 1289 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, |
| 1290 &Numeric, control, info) ; | |
| 1291 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 1292 |
| 1293 rcond = Info (UMFPACK_RCOND); | |
| 1294 | |
| 1295 if (status < 0) | |
| 1296 { | |
| 1297 (*current_liboctave_error_handler) | |
| 1298 ("SparseMatrix::determinant numeric factorization failed"); | |
| 1299 | |
| 5322 | 1300 UMFPACK_DNAME (report_status) (control, status); |
| 1301 UMFPACK_DNAME (report_info) (control, info); | |
| 1302 | |
| 1303 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 1304 } |
| 1305 else | |
| 1306 { | |
| 5322 | 1307 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 1308 |
| 8335 | 1309 double c10, e10; |
| 1310 | |
| 1311 status = UMFPACK_DNAME (get_determinant) (&c10, &e10, Numeric, info); | |
| 5164 | 1312 |
| 1313 if (status < 0) | |
| 1314 { | |
| 1315 (*current_liboctave_error_handler) | |
| 1316 ("SparseMatrix::determinant error calculating determinant"); | |
| 1317 | |
| 5322 | 1318 UMFPACK_DNAME (report_status) (control, status); |
| 1319 UMFPACK_DNAME (report_info) (control, info); | |
| 5164 | 1320 } |
| 1321 else | |
| 8335 | 1322 retval = DET (c10, e10, 10); |
| 5346 | 1323 |
| 1324 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 1325 } |
| 1326 } | |
| 1327 } | |
| 5203 | 1328 #else |
| 1329 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 1330 #endif | |
| 5164 | 1331 |
| 1332 return retval; | |
| 1333 } | |
| 1334 | |
| 1335 Matrix | |
| 5785 | 1336 SparseMatrix::dsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, |
| 5681 | 1337 double& rcond, solve_singularity_handler, |
| 1338 bool calc_cond) const | |
| 5164 | 1339 { |
| 1340 Matrix retval; | |
| 1341 | |
| 5275 | 1342 octave_idx_type nr = rows (); |
| 1343 octave_idx_type nc = cols (); | |
| 5630 | 1344 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1345 err = 0; |
| 1346 | |
| 6924 | 1347 if (nr != b.rows ()) |
| 5164 | 1348 (*current_liboctave_error_handler) |
| 1349 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1350 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1351 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 1352 else |
| 1353 { | |
| 1354 // Print spparms("spumoni") info if requested | |
| 1355 int typ = mattype.type (); | |
| 1356 mattype.info (); | |
| 1357 | |
| 5785 | 1358 if (typ == MatrixType::Diagonal || |
| 1359 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1360 { |
| 5630 | 1361 retval.resize (nc, b.cols(), 0.); |
| 5785 | 1362 if (typ == MatrixType::Diagonal) |
| 5275 | 1363 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1364 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1365 retval(i,j) = b(i,j) / data (i); |
| 1366 else | |
| 5275 | 1367 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1368 for (octave_idx_type k = 0; k < nc; k++) |
| 1369 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1370 retval(k,j) = b(ridx(i),j) / data (i); | |
| 1371 | |
| 5681 | 1372 if (calc_cond) |
| 1373 { | |
| 1374 double dmax = 0., dmin = octave_Inf; | |
| 1375 for (octave_idx_type i = 0; i < nm; i++) | |
| 1376 { | |
| 1377 double tmp = fabs(data(i)); | |
| 1378 if (tmp > dmax) | |
| 1379 dmax = tmp; | |
| 1380 if (tmp < dmin) | |
| 1381 dmin = tmp; | |
| 1382 } | |
| 1383 rcond = dmin / dmax; | |
| 1384 } | |
| 1385 else | |
| 1386 rcond = 1.; | |
| 5164 | 1387 } |
| 1388 else | |
| 1389 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1390 } | |
| 1391 | |
| 1392 return retval; | |
| 1393 } | |
| 1394 | |
| 1395 SparseMatrix | |
| 5785 | 1396 SparseMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 1397 octave_idx_type& err, double& rcond, |
| 1398 solve_singularity_handler, bool calc_cond) const | |
| 5164 | 1399 { |
| 1400 SparseMatrix retval; | |
| 1401 | |
| 5275 | 1402 octave_idx_type nr = rows (); |
| 1403 octave_idx_type nc = cols (); | |
| 5630 | 1404 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1405 err = 0; |
| 1406 | |
| 6924 | 1407 if (nr != b.rows ()) |
| 5164 | 1408 (*current_liboctave_error_handler) |
| 1409 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1410 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1411 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 1412 else |
| 1413 { | |
| 1414 // Print spparms("spumoni") info if requested | |
| 1415 int typ = mattype.type (); | |
| 1416 mattype.info (); | |
| 1417 | |
| 5785 | 1418 if (typ == MatrixType::Diagonal || |
| 1419 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1420 { |
| 5275 | 1421 octave_idx_type b_nc = b.cols (); |
| 5681 | 1422 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1423 retval = SparseMatrix (nc, b_nc, b_nz); |
| 5164 | 1424 |
| 1425 retval.xcidx(0) = 0; | |
| 5275 | 1426 octave_idx_type ii = 0; |
| 5785 | 1427 if (typ == MatrixType::Diagonal) |
| 5681 | 1428 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1429 { |
| 5275 | 1430 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1431 { |
| 5681 | 1432 if (b.ridx(i) >= nm) |
| 1433 break; | |
| 5164 | 1434 retval.xridx (ii) = b.ridx(i); |
| 1435 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1436 } | |
| 1437 retval.xcidx(j+1) = ii; | |
| 1438 } | |
| 1439 else | |
| 5681 | 1440 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1441 { |
| 5630 | 1442 for (octave_idx_type l = 0; l < nc; l++) |
| 1443 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1444 { | |
| 1445 bool found = false; | |
| 1446 octave_idx_type k; | |
| 1447 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1448 if (ridx(i) == b.ridx(k)) | |
| 1449 { | |
| 1450 found = true; | |
| 1451 break; | |
| 1452 } | |
| 1453 if (found) | |
| 5164 | 1454 { |
| 5630 | 1455 retval.xridx (ii) = l; |
| 1456 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1457 } |
| 5630 | 1458 } |
| 5164 | 1459 retval.xcidx(j+1) = ii; |
| 1460 } | |
| 5630 | 1461 |
| 5681 | 1462 if (calc_cond) |
| 1463 { | |
| 1464 double dmax = 0., dmin = octave_Inf; | |
| 1465 for (octave_idx_type i = 0; i < nm; i++) | |
| 1466 { | |
| 1467 double tmp = fabs(data(i)); | |
| 1468 if (tmp > dmax) | |
| 1469 dmax = tmp; | |
| 1470 if (tmp < dmin) | |
| 1471 dmin = tmp; | |
| 1472 } | |
| 1473 rcond = dmin / dmax; | |
| 1474 } | |
| 1475 else | |
| 1476 rcond = 1.; | |
| 5164 | 1477 } |
| 1478 else | |
| 1479 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1480 } | |
| 1481 | |
| 1482 return retval; | |
| 1483 } | |
| 1484 | |
| 1485 ComplexMatrix | |
| 5785 | 1486 SparseMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 1487 octave_idx_type& err, double& rcond, |
| 1488 solve_singularity_handler, bool calc_cond) const | |
| 5164 | 1489 { |
| 1490 ComplexMatrix retval; | |
| 1491 | |
| 5275 | 1492 octave_idx_type nr = rows (); |
| 1493 octave_idx_type nc = cols (); | |
| 5630 | 1494 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1495 err = 0; |
| 1496 | |
| 6924 | 1497 if (nr != b.rows ()) |
| 5164 | 1498 (*current_liboctave_error_handler) |
| 1499 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1500 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1501 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 1502 else |
| 1503 { | |
| 1504 // Print spparms("spumoni") info if requested | |
| 1505 int typ = mattype.type (); | |
| 1506 mattype.info (); | |
| 1507 | |
| 5785 | 1508 if (typ == MatrixType::Diagonal || |
| 1509 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1510 { |
| 5630 | 1511 retval.resize (nc, b.cols(), 0); |
| 5785 | 1512 if (typ == MatrixType::Diagonal) |
| 5275 | 1513 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1514 for (octave_idx_type i = 0; i < nm; i++) |
| 1515 retval(i,j) = b(i,j) / data (i); | |
| 5164 | 1516 else |
| 5275 | 1517 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1518 for (octave_idx_type k = 0; k < nc; k++) |
| 1519 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1520 retval(k,j) = b(ridx(i),j) / data (i); | |
| 5164 | 1521 |
| 5681 | 1522 if (calc_cond) |
| 1523 { | |
| 1524 double dmax = 0., dmin = octave_Inf; | |
| 1525 for (octave_idx_type i = 0; i < nm; i++) | |
| 1526 { | |
| 1527 double tmp = fabs(data(i)); | |
| 1528 if (tmp > dmax) | |
| 1529 dmax = tmp; | |
| 1530 if (tmp < dmin) | |
| 1531 dmin = tmp; | |
| 1532 } | |
| 1533 rcond = dmin / dmax; | |
| 1534 } | |
| 1535 else | |
| 1536 rcond = 1.; | |
| 5164 | 1537 } |
| 1538 else | |
| 1539 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1540 } | |
| 1541 | |
| 1542 return retval; | |
| 1543 } | |
| 1544 | |
| 1545 SparseComplexMatrix | |
| 5785 | 1546 SparseMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 1547 octave_idx_type& err, double& rcond, |
| 5681 | 1548 solve_singularity_handler, bool calc_cond) const |
| 5164 | 1549 { |
| 1550 SparseComplexMatrix retval; | |
| 1551 | |
| 5275 | 1552 octave_idx_type nr = rows (); |
| 1553 octave_idx_type nc = cols (); | |
| 5630 | 1554 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1555 err = 0; |
| 1556 | |
| 6924 | 1557 if (nr != b.rows ()) |
| 5164 | 1558 (*current_liboctave_error_handler) |
| 1559 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1560 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1561 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 1562 else |
| 1563 { | |
| 1564 // Print spparms("spumoni") info if requested | |
| 1565 int typ = mattype.type (); | |
| 1566 mattype.info (); | |
| 1567 | |
| 5785 | 1568 if (typ == MatrixType::Diagonal || |
| 1569 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1570 { |
| 5275 | 1571 octave_idx_type b_nc = b.cols (); |
| 5681 | 1572 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1573 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 1574 |
| 1575 retval.xcidx(0) = 0; | |
| 5275 | 1576 octave_idx_type ii = 0; |
| 5785 | 1577 if (typ == MatrixType::Diagonal) |
| 5275 | 1578 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1579 { |
| 5275 | 1580 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1581 { |
| 5681 | 1582 if (b.ridx(i) >= nm) |
| 1583 break; | |
| 5164 | 1584 retval.xridx (ii) = b.ridx(i); |
| 1585 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1586 } | |
| 1587 retval.xcidx(j+1) = ii; | |
| 1588 } | |
| 1589 else | |
| 5275 | 1590 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1591 { |
| 5630 | 1592 for (octave_idx_type l = 0; l < nc; l++) |
| 1593 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1594 { | |
| 1595 bool found = false; | |
| 1596 octave_idx_type k; | |
| 1597 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1598 if (ridx(i) == b.ridx(k)) | |
| 1599 { | |
| 1600 found = true; | |
| 1601 break; | |
| 1602 } | |
| 1603 if (found) | |
| 5164 | 1604 { |
| 5630 | 1605 retval.xridx (ii) = l; |
| 1606 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1607 } |
| 5630 | 1608 } |
| 5164 | 1609 retval.xcidx(j+1) = ii; |
| 1610 } | |
| 1611 | |
| 5681 | 1612 if (calc_cond) |
| 1613 { | |
| 1614 double dmax = 0., dmin = octave_Inf; | |
| 1615 for (octave_idx_type i = 0; i < nm; i++) | |
| 1616 { | |
| 1617 double tmp = fabs(data(i)); | |
| 1618 if (tmp > dmax) | |
| 1619 dmax = tmp; | |
| 1620 if (tmp < dmin) | |
| 1621 dmin = tmp; | |
| 1622 } | |
| 1623 rcond = dmin / dmax; | |
| 1624 } | |
| 1625 else | |
| 1626 rcond = 1.; | |
| 5164 | 1627 } |
| 1628 else | |
| 1629 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1630 } | |
| 1631 | |
| 1632 return retval; | |
| 1633 } | |
| 1634 | |
| 1635 Matrix | |
| 5785 | 1636 SparseMatrix::utsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 1637 octave_idx_type& err, double& rcond, |
| 5681 | 1638 solve_singularity_handler sing_handler, |
| 1639 bool calc_cond) const | |
| 5164 | 1640 { |
| 1641 Matrix retval; | |
| 1642 | |
| 5275 | 1643 octave_idx_type nr = rows (); |
| 1644 octave_idx_type nc = cols (); | |
| 5630 | 1645 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1646 err = 0; |
| 1647 | |
| 6924 | 1648 if (nr != b.rows ()) |
| 5164 | 1649 (*current_liboctave_error_handler) |
| 1650 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1651 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1652 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 1653 else |
| 1654 { | |
| 1655 // Print spparms("spumoni") info if requested | |
| 1656 int typ = mattype.type (); | |
| 1657 mattype.info (); | |
| 1658 | |
| 5785 | 1659 if (typ == MatrixType::Permuted_Upper || |
| 1660 typ == MatrixType::Upper) | |
| 5164 | 1661 { |
| 1662 double anorm = 0.; | |
| 1663 double ainvnorm = 0.; | |
| 5630 | 1664 octave_idx_type b_nc = b.cols (); |
| 5681 | 1665 rcond = 1.; |
| 1666 | |
| 1667 if (calc_cond) | |
| 1668 { | |
| 1669 // Calculate the 1-norm of matrix for rcond calculation | |
| 1670 for (octave_idx_type j = 0; j < nc; j++) | |
| 1671 { | |
| 1672 double atmp = 0.; | |
| 1673 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1674 atmp += fabs(data(i)); | |
| 1675 if (atmp > anorm) | |
| 1676 anorm = atmp; | |
| 1677 } | |
| 5164 | 1678 } |
| 1679 | |
| 5785 | 1680 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1681 { |
| 5630 | 1682 retval.resize (nc, b_nc); |
| 5322 | 1683 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 1684 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1685 | |
| 1686 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 1687 { |
| 5275 | 1688 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 1689 work[i] = b(i,j); |
| 5630 | 1690 for (octave_idx_type i = nr; i < nc; i++) |
| 1691 work[i] = 0.; | |
| 1692 | |
| 1693 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1694 { |
| 5322 | 1695 octave_idx_type kidx = perm[k]; |
| 1696 | |
| 1697 if (work[k] != 0.) | |
| 5164 | 1698 { |
| 5681 | 1699 if (ridx(cidx(kidx+1)-1) != k || |
| 1700 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1701 { |
| 1702 err = -2; | |
| 1703 goto triangular_error; | |
| 1704 } | |
| 1705 | |
| 5322 | 1706 double tmp = work[k] / data(cidx(kidx+1)-1); |
| 1707 work[k] = tmp; | |
| 1708 for (octave_idx_type i = cidx(kidx); | |
| 1709 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1710 { |
| 5322 | 1711 octave_idx_type iidx = ridx(i); |
| 1712 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1713 } |
| 1714 } | |
| 1715 } | |
| 1716 | |
| 5630 | 1717 for (octave_idx_type i = 0; i < nc; i++) |
| 1718 retval.xelem (perm[i], j) = work[i]; | |
| 5164 | 1719 } |
| 1720 | |
| 5681 | 1721 if (calc_cond) |
| 1722 { | |
| 1723 // Calculation of 1-norm of inv(*this) | |
| 1724 for (octave_idx_type i = 0; i < nm; i++) | |
| 1725 work[i] = 0.; | |
| 1726 | |
| 1727 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1728 { |
| 5681 | 1729 work[j] = 1.; |
| 1730 | |
| 1731 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1732 { |
| 5681 | 1733 octave_idx_type iidx = perm[k]; |
| 1734 | |
| 1735 if (work[k] != 0.) | |
| 5164 | 1736 { |
| 5681 | 1737 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 1738 work[k] = tmp; | |
| 1739 for (octave_idx_type i = cidx(iidx); | |
| 1740 i < cidx(iidx+1)-1; i++) | |
| 1741 { | |
| 1742 octave_idx_type idx2 = ridx(i); | |
| 1743 work[idx2] = work[idx2] - tmp * data(i); | |
| 1744 } | |
| 5164 | 1745 } |
| 1746 } | |
| 5681 | 1747 double atmp = 0; |
| 1748 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1749 { | |
| 1750 atmp += fabs(work[i]); | |
| 1751 work[i] = 0.; | |
| 1752 } | |
| 1753 if (atmp > ainvnorm) | |
| 1754 ainvnorm = atmp; | |
| 5164 | 1755 } |
| 5681 | 1756 rcond = 1. / ainvnorm / anorm; |
| 5164 | 1757 } |
| 1758 } | |
| 1759 else | |
| 1760 { | |
| 5630 | 1761 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1762 retval.resize (nc, b_nc); | |
| 1763 | |
| 1764 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 1765 { |
| 5630 | 1766 for (octave_idx_type i = 0; i < nr; i++) |
| 1767 work[i] = b(i,j); | |
| 1768 for (octave_idx_type i = nr; i < nc; i++) | |
| 1769 work[i] = 0.; | |
| 1770 | |
| 1771 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1772 { |
| 5630 | 1773 if (work[k] != 0.) |
| 5164 | 1774 { |
| 5681 | 1775 if (ridx(cidx(k+1)-1) != k || |
| 1776 data(cidx(k+1)-1) == 0.) | |
| 5164 | 1777 { |
| 1778 err = -2; | |
| 1779 goto triangular_error; | |
| 1780 } | |
| 1781 | |
| 5630 | 1782 double tmp = work[k] / data(cidx(k+1)-1); |
| 1783 work[k] = tmp; | |
| 5275 | 1784 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 1785 { |
| 5275 | 1786 octave_idx_type iidx = ridx(i); |
| 5630 | 1787 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 1788 } |
| 1789 } | |
| 1790 } | |
| 5630 | 1791 |
| 1792 for (octave_idx_type i = 0; i < nc; i++) | |
| 1793 retval.xelem (i, j) = work[i]; | |
| 5164 | 1794 } |
| 1795 | |
| 5681 | 1796 if (calc_cond) |
| 1797 { | |
| 1798 // Calculation of 1-norm of inv(*this) | |
| 1799 for (octave_idx_type i = 0; i < nm; i++) | |
| 1800 work[i] = 0.; | |
| 1801 | |
| 1802 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1803 { |
| 5681 | 1804 work[j] = 1.; |
| 1805 | |
| 1806 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1807 { |
| 5681 | 1808 if (work[k] != 0.) |
| 5164 | 1809 { |
| 5681 | 1810 double tmp = work[k] / data(cidx(k+1)-1); |
| 1811 work[k] = tmp; | |
| 1812 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) | |
| 1813 { | |
| 1814 octave_idx_type iidx = ridx(i); | |
| 1815 work[iidx] = work[iidx] - tmp * data(i); | |
| 1816 } | |
| 5164 | 1817 } |
| 1818 } | |
| 5681 | 1819 double atmp = 0; |
| 1820 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1821 { | |
| 1822 atmp += fabs(work[i]); | |
| 1823 work[i] = 0.; | |
| 1824 } | |
| 1825 if (atmp > ainvnorm) | |
| 1826 ainvnorm = atmp; | |
| 5164 | 1827 } |
| 5681 | 1828 rcond = 1. / ainvnorm / anorm; |
| 1829 } | |
| 1830 } | |
| 5164 | 1831 |
| 1832 triangular_error: | |
| 1833 if (err != 0) | |
| 1834 { | |
| 1835 if (sing_handler) | |
| 5681 | 1836 { |
| 1837 sing_handler (rcond); | |
| 1838 mattype.mark_as_rectangular (); | |
| 1839 } | |
| 5164 | 1840 else |
| 1841 (*current_liboctave_error_handler) | |
| 1842 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 1843 rcond); | |
| 1844 } | |
| 1845 | |
| 1846 volatile double rcond_plus_one = rcond + 1.0; | |
| 1847 | |
| 1848 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 1849 { | |
| 1850 err = -2; | |
| 1851 | |
| 1852 if (sing_handler) | |
| 5681 | 1853 { |
| 1854 sing_handler (rcond); | |
| 1855 mattype.mark_as_rectangular (); | |
| 1856 } | |
| 5164 | 1857 else |
| 1858 (*current_liboctave_error_handler) | |
| 1859 ("matrix singular to machine precision, rcond = %g", | |
| 1860 rcond); | |
| 1861 } | |
| 1862 } | |
| 1863 else | |
| 1864 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1865 } | |
| 1866 | |
| 1867 return retval; | |
| 1868 } | |
| 1869 | |
| 1870 SparseMatrix | |
| 5785 | 1871 SparseMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 1872 octave_idx_type& err, double& rcond, |
| 5681 | 1873 solve_singularity_handler sing_handler, |
| 1874 bool calc_cond) const | |
| 5164 | 1875 { |
| 1876 SparseMatrix retval; | |
| 1877 | |
| 5275 | 1878 octave_idx_type nr = rows (); |
| 1879 octave_idx_type nc = cols (); | |
| 5630 | 1880 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1881 err = 0; |
| 1882 | |
| 6924 | 1883 if (nr != b.rows ()) |
| 5164 | 1884 (*current_liboctave_error_handler) |
| 1885 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1886 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1887 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 1888 else |
| 1889 { | |
| 1890 // Print spparms("spumoni") info if requested | |
| 1891 int typ = mattype.type (); | |
| 1892 mattype.info (); | |
| 1893 | |
| 5785 | 1894 if (typ == MatrixType::Permuted_Upper || |
| 1895 typ == MatrixType::Upper) | |
| 5164 | 1896 { |
| 1897 double anorm = 0.; | |
| 1898 double ainvnorm = 0.; | |
| 5681 | 1899 rcond = 1.; |
| 1900 | |
| 1901 if (calc_cond) | |
| 1902 { | |
| 1903 // Calculate the 1-norm of matrix for rcond calculation | |
| 1904 for (octave_idx_type j = 0; j < nc; j++) | |
| 1905 { | |
| 1906 double atmp = 0.; | |
| 1907 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1908 atmp += fabs(data(i)); | |
| 1909 if (atmp > anorm) | |
| 1910 anorm = atmp; | |
| 1911 } | |
| 5164 | 1912 } |
| 1913 | |
| 5275 | 1914 octave_idx_type b_nc = b.cols (); |
| 5681 | 1915 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1916 retval = SparseMatrix (nc, b_nc, b_nz); |
| 5164 | 1917 retval.xcidx(0) = 0; |
| 5275 | 1918 octave_idx_type ii = 0; |
| 1919 octave_idx_type x_nz = b_nz; | |
| 5164 | 1920 |
| 5785 | 1921 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1922 { |
| 5322 | 1923 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 1924 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1925 | |
| 1926 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 1927 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 1928 rperm[perm[i]] = i; |
| 5164 | 1929 |
| 5275 | 1930 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1931 { |
| 5630 | 1932 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1933 work[i] = 0.; |
| 5275 | 1934 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1935 work[b.ridx(i)] = b.data(i); |
| 1936 | |
| 5630 | 1937 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 1938 { |
| 5322 | 1939 octave_idx_type kidx = perm[k]; |
| 1940 | |
| 1941 if (work[k] != 0.) | |
| 5164 | 1942 { |
| 5681 | 1943 if (ridx(cidx(kidx+1)-1) != k || |
| 1944 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1945 { |
| 1946 err = -2; | |
| 1947 goto triangular_error; | |
| 1948 } | |
| 1949 | |
| 5322 | 1950 double tmp = work[k] / data(cidx(kidx+1)-1); |
| 1951 work[k] = tmp; | |
| 1952 for (octave_idx_type i = cidx(kidx); | |
| 1953 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1954 { |
| 5322 | 1955 octave_idx_type iidx = ridx(i); |
| 1956 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1957 } |
| 1958 } | |
| 1959 } | |
| 1960 | |
| 1961 // Count non-zeros in work vector and adjust space in | |
| 1962 // retval if needed | |
| 5275 | 1963 octave_idx_type new_nnz = 0; |
| 5630 | 1964 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 1965 if (work[i] != 0.) |
| 1966 new_nnz++; | |
| 1967 | |
| 1968 if (ii + new_nnz > x_nz) | |
| 1969 { | |
| 1970 // Resize the sparse matrix | |
| 5275 | 1971 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 1972 retval.change_capacity (sz); |
| 1973 x_nz = sz; | |
| 1974 } | |
| 1975 | |
| 5630 | 1976 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 1977 if (work[rperm[i]] != 0.) |
| 5164 | 1978 { |
| 1979 retval.xridx(ii) = i; | |
| 5322 | 1980 retval.xdata(ii++) = work[rperm[i]]; |
| 5164 | 1981 } |
| 1982 retval.xcidx(j+1) = ii; | |
| 1983 } | |
| 1984 | |
| 1985 retval.maybe_compress (); | |
| 1986 | |
| 5681 | 1987 if (calc_cond) |
| 1988 { | |
| 1989 // Calculation of 1-norm of inv(*this) | |
| 1990 for (octave_idx_type i = 0; i < nm; i++) | |
| 1991 work[i] = 0.; | |
| 1992 | |
| 1993 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1994 { |
| 5681 | 1995 work[j] = 1.; |
| 1996 | |
| 1997 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1998 { |
| 5681 | 1999 octave_idx_type iidx = perm[k]; |
| 2000 | |
| 2001 if (work[k] != 0.) | |
| 5164 | 2002 { |
| 5681 | 2003 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2004 work[k] = tmp; | |
| 2005 for (octave_idx_type i = cidx(iidx); | |
| 2006 i < cidx(iidx+1)-1; i++) | |
| 2007 { | |
| 2008 octave_idx_type idx2 = ridx(i); | |
| 2009 work[idx2] = work[idx2] - tmp * data(i); | |
| 2010 } | |
| 5164 | 2011 } |
| 2012 } | |
| 5681 | 2013 double atmp = 0; |
| 2014 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2015 { | |
| 2016 atmp += fabs(work[i]); | |
| 2017 work[i] = 0.; | |
| 2018 } | |
| 2019 if (atmp > ainvnorm) | |
| 2020 ainvnorm = atmp; | |
| 5164 | 2021 } |
| 5681 | 2022 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2023 } |
| 2024 } | |
| 2025 else | |
| 2026 { | |
| 5630 | 2027 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5164 | 2028 |
| 5275 | 2029 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2030 { |
| 5630 | 2031 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 2032 work[i] = 0.; |
| 5275 | 2033 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 2034 work[b.ridx(i)] = b.data(i); |
| 2035 | |
| 5630 | 2036 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 2037 { |
| 2038 if (work[k] != 0.) | |
| 2039 { | |
| 5681 | 2040 if (ridx(cidx(k+1)-1) != k || |
| 2041 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2042 { |
| 2043 err = -2; | |
| 2044 goto triangular_error; | |
| 2045 } | |
| 2046 | |
| 2047 double tmp = work[k] / data(cidx(k+1)-1); | |
| 2048 work[k] = tmp; | |
| 5275 | 2049 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2050 { |
| 5275 | 2051 octave_idx_type iidx = ridx(i); |
| 5164 | 2052 work[iidx] = work[iidx] - tmp * data(i); |
| 2053 } | |
| 2054 } | |
| 2055 } | |
| 2056 | |
| 2057 // Count non-zeros in work vector and adjust space in | |
| 2058 // retval if needed | |
| 5275 | 2059 octave_idx_type new_nnz = 0; |
| 5630 | 2060 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2061 if (work[i] != 0.) |
| 2062 new_nnz++; | |
| 2063 | |
| 2064 if (ii + new_nnz > x_nz) | |
| 2065 { | |
| 2066 // Resize the sparse matrix | |
| 5275 | 2067 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2068 retval.change_capacity (sz); |
| 2069 x_nz = sz; | |
| 2070 } | |
| 2071 | |
| 5630 | 2072 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2073 if (work[i] != 0.) |
| 2074 { | |
| 2075 retval.xridx(ii) = i; | |
| 2076 retval.xdata(ii++) = work[i]; | |
| 2077 } | |
| 2078 retval.xcidx(j+1) = ii; | |
| 2079 } | |
| 2080 | |
| 2081 retval.maybe_compress (); | |
| 2082 | |
| 5681 | 2083 if (calc_cond) |
| 2084 { | |
| 2085 // Calculation of 1-norm of inv(*this) | |
| 2086 for (octave_idx_type i = 0; i < nm; i++) | |
| 2087 work[i] = 0.; | |
| 2088 | |
| 2089 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2090 { |
| 5681 | 2091 work[j] = 1.; |
| 2092 | |
| 2093 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2094 { |
| 5681 | 2095 if (work[k] != 0.) |
| 5164 | 2096 { |
| 5681 | 2097 double tmp = work[k] / data(cidx(k+1)-1); |
| 2098 work[k] = tmp; | |
| 2099 for (octave_idx_type i = cidx(k); | |
| 2100 i < cidx(k+1)-1; i++) | |
| 2101 { | |
| 2102 octave_idx_type iidx = ridx(i); | |
| 2103 work[iidx] = work[iidx] - tmp * data(i); | |
| 2104 } | |
| 5164 | 2105 } |
| 2106 } | |
| 5681 | 2107 double atmp = 0; |
| 2108 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2109 { | |
| 2110 atmp += fabs(work[i]); | |
| 2111 work[i] = 0.; | |
| 2112 } | |
| 2113 if (atmp > ainvnorm) | |
| 2114 ainvnorm = atmp; | |
| 5164 | 2115 } |
| 5681 | 2116 rcond = 1. / ainvnorm / anorm; |
| 2117 } | |
| 2118 } | |
| 5164 | 2119 |
| 2120 triangular_error: | |
| 2121 if (err != 0) | |
| 2122 { | |
| 2123 if (sing_handler) | |
| 5681 | 2124 { |
| 2125 sing_handler (rcond); | |
| 2126 mattype.mark_as_rectangular (); | |
| 2127 } | |
| 5164 | 2128 else |
| 2129 (*current_liboctave_error_handler) | |
| 2130 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2131 rcond); | |
| 2132 } | |
| 2133 | |
| 2134 volatile double rcond_plus_one = rcond + 1.0; | |
| 2135 | |
| 2136 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2137 { | |
| 2138 err = -2; | |
| 2139 | |
| 2140 if (sing_handler) | |
| 5681 | 2141 { |
| 2142 sing_handler (rcond); | |
| 2143 mattype.mark_as_rectangular (); | |
| 2144 } | |
| 5164 | 2145 else |
| 2146 (*current_liboctave_error_handler) | |
| 2147 ("matrix singular to machine precision, rcond = %g", | |
| 2148 rcond); | |
| 2149 } | |
| 2150 } | |
| 2151 else | |
| 2152 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2153 } | |
| 2154 return retval; | |
| 2155 } | |
| 2156 | |
| 2157 ComplexMatrix | |
| 5785 | 2158 SparseMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 2159 octave_idx_type& err, double& rcond, |
| 5681 | 2160 solve_singularity_handler sing_handler, |
| 2161 bool calc_cond) const | |
| 5164 | 2162 { |
| 2163 ComplexMatrix retval; | |
| 2164 | |
| 5275 | 2165 octave_idx_type nr = rows (); |
| 2166 octave_idx_type nc = cols (); | |
| 5630 | 2167 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2168 err = 0; |
| 2169 | |
| 6924 | 2170 if (nr != b.rows ()) |
| 5164 | 2171 (*current_liboctave_error_handler) |
| 2172 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2173 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2174 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 2175 else |
| 2176 { | |
| 2177 // Print spparms("spumoni") info if requested | |
| 2178 int typ = mattype.type (); | |
| 2179 mattype.info (); | |
| 2180 | |
| 5785 | 2181 if (typ == MatrixType::Permuted_Upper || |
| 2182 typ == MatrixType::Upper) | |
| 5164 | 2183 { |
| 2184 double anorm = 0.; | |
| 2185 double ainvnorm = 0.; | |
| 5275 | 2186 octave_idx_type b_nc = b.cols (); |
| 5681 | 2187 rcond = 1.; |
| 2188 | |
| 2189 if (calc_cond) | |
| 2190 { | |
| 2191 // Calculate the 1-norm of matrix for rcond calculation | |
| 2192 for (octave_idx_type j = 0; j < nc; j++) | |
| 2193 { | |
| 2194 double atmp = 0.; | |
| 2195 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2196 atmp += fabs(data(i)); | |
| 2197 if (atmp > anorm) | |
| 2198 anorm = atmp; | |
| 2199 } | |
| 5164 | 2200 } |
| 2201 | |
| 5785 | 2202 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2203 { |
| 5630 | 2204 retval.resize (nc, b_nc); |
| 5322 | 2205 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2206 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 2207 |
| 5275 | 2208 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2209 { |
| 5275 | 2210 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 2211 cwork[i] = b(i,j); |
| 5630 | 2212 for (octave_idx_type i = nr; i < nc; i++) |
| 2213 cwork[i] = 0.; | |
| 2214 | |
| 2215 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2216 { |
| 5322 | 2217 octave_idx_type kidx = perm[k]; |
| 2218 | |
| 2219 if (cwork[k] != 0.) | |
| 5164 | 2220 { |
| 5681 | 2221 if (ridx(cidx(kidx+1)-1) != k || |
| 2222 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2223 { |
| 2224 err = -2; | |
| 2225 goto triangular_error; | |
| 2226 } | |
| 2227 | |
| 5322 | 2228 Complex tmp = cwork[k] / data(cidx(kidx+1)-1); |
| 2229 cwork[k] = tmp; | |
| 2230 for (octave_idx_type i = cidx(kidx); | |
| 2231 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2232 { |
| 5322 | 2233 octave_idx_type iidx = ridx(i); |
| 2234 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 2235 } |
| 2236 } | |
| 2237 } | |
| 2238 | |
| 5630 | 2239 for (octave_idx_type i = 0; i < nc; i++) |
| 2240 retval.xelem (perm[i], j) = cwork[i]; | |
| 5164 | 2241 } |
| 2242 | |
| 5681 | 2243 if (calc_cond) |
| 2244 { | |
| 2245 // Calculation of 1-norm of inv(*this) | |
| 2246 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2247 for (octave_idx_type i = 0; i < nm; i++) | |
| 2248 work[i] = 0.; | |
| 2249 | |
| 2250 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2251 { |
| 5681 | 2252 work[j] = 1.; |
| 2253 | |
| 2254 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2255 { |
| 5681 | 2256 octave_idx_type iidx = perm[k]; |
| 2257 | |
| 2258 if (work[k] != 0.) | |
| 5164 | 2259 { |
| 5681 | 2260 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2261 work[k] = tmp; | |
| 2262 for (octave_idx_type i = cidx(iidx); | |
| 2263 i < cidx(iidx+1)-1; i++) | |
| 2264 { | |
| 2265 octave_idx_type idx2 = ridx(i); | |
| 2266 work[idx2] = work[idx2] - tmp * data(i); | |
| 2267 } | |
| 5164 | 2268 } |
| 2269 } | |
| 5681 | 2270 double atmp = 0; |
| 2271 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2272 { | |
| 2273 atmp += fabs(work[i]); | |
| 2274 work[i] = 0.; | |
| 2275 } | |
| 2276 if (atmp > ainvnorm) | |
| 2277 ainvnorm = atmp; | |
| 5164 | 2278 } |
| 5681 | 2279 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2280 } |
| 2281 } | |
| 2282 else | |
| 2283 { | |
| 5630 | 2284 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 2285 retval.resize (nc, b_nc); | |
| 5164 | 2286 |
| 5275 | 2287 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2288 { |
| 5630 | 2289 for (octave_idx_type i = 0; i < nr; i++) |
| 2290 cwork[i] = b(i,j); | |
| 2291 for (octave_idx_type i = nr; i < nc; i++) | |
| 2292 cwork[i] = 0.; | |
| 2293 | |
| 2294 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2295 { |
| 5630 | 2296 if (cwork[k] != 0.) |
| 5164 | 2297 { |
| 5681 | 2298 if (ridx(cidx(k+1)-1) != k || |
| 2299 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2300 { |
| 2301 err = -2; | |
| 2302 goto triangular_error; | |
| 2303 } | |
| 2304 | |
| 5630 | 2305 Complex tmp = cwork[k] / data(cidx(k+1)-1); |
| 2306 cwork[k] = tmp; | |
| 5275 | 2307 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2308 { |
| 5275 | 2309 octave_idx_type iidx = ridx(i); |
| 5630 | 2310 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 2311 } |
| 2312 } | |
| 2313 } | |
| 5630 | 2314 |
| 2315 for (octave_idx_type i = 0; i < nc; i++) | |
| 2316 retval.xelem (i, j) = cwork[i]; | |
| 5164 | 2317 } |
| 2318 | |
| 5681 | 2319 if (calc_cond) |
| 2320 { | |
| 2321 // Calculation of 1-norm of inv(*this) | |
| 2322 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2323 for (octave_idx_type i = 0; i < nm; i++) | |
| 2324 work[i] = 0.; | |
| 2325 | |
| 2326 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2327 { |
| 5681 | 2328 work[j] = 1.; |
| 2329 | |
| 2330 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2331 { |
| 5681 | 2332 if (work[k] != 0.) |
| 5164 | 2333 { |
| 5681 | 2334 double tmp = work[k] / data(cidx(k+1)-1); |
| 2335 work[k] = tmp; | |
| 2336 for (octave_idx_type i = cidx(k); | |
| 2337 i < cidx(k+1)-1; i++) | |
| 2338 { | |
| 2339 octave_idx_type iidx = ridx(i); | |
| 2340 work[iidx] = work[iidx] - tmp * data(i); | |
| 2341 } | |
| 5164 | 2342 } |
| 2343 } | |
| 5681 | 2344 double atmp = 0; |
| 2345 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2346 { | |
| 2347 atmp += fabs(work[i]); | |
| 2348 work[i] = 0.; | |
| 2349 } | |
| 2350 if (atmp > ainvnorm) | |
| 2351 ainvnorm = atmp; | |
| 5164 | 2352 } |
| 5681 | 2353 rcond = 1. / ainvnorm / anorm; |
| 2354 } | |
| 2355 } | |
| 5164 | 2356 |
| 2357 triangular_error: | |
| 2358 if (err != 0) | |
| 2359 { | |
| 2360 if (sing_handler) | |
| 5681 | 2361 { |
| 2362 sing_handler (rcond); | |
| 2363 mattype.mark_as_rectangular (); | |
| 2364 } | |
| 5164 | 2365 else |
| 2366 (*current_liboctave_error_handler) | |
| 2367 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2368 rcond); | |
| 2369 } | |
| 2370 | |
| 2371 volatile double rcond_plus_one = rcond + 1.0; | |
| 2372 | |
| 2373 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2374 { | |
| 2375 err = -2; | |
| 2376 | |
| 2377 if (sing_handler) | |
| 5681 | 2378 { |
| 2379 sing_handler (rcond); | |
| 2380 mattype.mark_as_rectangular (); | |
| 2381 } | |
| 5164 | 2382 else |
| 2383 (*current_liboctave_error_handler) | |
| 2384 ("matrix singular to machine precision, rcond = %g", | |
| 2385 rcond); | |
| 2386 } | |
| 2387 } | |
| 2388 else | |
| 2389 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2390 } | |
| 2391 | |
| 2392 return retval; | |
| 2393 } | |
| 2394 | |
| 2395 SparseComplexMatrix | |
| 5785 | 2396 SparseMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 2397 octave_idx_type& err, double& rcond, |
| 5681 | 2398 solve_singularity_handler sing_handler, |
| 2399 bool calc_cond) const | |
| 5164 | 2400 { |
| 2401 SparseComplexMatrix retval; | |
| 2402 | |
| 5275 | 2403 octave_idx_type nr = rows (); |
| 2404 octave_idx_type nc = cols (); | |
| 5630 | 2405 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2406 err = 0; |
| 2407 | |
| 6924 | 2408 if (nr != b.rows ()) |
| 5164 | 2409 (*current_liboctave_error_handler) |
| 2410 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2411 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2412 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 2413 else |
| 2414 { | |
| 2415 // Print spparms("spumoni") info if requested | |
| 2416 int typ = mattype.type (); | |
| 2417 mattype.info (); | |
| 2418 | |
| 5785 | 2419 if (typ == MatrixType::Permuted_Upper || |
| 2420 typ == MatrixType::Upper) | |
| 5164 | 2421 { |
| 2422 double anorm = 0.; | |
| 2423 double ainvnorm = 0.; | |
| 5681 | 2424 rcond = 1.; |
| 2425 | |
| 2426 if (calc_cond) | |
| 2427 { | |
| 2428 // Calculate the 1-norm of matrix for rcond calculation | |
| 2429 for (octave_idx_type j = 0; j < nc; j++) | |
| 2430 { | |
| 2431 double atmp = 0.; | |
| 2432 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2433 atmp += fabs(data(i)); | |
| 2434 if (atmp > anorm) | |
| 2435 anorm = atmp; | |
| 2436 } | |
| 5164 | 2437 } |
| 2438 | |
| 5275 | 2439 octave_idx_type b_nc = b.cols (); |
| 5681 | 2440 octave_idx_type b_nz = b.nnz (); |
| 5630 | 2441 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 2442 retval.xcidx(0) = 0; |
| 5275 | 2443 octave_idx_type ii = 0; |
| 2444 octave_idx_type x_nz = b_nz; | |
| 5164 | 2445 |
| 5785 | 2446 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2447 { |
| 5322 | 2448 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2449 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 2450 | |
| 2451 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 2452 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 2453 rperm[perm[i]] = i; |
| 5164 | 2454 |
| 5275 | 2455 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2456 { |
| 5630 | 2457 for (octave_idx_type i = 0; i < nm; i++) |
| 5322 | 2458 cwork[i] = 0.; |
| 5275 | 2459 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 2460 cwork[b.ridx(i)] = b.data(i); |
| 5164 | 2461 |
| 5630 | 2462 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 2463 { |
| 5322 | 2464 octave_idx_type kidx = perm[k]; |
| 2465 | |
| 2466 if (cwork[k] != 0.) | |
| 5164 | 2467 { |
| 5681 | 2468 if (ridx(cidx(kidx+1)-1) != k || |
| 2469 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2470 { |
| 2471 err = -2; | |
| 2472 goto triangular_error; | |
| 2473 } | |
| 2474 | |
| 5322 | 2475 Complex tmp = cwork[k] / data(cidx(kidx+1)-1); |
| 2476 cwork[k] = tmp; | |
| 2477 for (octave_idx_type i = cidx(kidx); | |
| 2478 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2479 { |
| 5322 | 2480 octave_idx_type iidx = ridx(i); |
| 2481 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 2482 } |
| 2483 } | |
| 2484 } | |
| 2485 | |
| 2486 // Count non-zeros in work vector and adjust space in | |
| 2487 // retval if needed | |
| 5275 | 2488 octave_idx_type new_nnz = 0; |
| 5630 | 2489 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2490 if (cwork[i] != 0.) |
| 5164 | 2491 new_nnz++; |
| 2492 | |
| 2493 if (ii + new_nnz > x_nz) | |
| 2494 { | |
| 2495 // Resize the sparse matrix | |
| 5275 | 2496 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2497 retval.change_capacity (sz); |
| 2498 x_nz = sz; | |
| 2499 } | |
| 2500 | |
| 5630 | 2501 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2502 if (cwork[rperm[i]] != 0.) |
| 5164 | 2503 { |
| 2504 retval.xridx(ii) = i; | |
| 5322 | 2505 retval.xdata(ii++) = cwork[rperm[i]]; |
| 5164 | 2506 } |
| 2507 retval.xcidx(j+1) = ii; | |
| 2508 } | |
| 2509 | |
| 2510 retval.maybe_compress (); | |
| 2511 | |
| 5681 | 2512 if (calc_cond) |
| 2513 { | |
| 2514 // Calculation of 1-norm of inv(*this) | |
| 2515 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2516 for (octave_idx_type i = 0; i < nm; i++) | |
| 2517 work[i] = 0.; | |
| 2518 | |
| 2519 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2520 { |
| 5681 | 2521 work[j] = 1.; |
| 2522 | |
| 2523 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2524 { |
| 5681 | 2525 octave_idx_type iidx = perm[k]; |
| 2526 | |
| 2527 if (work[k] != 0.) | |
| 5164 | 2528 { |
| 5681 | 2529 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2530 work[k] = tmp; | |
| 2531 for (octave_idx_type i = cidx(iidx); | |
| 2532 i < cidx(iidx+1)-1; i++) | |
| 2533 { | |
| 2534 octave_idx_type idx2 = ridx(i); | |
| 2535 work[idx2] = work[idx2] - tmp * data(i); | |
| 2536 } | |
| 5164 | 2537 } |
| 2538 } | |
| 5681 | 2539 double atmp = 0; |
| 2540 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2541 { | |
| 2542 atmp += fabs(work[i]); | |
| 2543 work[i] = 0.; | |
| 2544 } | |
| 2545 if (atmp > ainvnorm) | |
| 2546 ainvnorm = atmp; | |
| 5164 | 2547 } |
| 5681 | 2548 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2549 } |
| 2550 } | |
| 2551 else | |
| 2552 { | |
| 5630 | 2553 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 2554 |
| 5275 | 2555 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2556 { |
| 5630 | 2557 for (octave_idx_type i = 0; i < nm; i++) |
| 2558 cwork[i] = 0.; | |
| 5275 | 2559 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5630 | 2560 cwork[b.ridx(i)] = b.data(i); |
| 2561 | |
| 2562 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2563 { |
| 5630 | 2564 if (cwork[k] != 0.) |
| 5164 | 2565 { |
| 5681 | 2566 if (ridx(cidx(k+1)-1) != k || |
| 2567 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2568 { |
| 2569 err = -2; | |
| 2570 goto triangular_error; | |
| 2571 } | |
| 2572 | |
| 5630 | 2573 Complex tmp = cwork[k] / data(cidx(k+1)-1); |
| 2574 cwork[k] = tmp; | |
| 5275 | 2575 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2576 { |
| 5275 | 2577 octave_idx_type iidx = ridx(i); |
| 5630 | 2578 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 2579 } |
| 2580 } | |
| 2581 } | |
| 2582 | |
| 2583 // Count non-zeros in work vector and adjust space in | |
| 2584 // retval if needed | |
| 5275 | 2585 octave_idx_type new_nnz = 0; |
| 5630 | 2586 for (octave_idx_type i = 0; i < nc; i++) |
| 2587 if (cwork[i] != 0.) | |
| 5164 | 2588 new_nnz++; |
| 2589 | |
| 2590 if (ii + new_nnz > x_nz) | |
| 2591 { | |
| 2592 // Resize the sparse matrix | |
| 5275 | 2593 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2594 retval.change_capacity (sz); |
| 2595 x_nz = sz; | |
| 2596 } | |
| 2597 | |
| 5630 | 2598 for (octave_idx_type i = 0; i < nc; i++) |
| 2599 if (cwork[i] != 0.) | |
| 5164 | 2600 { |
| 2601 retval.xridx(ii) = i; | |
| 5630 | 2602 retval.xdata(ii++) = cwork[i]; |
| 5164 | 2603 } |
| 2604 retval.xcidx(j+1) = ii; | |
| 2605 } | |
| 2606 | |
| 2607 retval.maybe_compress (); | |
| 2608 | |
| 5681 | 2609 if (calc_cond) |
| 2610 { | |
| 2611 // Calculation of 1-norm of inv(*this) | |
| 2612 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2613 for (octave_idx_type i = 0; i < nm; i++) | |
| 2614 work[i] = 0.; | |
| 2615 | |
| 2616 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2617 { |
| 5681 | 2618 work[j] = 1.; |
| 2619 | |
| 2620 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2621 { |
| 5681 | 2622 if (work[k] != 0.) |
| 5164 | 2623 { |
| 5681 | 2624 double tmp = work[k] / data(cidx(k+1)-1); |
| 2625 work[k] = tmp; | |
| 2626 for (octave_idx_type i = cidx(k); | |
| 2627 i < cidx(k+1)-1; i++) | |
| 2628 { | |
| 2629 octave_idx_type iidx = ridx(i); | |
| 2630 work[iidx] = work[iidx] - tmp * data(i); | |
| 2631 } | |
| 5164 | 2632 } |
| 2633 } | |
| 5681 | 2634 double atmp = 0; |
| 2635 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2636 { | |
| 2637 atmp += fabs(work[i]); | |
| 2638 work[i] = 0.; | |
| 2639 } | |
| 2640 if (atmp > ainvnorm) | |
| 2641 ainvnorm = atmp; | |
| 5164 | 2642 } |
| 5681 | 2643 rcond = 1. / ainvnorm / anorm; |
| 2644 } | |
| 2645 } | |
| 5164 | 2646 |
| 2647 triangular_error: | |
| 2648 if (err != 0) | |
| 2649 { | |
| 2650 if (sing_handler) | |
| 5681 | 2651 { |
| 2652 sing_handler (rcond); | |
| 2653 mattype.mark_as_rectangular (); | |
| 2654 } | |
| 5164 | 2655 else |
| 2656 (*current_liboctave_error_handler) | |
| 2657 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2658 rcond); | |
| 2659 } | |
| 2660 | |
| 2661 volatile double rcond_plus_one = rcond + 1.0; | |
| 2662 | |
| 2663 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2664 { | |
| 2665 err = -2; | |
| 2666 | |
| 2667 if (sing_handler) | |
| 5681 | 2668 { |
| 2669 sing_handler (rcond); | |
| 2670 mattype.mark_as_rectangular (); | |
| 2671 } | |
| 5164 | 2672 else |
| 2673 (*current_liboctave_error_handler) | |
| 2674 ("matrix singular to machine precision, rcond = %g", | |
| 2675 rcond); | |
| 2676 } | |
| 2677 } | |
| 2678 else | |
| 2679 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2680 } | |
| 2681 | |
| 2682 return retval; | |
| 2683 } | |
| 2684 | |
| 2685 Matrix | |
| 5785 | 2686 SparseMatrix::ltsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 2687 octave_idx_type& err, double& rcond, |
| 5681 | 2688 solve_singularity_handler sing_handler, |
| 2689 bool calc_cond) const | |
| 5164 | 2690 { |
| 2691 Matrix retval; | |
| 2692 | |
| 5275 | 2693 octave_idx_type nr = rows (); |
| 2694 octave_idx_type nc = cols (); | |
| 5630 | 2695 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2696 err = 0; |
| 2697 | |
| 6924 | 2698 if (nr != b.rows ()) |
| 5164 | 2699 (*current_liboctave_error_handler) |
| 2700 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2701 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2702 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 2703 else |
| 2704 { | |
| 2705 // Print spparms("spumoni") info if requested | |
| 2706 int typ = mattype.type (); | |
| 2707 mattype.info (); | |
| 2708 | |
| 5785 | 2709 if (typ == MatrixType::Permuted_Lower || |
| 2710 typ == MatrixType::Lower) | |
| 5164 | 2711 { |
| 2712 double anorm = 0.; | |
| 2713 double ainvnorm = 0.; | |
| 5630 | 2714 octave_idx_type b_nc = b.cols (); |
| 5681 | 2715 rcond = 1.; |
| 2716 | |
| 2717 if (calc_cond) | |
| 2718 { | |
| 2719 // Calculate the 1-norm of matrix for rcond calculation | |
| 2720 for (octave_idx_type j = 0; j < nc; j++) | |
| 2721 { | |
| 2722 double atmp = 0.; | |
| 2723 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2724 atmp += fabs(data(i)); | |
| 2725 if (atmp > anorm) | |
| 2726 anorm = atmp; | |
| 2727 } | |
| 5164 | 2728 } |
| 2729 | |
| 5785 | 2730 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 2731 { |
| 5630 | 2732 retval.resize (nc, b_nc); |
| 2733 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 5322 | 2734 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 2735 |
| 5630 | 2736 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2737 { |
| 5630 | 2738 if (nc > nr) |
| 2739 for (octave_idx_type i = 0; i < nm; i++) | |
| 2740 work[i] = 0.; | |
| 5275 | 2741 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 2742 work[perm[i]] = b(i,j); |
| 5164 | 2743 |
| 5630 | 2744 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 2745 { |
| 5322 | 2746 if (work[k] != 0.) |
| 5164 | 2747 { |
| 5322 | 2748 octave_idx_type minr = nr; |
| 2749 octave_idx_type mini = 0; | |
| 2750 | |
| 2751 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 2752 if (perm[ridx(i)] < minr) | |
| 2753 { | |
| 2754 minr = perm[ridx(i)]; | |
| 2755 mini = i; | |
| 2756 } | |
| 2757 | |
| 5681 | 2758 if (minr != k || data(mini) == 0) |
| 5164 | 2759 { |
| 2760 err = -2; | |
| 2761 goto triangular_error; | |
| 2762 } | |
| 2763 | |
| 5322 | 2764 double tmp = work[k] / data(mini); |
| 2765 work[k] = tmp; | |
| 2766 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 2767 { |
| 5322 | 2768 if (i == mini) |
| 2769 continue; | |
| 2770 | |
| 2771 octave_idx_type iidx = perm[ridx(i)]; | |
| 2772 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2773 } |
| 2774 } | |
| 2775 } | |
| 2776 | |
| 5630 | 2777 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2778 retval (i, j) = work[i]; |
| 5164 | 2779 } |
| 2780 | |
| 5681 | 2781 if (calc_cond) |
| 2782 { | |
| 2783 // Calculation of 1-norm of inv(*this) | |
| 2784 for (octave_idx_type i = 0; i < nm; i++) | |
| 2785 work[i] = 0.; | |
| 2786 | |
| 2787 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2788 { |
| 5681 | 2789 work[j] = 1.; |
| 2790 | |
| 2791 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2792 { |
| 5681 | 2793 if (work[k] != 0.) |
| 5164 | 2794 { |
| 5681 | 2795 octave_idx_type minr = nr; |
| 2796 octave_idx_type mini = 0; | |
| 2797 | |
| 2798 for (octave_idx_type i = cidx(k); | |
| 2799 i < cidx(k+1); i++) | |
| 2800 if (perm[ridx(i)] < minr) | |
| 2801 { | |
| 2802 minr = perm[ridx(i)]; | |
| 2803 mini = i; | |
| 2804 } | |
| 2805 | |
| 2806 double tmp = work[k] / data(mini); | |
| 2807 work[k] = tmp; | |
| 2808 for (octave_idx_type i = cidx(k); | |
| 2809 i < cidx(k+1); i++) | |
| 2810 { | |
| 2811 if (i == mini) | |
| 2812 continue; | |
| 2813 | |
| 2814 octave_idx_type iidx = perm[ridx(i)]; | |
| 2815 work[iidx] = work[iidx] - tmp * data(i); | |
| 2816 } | |
| 5164 | 2817 } |
| 2818 } | |
| 5681 | 2819 |
| 2820 double atmp = 0; | |
| 2821 for (octave_idx_type i = j; i < nc; i++) | |
| 2822 { | |
| 2823 atmp += fabs(work[i]); | |
| 2824 work[i] = 0.; | |
| 2825 } | |
| 2826 if (atmp > ainvnorm) | |
| 2827 ainvnorm = atmp; | |
| 5164 | 2828 } |
| 5681 | 2829 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2830 } |
| 2831 } | |
| 2832 else | |
| 2833 { | |
| 5630 | 2834 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 2835 retval.resize (nc, b_nc, 0.); | |
| 2836 | |
| 2837 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 2838 { |
| 5630 | 2839 for (octave_idx_type i = 0; i < nr; i++) |
| 2840 work[i] = b(i,j); | |
| 2841 for (octave_idx_type i = nr; i < nc; i++) | |
| 2842 work[i] = 0.; | |
| 2843 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2844 { |
| 5630 | 2845 if (work[k] != 0.) |
| 5164 | 2846 { |
| 5681 | 2847 if (ridx(cidx(k)) != k || |
| 2848 data(cidx(k)) == 0.) | |
| 5164 | 2849 { |
| 2850 err = -2; | |
| 2851 goto triangular_error; | |
| 2852 } | |
| 2853 | |
| 5630 | 2854 double tmp = work[k] / data(cidx(k)); |
| 2855 work[k] = tmp; | |
| 2856 for (octave_idx_type i = cidx(k)+1; | |
| 2857 i < cidx(k+1); i++) | |
| 5164 | 2858 { |
| 5275 | 2859 octave_idx_type iidx = ridx(i); |
| 5630 | 2860 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 2861 } |
| 2862 } | |
| 2863 } | |
| 5630 | 2864 |
| 2865 for (octave_idx_type i = 0; i < nc; i++) | |
| 2866 retval.xelem (i, j) = work[i]; | |
| 5164 | 2867 } |
| 2868 | |
| 5681 | 2869 if (calc_cond) |
| 2870 { | |
| 2871 // Calculation of 1-norm of inv(*this) | |
| 2872 for (octave_idx_type i = 0; i < nm; i++) | |
| 2873 work[i] = 0.; | |
| 2874 | |
| 2875 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2876 { |
| 5681 | 2877 work[j] = 1.; |
| 2878 | |
| 2879 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 2880 { |
| 5681 | 2881 |
| 2882 if (work[k] != 0.) | |
| 5164 | 2883 { |
| 5681 | 2884 double tmp = work[k] / data(cidx(k)); |
| 2885 work[k] = tmp; | |
| 2886 for (octave_idx_type i = cidx(k)+1; | |
| 2887 i < cidx(k+1); i++) | |
| 2888 { | |
| 2889 octave_idx_type iidx = ridx(i); | |
| 2890 work[iidx] = work[iidx] - tmp * data(i); | |
| 2891 } | |
| 5164 | 2892 } |
| 2893 } | |
| 5681 | 2894 double atmp = 0; |
| 2895 for (octave_idx_type i = j; i < nc; i++) | |
| 2896 { | |
| 2897 atmp += fabs(work[i]); | |
| 2898 work[i] = 0.; | |
| 2899 } | |
| 2900 if (atmp > ainvnorm) | |
| 2901 ainvnorm = atmp; | |
| 5164 | 2902 } |
| 5681 | 2903 rcond = 1. / ainvnorm / anorm; |
| 2904 } | |
| 2905 } | |
| 5164 | 2906 |
| 2907 triangular_error: | |
| 2908 if (err != 0) | |
| 2909 { | |
| 2910 if (sing_handler) | |
| 5681 | 2911 { |
| 2912 sing_handler (rcond); | |
| 2913 mattype.mark_as_rectangular (); | |
| 2914 } | |
| 5164 | 2915 else |
| 2916 (*current_liboctave_error_handler) | |
| 2917 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2918 rcond); | |
| 2919 } | |
| 2920 | |
| 2921 volatile double rcond_plus_one = rcond + 1.0; | |
| 2922 | |
| 2923 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2924 { | |
| 2925 err = -2; | |
| 2926 | |
| 2927 if (sing_handler) | |
| 5681 | 2928 { |
| 2929 sing_handler (rcond); | |
| 2930 mattype.mark_as_rectangular (); | |
| 2931 } | |
| 5164 | 2932 else |
| 2933 (*current_liboctave_error_handler) | |
| 2934 ("matrix singular to machine precision, rcond = %g", | |
| 2935 rcond); | |
| 2936 } | |
| 2937 } | |
| 2938 else | |
| 2939 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2940 } | |
| 2941 | |
| 2942 return retval; | |
| 2943 } | |
| 2944 | |
| 2945 SparseMatrix | |
| 5785 | 2946 SparseMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 2947 octave_idx_type& err, double& rcond, |
| 5681 | 2948 solve_singularity_handler sing_handler, |
| 2949 bool calc_cond) const | |
| 5164 | 2950 { |
| 2951 SparseMatrix retval; | |
| 2952 | |
| 5275 | 2953 octave_idx_type nr = rows (); |
| 2954 octave_idx_type nc = cols (); | |
| 5630 | 2955 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2956 err = 0; |
| 2957 | |
| 6924 | 2958 if (nr != b.rows ()) |
| 5164 | 2959 (*current_liboctave_error_handler) |
| 2960 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2961 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2962 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 2963 else |
| 2964 { | |
| 2965 // Print spparms("spumoni") info if requested | |
| 2966 int typ = mattype.type (); | |
| 2967 mattype.info (); | |
| 2968 | |
| 5785 | 2969 if (typ == MatrixType::Permuted_Lower || |
| 2970 typ == MatrixType::Lower) | |
| 5164 | 2971 { |
| 2972 double anorm = 0.; | |
| 2973 double ainvnorm = 0.; | |
| 5681 | 2974 rcond = 1.; |
| 2975 | |
| 2976 if (calc_cond) | |
| 2977 { | |
| 2978 // Calculate the 1-norm of matrix for rcond calculation | |
| 2979 for (octave_idx_type j = 0; j < nc; j++) | |
| 2980 { | |
| 2981 double atmp = 0.; | |
| 2982 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2983 atmp += fabs(data(i)); | |
| 2984 if (atmp > anorm) | |
| 2985 anorm = atmp; | |
| 2986 } | |
| 2987 } | |
| 2988 | |
| 5275 | 2989 octave_idx_type b_nc = b.cols (); |
| 5681 | 2990 octave_idx_type b_nz = b.nnz (); |
| 2991 retval = SparseMatrix (nc, b_nc, b_nz); | |
| 5164 | 2992 retval.xcidx(0) = 0; |
| 5275 | 2993 octave_idx_type ii = 0; |
| 2994 octave_idx_type x_nz = b_nz; | |
| 5164 | 2995 |
| 5785 | 2996 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 2997 { |
| 5681 | 2998 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5322 | 2999 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3000 |
| 5275 | 3001 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3002 { |
| 5630 | 3003 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 3004 work[i] = 0.; |
| 5275 | 3005 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 3006 work[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 3007 |
| 5630 | 3008 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3009 { |
| 5322 | 3010 if (work[k] != 0.) |
| 5164 | 3011 { |
| 5322 | 3012 octave_idx_type minr = nr; |
| 3013 octave_idx_type mini = 0; | |
| 3014 | |
| 3015 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3016 if (perm[ridx(i)] < minr) | |
| 3017 { | |
| 3018 minr = perm[ridx(i)]; | |
| 3019 mini = i; | |
| 3020 } | |
| 3021 | |
| 5681 | 3022 if (minr != k || data(mini) == 0) |
| 5164 | 3023 { |
| 3024 err = -2; | |
| 3025 goto triangular_error; | |
| 3026 } | |
| 3027 | |
| 5322 | 3028 double tmp = work[k] / data(mini); |
| 3029 work[k] = tmp; | |
| 3030 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3031 { |
| 5322 | 3032 if (i == mini) |
| 3033 continue; | |
| 3034 | |
| 3035 octave_idx_type iidx = perm[ridx(i)]; | |
| 3036 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 3037 } |
| 3038 } | |
| 3039 } | |
| 3040 | |
| 3041 // Count non-zeros in work vector and adjust space in | |
| 3042 // retval if needed | |
| 5275 | 3043 octave_idx_type new_nnz = 0; |
| 5630 | 3044 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3045 if (work[i] != 0.) |
| 3046 new_nnz++; | |
| 3047 | |
| 3048 if (ii + new_nnz > x_nz) | |
| 3049 { | |
| 3050 // Resize the sparse matrix | |
| 5275 | 3051 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3052 retval.change_capacity (sz); |
| 3053 x_nz = sz; | |
| 3054 } | |
| 3055 | |
| 5630 | 3056 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3057 if (work[i] != 0.) |
| 5164 | 3058 { |
| 3059 retval.xridx(ii) = i; | |
| 5322 | 3060 retval.xdata(ii++) = work[i]; |
| 5164 | 3061 } |
| 3062 retval.xcidx(j+1) = ii; | |
| 3063 } | |
| 3064 | |
| 3065 retval.maybe_compress (); | |
| 3066 | |
| 5681 | 3067 if (calc_cond) |
| 3068 { | |
| 3069 // Calculation of 1-norm of inv(*this) | |
| 3070 for (octave_idx_type i = 0; i < nm; i++) | |
| 3071 work[i] = 0.; | |
| 3072 | |
| 3073 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3074 { |
| 5681 | 3075 work[j] = 1.; |
| 3076 | |
| 3077 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3078 { |
| 5681 | 3079 if (work[k] != 0.) |
| 5164 | 3080 { |
| 5681 | 3081 octave_idx_type minr = nr; |
| 3082 octave_idx_type mini = 0; | |
| 3083 | |
| 3084 for (octave_idx_type i = cidx(k); | |
| 3085 i < cidx(k+1); i++) | |
| 3086 if (perm[ridx(i)] < minr) | |
| 3087 { | |
| 3088 minr = perm[ridx(i)]; | |
| 3089 mini = i; | |
| 3090 } | |
| 3091 | |
| 3092 double tmp = work[k] / data(mini); | |
| 3093 work[k] = tmp; | |
| 3094 for (octave_idx_type i = cidx(k); | |
| 3095 i < cidx(k+1); i++) | |
| 3096 { | |
| 3097 if (i == mini) | |
| 3098 continue; | |
| 3099 | |
| 3100 octave_idx_type iidx = perm[ridx(i)]; | |
| 3101 work[iidx] = work[iidx] - tmp * data(i); | |
| 3102 } | |
| 5164 | 3103 } |
| 3104 } | |
| 5681 | 3105 |
| 3106 double atmp = 0; | |
| 3107 for (octave_idx_type i = j; i < nr; i++) | |
| 3108 { | |
| 3109 atmp += fabs(work[i]); | |
| 3110 work[i] = 0.; | |
| 3111 } | |
| 3112 if (atmp > ainvnorm) | |
| 3113 ainvnorm = atmp; | |
| 5164 | 3114 } |
| 5681 | 3115 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3116 } |
| 3117 } | |
| 3118 else | |
| 3119 { | |
| 5681 | 3120 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5164 | 3121 |
| 5275 | 3122 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3123 { |
| 5630 | 3124 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 3125 work[i] = 0.; |
| 5275 | 3126 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 3127 work[b.ridx(i)] = b.data(i); |
| 3128 | |
| 5630 | 3129 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3130 { |
| 3131 if (work[k] != 0.) | |
| 3132 { | |
| 5681 | 3133 if (ridx(cidx(k)) != k || |
| 3134 data(cidx(k)) == 0.) | |
| 5164 | 3135 { |
| 3136 err = -2; | |
| 3137 goto triangular_error; | |
| 3138 } | |
| 3139 | |
| 3140 double tmp = work[k] / data(cidx(k)); | |
| 3141 work[k] = tmp; | |
| 5275 | 3142 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3143 { |
| 5275 | 3144 octave_idx_type iidx = ridx(i); |
| 5164 | 3145 work[iidx] = work[iidx] - tmp * data(i); |
| 3146 } | |
| 3147 } | |
| 3148 } | |
| 3149 | |
| 3150 // Count non-zeros in work vector and adjust space in | |
| 3151 // retval if needed | |
| 5275 | 3152 octave_idx_type new_nnz = 0; |
| 5630 | 3153 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3154 if (work[i] != 0.) |
| 3155 new_nnz++; | |
| 3156 | |
| 3157 if (ii + new_nnz > x_nz) | |
| 3158 { | |
| 3159 // Resize the sparse matrix | |
| 5275 | 3160 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3161 retval.change_capacity (sz); |
| 3162 x_nz = sz; | |
| 3163 } | |
| 3164 | |
| 5630 | 3165 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3166 if (work[i] != 0.) |
| 3167 { | |
| 3168 retval.xridx(ii) = i; | |
| 3169 retval.xdata(ii++) = work[i]; | |
| 3170 } | |
| 3171 retval.xcidx(j+1) = ii; | |
| 3172 } | |
| 3173 | |
| 3174 retval.maybe_compress (); | |
| 3175 | |
| 5681 | 3176 if (calc_cond) |
| 3177 { | |
| 3178 // Calculation of 1-norm of inv(*this) | |
| 3179 for (octave_idx_type i = 0; i < nm; i++) | |
| 3180 work[i] = 0.; | |
| 3181 | |
| 3182 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3183 { |
| 5681 | 3184 work[j] = 1.; |
| 3185 | |
| 3186 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3187 { |
| 5681 | 3188 |
| 3189 if (work[k] != 0.) | |
| 5164 | 3190 { |
| 5681 | 3191 double tmp = work[k] / data(cidx(k)); |
| 3192 work[k] = tmp; | |
| 3193 for (octave_idx_type i = cidx(k)+1; | |
| 3194 i < cidx(k+1); i++) | |
| 3195 { | |
| 3196 octave_idx_type iidx = ridx(i); | |
| 3197 work[iidx] = work[iidx] - tmp * data(i); | |
| 3198 } | |
| 5164 | 3199 } |
| 3200 } | |
| 5681 | 3201 double atmp = 0; |
| 3202 for (octave_idx_type i = j; i < nc; i++) | |
| 3203 { | |
| 3204 atmp += fabs(work[i]); | |
| 3205 work[i] = 0.; | |
| 3206 } | |
| 3207 if (atmp > ainvnorm) | |
| 3208 ainvnorm = atmp; | |
| 5164 | 3209 } |
| 5681 | 3210 rcond = 1. / ainvnorm / anorm; |
| 3211 } | |
| 3212 } | |
| 5164 | 3213 |
| 3214 triangular_error: | |
| 3215 if (err != 0) | |
| 3216 { | |
| 3217 if (sing_handler) | |
| 5681 | 3218 { |
| 3219 sing_handler (rcond); | |
| 3220 mattype.mark_as_rectangular (); | |
| 3221 } | |
| 5164 | 3222 else |
| 3223 (*current_liboctave_error_handler) | |
| 3224 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3225 rcond); | |
| 3226 } | |
| 3227 | |
| 3228 volatile double rcond_plus_one = rcond + 1.0; | |
| 3229 | |
| 3230 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3231 { | |
| 3232 err = -2; | |
| 3233 | |
| 3234 if (sing_handler) | |
| 5681 | 3235 { |
| 3236 sing_handler (rcond); | |
| 3237 mattype.mark_as_rectangular (); | |
| 3238 } | |
| 5164 | 3239 else |
| 3240 (*current_liboctave_error_handler) | |
| 3241 ("matrix singular to machine precision, rcond = %g", | |
| 3242 rcond); | |
| 3243 } | |
| 3244 } | |
| 3245 else | |
| 3246 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3247 } | |
| 3248 | |
| 3249 return retval; | |
| 3250 } | |
| 3251 | |
| 3252 ComplexMatrix | |
| 5785 | 3253 SparseMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 3254 octave_idx_type& err, double& rcond, |
| 5681 | 3255 solve_singularity_handler sing_handler, |
| 3256 bool calc_cond) const | |
| 5164 | 3257 { |
| 3258 ComplexMatrix retval; | |
| 3259 | |
| 5275 | 3260 octave_idx_type nr = rows (); |
| 3261 octave_idx_type nc = cols (); | |
| 5630 | 3262 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3263 err = 0; |
| 3264 | |
| 6924 | 3265 if (nr != b.rows ()) |
| 5164 | 3266 (*current_liboctave_error_handler) |
| 3267 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3268 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3269 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 3270 else |
| 3271 { | |
| 3272 // Print spparms("spumoni") info if requested | |
| 3273 int typ = mattype.type (); | |
| 3274 mattype.info (); | |
| 3275 | |
| 5785 | 3276 if (typ == MatrixType::Permuted_Lower || |
| 3277 typ == MatrixType::Lower) | |
| 5164 | 3278 { |
| 3279 double anorm = 0.; | |
| 3280 double ainvnorm = 0.; | |
| 5275 | 3281 octave_idx_type b_nc = b.cols (); |
| 5681 | 3282 rcond = 1.; |
| 3283 | |
| 3284 if (calc_cond) | |
| 3285 { | |
| 3286 // Calculate the 1-norm of matrix for rcond calculation | |
| 3287 for (octave_idx_type j = 0; j < nc; j++) | |
| 3288 { | |
| 3289 double atmp = 0.; | |
| 3290 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3291 atmp += fabs(data(i)); | |
| 3292 if (atmp > anorm) | |
| 3293 anorm = atmp; | |
| 3294 } | |
| 5164 | 3295 } |
| 3296 | |
| 5785 | 3297 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3298 { |
| 5630 | 3299 retval.resize (nc, b_nc); |
| 5681 | 3300 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5322 | 3301 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3302 |
| 5275 | 3303 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3304 { |
| 5630 | 3305 for (octave_idx_type i = 0; i < nm; i++) |
| 3306 cwork[i] = 0.; | |
| 5275 | 3307 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 3308 cwork[perm[i]] = b(i,j); |
| 5164 | 3309 |
| 5630 | 3310 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3311 { |
| 5322 | 3312 if (cwork[k] != 0.) |
| 5164 | 3313 { |
| 5322 | 3314 octave_idx_type minr = nr; |
| 3315 octave_idx_type mini = 0; | |
| 3316 | |
| 3317 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3318 if (perm[ridx(i)] < minr) | |
| 3319 { | |
| 3320 minr = perm[ridx(i)]; | |
| 3321 mini = i; | |
| 3322 } | |
| 3323 | |
| 5681 | 3324 if (minr != k || data(mini) == 0) |
| 5164 | 3325 { |
| 3326 err = -2; | |
| 3327 goto triangular_error; | |
| 3328 } | |
| 3329 | |
| 5322 | 3330 Complex tmp = cwork[k] / data(mini); |
| 3331 cwork[k] = tmp; | |
| 3332 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3333 { |
| 5322 | 3334 if (i == mini) |
| 3335 continue; | |
| 3336 | |
| 3337 octave_idx_type iidx = perm[ridx(i)]; | |
| 3338 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 3339 } |
| 3340 } | |
| 3341 } | |
| 3342 | |
| 5630 | 3343 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3344 retval (i, j) = cwork[i]; |
| 5164 | 3345 } |
| 3346 | |
| 5681 | 3347 if (calc_cond) |
| 3348 { | |
| 3349 // Calculation of 1-norm of inv(*this) | |
| 3350 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3351 for (octave_idx_type i = 0; i < nm; i++) | |
| 3352 work[i] = 0.; | |
| 3353 | |
| 3354 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3355 { |
| 5681 | 3356 work[j] = 1.; |
| 3357 | |
| 3358 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3359 { |
| 5681 | 3360 if (work[k] != 0.) |
| 5164 | 3361 { |
| 5681 | 3362 octave_idx_type minr = nr; |
| 3363 octave_idx_type mini = 0; | |
| 3364 | |
| 3365 for (octave_idx_type i = cidx(k); | |
| 3366 i < cidx(k+1); i++) | |
| 3367 if (perm[ridx(i)] < minr) | |
| 3368 { | |
| 3369 minr = perm[ridx(i)]; | |
| 3370 mini = i; | |
| 3371 } | |
| 3372 | |
| 3373 double tmp = work[k] / data(mini); | |
| 3374 work[k] = tmp; | |
| 3375 for (octave_idx_type i = cidx(k); | |
| 3376 i < cidx(k+1); i++) | |
| 3377 { | |
| 3378 if (i == mini) | |
| 3379 continue; | |
| 3380 | |
| 3381 octave_idx_type iidx = perm[ridx(i)]; | |
| 3382 work[iidx] = work[iidx] - tmp * data(i); | |
| 3383 } | |
| 5164 | 3384 } |
| 3385 } | |
| 5681 | 3386 |
| 3387 double atmp = 0; | |
| 3388 for (octave_idx_type i = j; i < nc; i++) | |
| 3389 { | |
| 3390 atmp += fabs(work[i]); | |
| 3391 work[i] = 0.; | |
| 3392 } | |
| 3393 if (atmp > ainvnorm) | |
| 3394 ainvnorm = atmp; | |
| 5164 | 3395 } |
| 5681 | 3396 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3397 } |
| 3398 } | |
| 3399 else | |
| 3400 { | |
| 5630 | 3401 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 3402 retval.resize (nc, b_nc, 0.); | |
| 5164 | 3403 |
| 5275 | 3404 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3405 { |
| 5630 | 3406 for (octave_idx_type i = 0; i < nr; i++) |
| 3407 cwork[i] = b(i,j); | |
| 3408 for (octave_idx_type i = nr; i < nc; i++) | |
| 3409 cwork[i] = 0.; | |
| 3410 | |
| 3411 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3412 { |
| 5630 | 3413 if (cwork[k] != 0.) |
| 5164 | 3414 { |
| 5681 | 3415 if (ridx(cidx(k)) != k || |
| 3416 data(cidx(k)) == 0.) | |
| 5164 | 3417 { |
| 3418 err = -2; | |
| 3419 goto triangular_error; | |
| 3420 } | |
| 3421 | |
| 5630 | 3422 Complex tmp = cwork[k] / data(cidx(k)); |
| 3423 cwork[k] = tmp; | |
| 5275 | 3424 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3425 { |
| 5275 | 3426 octave_idx_type iidx = ridx(i); |
| 5630 | 3427 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 3428 } |
| 3429 } | |
| 3430 } | |
| 5630 | 3431 |
| 3432 for (octave_idx_type i = 0; i < nc; i++) | |
| 3433 retval.xelem (i, j) = cwork[i]; | |
| 5164 | 3434 } |
| 3435 | |
| 5681 | 3436 if (calc_cond) |
| 3437 { | |
| 3438 // Calculation of 1-norm of inv(*this) | |
| 3439 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3440 for (octave_idx_type i = 0; i < nm; i++) | |
| 3441 work[i] = 0.; | |
| 3442 | |
| 3443 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3444 { |
| 5681 | 3445 work[j] = 1.; |
| 3446 | |
| 3447 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3448 { |
| 5681 | 3449 |
| 3450 if (work[k] != 0.) | |
| 5164 | 3451 { |
| 5681 | 3452 double tmp = work[k] / data(cidx(k)); |
| 3453 work[k] = tmp; | |
| 3454 for (octave_idx_type i = cidx(k)+1; | |
| 3455 i < cidx(k+1); i++) | |
| 3456 { | |
| 3457 octave_idx_type iidx = ridx(i); | |
| 3458 work[iidx] = work[iidx] - tmp * data(i); | |
| 3459 } | |
| 5164 | 3460 } |
| 3461 } | |
| 5681 | 3462 double atmp = 0; |
| 3463 for (octave_idx_type i = j; i < nc; i++) | |
| 3464 { | |
| 3465 atmp += fabs(work[i]); | |
| 3466 work[i] = 0.; | |
| 3467 } | |
| 3468 if (atmp > ainvnorm) | |
| 3469 ainvnorm = atmp; | |
| 5164 | 3470 } |
| 5681 | 3471 rcond = 1. / ainvnorm / anorm; |
| 3472 } | |
| 3473 } | |
| 5164 | 3474 |
| 3475 triangular_error: | |
| 3476 if (err != 0) | |
| 3477 { | |
| 3478 if (sing_handler) | |
| 5681 | 3479 { |
| 3480 sing_handler (rcond); | |
| 3481 mattype.mark_as_rectangular (); | |
| 3482 } | |
| 5164 | 3483 else |
| 3484 (*current_liboctave_error_handler) | |
| 3485 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3486 rcond); | |
| 3487 } | |
| 3488 | |
| 3489 volatile double rcond_plus_one = rcond + 1.0; | |
| 3490 | |
| 3491 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3492 { | |
| 3493 err = -2; | |
| 3494 | |
| 3495 if (sing_handler) | |
| 5681 | 3496 { |
| 3497 sing_handler (rcond); | |
| 3498 mattype.mark_as_rectangular (); | |
| 3499 } | |
| 5164 | 3500 else |
| 3501 (*current_liboctave_error_handler) | |
| 3502 ("matrix singular to machine precision, rcond = %g", | |
| 3503 rcond); | |
| 3504 } | |
| 3505 } | |
| 3506 else | |
| 3507 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3508 } | |
| 3509 | |
| 3510 return retval; | |
| 3511 } | |
| 3512 | |
| 3513 SparseComplexMatrix | |
| 5785 | 3514 SparseMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 3515 octave_idx_type& err, double& rcond, |
| 5681 | 3516 solve_singularity_handler sing_handler, |
| 3517 bool calc_cond) const | |
| 5164 | 3518 { |
| 3519 SparseComplexMatrix retval; | |
| 3520 | |
| 5275 | 3521 octave_idx_type nr = rows (); |
| 3522 octave_idx_type nc = cols (); | |
| 5630 | 3523 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3524 err = 0; |
| 3525 | |
| 6924 | 3526 if (nr != b.rows ()) |
| 5164 | 3527 (*current_liboctave_error_handler) |
| 3528 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3529 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3530 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 3531 else |
| 3532 { | |
| 3533 // Print spparms("spumoni") info if requested | |
| 3534 int typ = mattype.type (); | |
| 3535 mattype.info (); | |
| 3536 | |
| 5785 | 3537 if (typ == MatrixType::Permuted_Lower || |
| 3538 typ == MatrixType::Lower) | |
| 5164 | 3539 { |
| 3540 double anorm = 0.; | |
| 3541 double ainvnorm = 0.; | |
| 5681 | 3542 rcond = 1.; |
| 3543 | |
| 3544 if (calc_cond) | |
| 3545 { | |
| 3546 // Calculate the 1-norm of matrix for rcond calculation | |
| 3547 for (octave_idx_type j = 0; j < nc; j++) | |
| 3548 { | |
| 3549 double atmp = 0.; | |
| 3550 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3551 atmp += fabs(data(i)); | |
| 3552 if (atmp > anorm) | |
| 3553 anorm = atmp; | |
| 3554 } | |
| 5164 | 3555 } |
| 3556 | |
| 5275 | 3557 octave_idx_type b_nc = b.cols (); |
| 5681 | 3558 octave_idx_type b_nz = b.nnz (); |
| 5630 | 3559 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 3560 retval.xcidx(0) = 0; |
| 5275 | 3561 octave_idx_type ii = 0; |
| 3562 octave_idx_type x_nz = b_nz; | |
| 5164 | 3563 |
| 5785 | 3564 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3565 { |
| 5630 | 3566 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5322 | 3567 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3568 |
| 5275 | 3569 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3570 { |
| 5630 | 3571 for (octave_idx_type i = 0; i < nm; i++) |
| 5322 | 3572 cwork[i] = 0.; |
| 5275 | 3573 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 3574 cwork[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 3575 |
| 5630 | 3576 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3577 { |
| 5322 | 3578 if (cwork[k] != 0.) |
| 5164 | 3579 { |
| 5322 | 3580 octave_idx_type minr = nr; |
| 3581 octave_idx_type mini = 0; | |
| 3582 | |
| 3583 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3584 if (perm[ridx(i)] < minr) | |
| 3585 { | |
| 3586 minr = perm[ridx(i)]; | |
| 3587 mini = i; | |
| 3588 } | |
| 3589 | |
| 5681 | 3590 if (minr != k || data(mini) == 0) |
| 5164 | 3591 { |
| 3592 err = -2; | |
| 3593 goto triangular_error; | |
| 3594 } | |
| 3595 | |
| 5322 | 3596 Complex tmp = cwork[k] / data(mini); |
| 3597 cwork[k] = tmp; | |
| 3598 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3599 { |
| 5322 | 3600 if (i == mini) |
| 3601 continue; | |
| 3602 | |
| 3603 octave_idx_type iidx = perm[ridx(i)]; | |
| 3604 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 3605 } |
| 3606 } | |
| 3607 } | |
| 3608 | |
| 3609 // Count non-zeros in work vector and adjust space in | |
| 3610 // retval if needed | |
| 5275 | 3611 octave_idx_type new_nnz = 0; |
| 5630 | 3612 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3613 if (cwork[i] != 0.) |
| 5164 | 3614 new_nnz++; |
| 3615 | |
| 3616 if (ii + new_nnz > x_nz) | |
| 3617 { | |
| 3618 // Resize the sparse matrix | |
| 5275 | 3619 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3620 retval.change_capacity (sz); |
| 3621 x_nz = sz; | |
| 3622 } | |
| 3623 | |
| 5630 | 3624 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3625 if (cwork[i] != 0.) |
| 5164 | 3626 { |
| 3627 retval.xridx(ii) = i; | |
| 5322 | 3628 retval.xdata(ii++) = cwork[i]; |
| 5164 | 3629 } |
| 3630 retval.xcidx(j+1) = ii; | |
| 3631 } | |
| 3632 | |
| 3633 retval.maybe_compress (); | |
| 3634 | |
| 5681 | 3635 if (calc_cond) |
| 3636 { | |
| 3637 // Calculation of 1-norm of inv(*this) | |
| 3638 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3639 for (octave_idx_type i = 0; i < nm; i++) | |
| 3640 work[i] = 0.; | |
| 3641 | |
| 3642 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3643 { |
| 5681 | 3644 work[j] = 1.; |
| 3645 | |
| 3646 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3647 { |
| 5681 | 3648 if (work[k] != 0.) |
| 5164 | 3649 { |
| 5681 | 3650 octave_idx_type minr = nr; |
| 3651 octave_idx_type mini = 0; | |
| 3652 | |
| 3653 for (octave_idx_type i = cidx(k); | |
| 3654 i < cidx(k+1); i++) | |
| 3655 if (perm[ridx(i)] < minr) | |
| 3656 { | |
| 3657 minr = perm[ridx(i)]; | |
| 3658 mini = i; | |
| 3659 } | |
| 3660 | |
| 3661 double tmp = work[k] / data(mini); | |
| 3662 work[k] = tmp; | |
| 3663 for (octave_idx_type i = cidx(k); | |
| 3664 i < cidx(k+1); i++) | |
| 3665 { | |
| 3666 if (i == mini) | |
| 3667 continue; | |
| 3668 | |
| 3669 octave_idx_type iidx = perm[ridx(i)]; | |
| 3670 work[iidx] = work[iidx] - tmp * data(i); | |
| 3671 } | |
| 5164 | 3672 } |
| 3673 } | |
| 5681 | 3674 |
| 3675 double atmp = 0; | |
| 3676 for (octave_idx_type i = j; i < nc; i++) | |
| 3677 { | |
| 3678 atmp += fabs(work[i]); | |
| 3679 work[i] = 0.; | |
| 3680 } | |
| 3681 if (atmp > ainvnorm) | |
| 3682 ainvnorm = atmp; | |
| 5164 | 3683 } |
| 5681 | 3684 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3685 } |
| 3686 } | |
| 3687 else | |
| 3688 { | |
| 5630 | 3689 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 3690 |
| 5275 | 3691 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3692 { |
| 5630 | 3693 for (octave_idx_type i = 0; i < nm; i++) |
| 3694 cwork[i] = 0.; | |
| 5275 | 3695 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5630 | 3696 cwork[b.ridx(i)] = b.data(i); |
| 3697 | |
| 3698 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3699 { |
| 5630 | 3700 if (cwork[k] != 0.) |
| 5164 | 3701 { |
| 5681 | 3702 if (ridx(cidx(k)) != k || |
| 3703 data(cidx(k)) == 0.) | |
| 5164 | 3704 { |
| 3705 err = -2; | |
| 3706 goto triangular_error; | |
| 3707 } | |
| 3708 | |
| 5630 | 3709 Complex tmp = cwork[k] / data(cidx(k)); |
| 3710 cwork[k] = tmp; | |
| 5275 | 3711 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3712 { |
| 5275 | 3713 octave_idx_type iidx = ridx(i); |
| 5630 | 3714 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 3715 } |
| 3716 } | |
| 3717 } | |
| 3718 | |
| 3719 // Count non-zeros in work vector and adjust space in | |
| 3720 // retval if needed | |
| 5275 | 3721 octave_idx_type new_nnz = 0; |
| 5630 | 3722 for (octave_idx_type i = 0; i < nc; i++) |
| 3723 if (cwork[i] != 0.) | |
| 5164 | 3724 new_nnz++; |
| 3725 | |
| 3726 if (ii + new_nnz > x_nz) | |
| 3727 { | |
| 3728 // Resize the sparse matrix | |
| 5275 | 3729 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3730 retval.change_capacity (sz); |
| 3731 x_nz = sz; | |
| 3732 } | |
| 3733 | |
| 5630 | 3734 for (octave_idx_type i = 0; i < nc; i++) |
| 3735 if (cwork[i] != 0.) | |
| 5164 | 3736 { |
| 3737 retval.xridx(ii) = i; | |
| 5630 | 3738 retval.xdata(ii++) = cwork[i]; |
| 5164 | 3739 } |
| 3740 retval.xcidx(j+1) = ii; | |
| 3741 } | |
| 3742 | |
| 3743 retval.maybe_compress (); | |
| 3744 | |
| 5681 | 3745 if (calc_cond) |
| 3746 { | |
| 3747 // Calculation of 1-norm of inv(*this) | |
| 3748 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3749 for (octave_idx_type i = 0; i < nm; i++) | |
| 3750 work[i] = 0.; | |
| 3751 | |
| 3752 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3753 { |
| 5681 | 3754 work[j] = 1.; |
| 3755 | |
| 3756 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3757 { |
| 5681 | 3758 |
| 3759 if (work[k] != 0.) | |
| 5164 | 3760 { |
| 5681 | 3761 double tmp = work[k] / data(cidx(k)); |
| 3762 work[k] = tmp; | |
| 3763 for (octave_idx_type i = cidx(k)+1; | |
| 3764 i < cidx(k+1); i++) | |
| 3765 { | |
| 3766 octave_idx_type iidx = ridx(i); | |
| 3767 work[iidx] = work[iidx] - tmp * data(i); | |
| 3768 } | |
| 5164 | 3769 } |
| 3770 } | |
| 5681 | 3771 double atmp = 0; |
| 3772 for (octave_idx_type i = j; i < nc; i++) | |
| 3773 { | |
| 3774 atmp += fabs(work[i]); | |
| 3775 work[i] = 0.; | |
| 3776 } | |
| 3777 if (atmp > ainvnorm) | |
| 3778 ainvnorm = atmp; | |
| 5164 | 3779 } |
| 5681 | 3780 rcond = 1. / ainvnorm / anorm; |
| 3781 } | |
| 3782 } | |
| 5164 | 3783 |
| 3784 triangular_error: | |
| 3785 if (err != 0) | |
| 3786 { | |
| 3787 if (sing_handler) | |
| 5681 | 3788 { |
| 3789 sing_handler (rcond); | |
| 3790 mattype.mark_as_rectangular (); | |
| 3791 } | |
| 5164 | 3792 else |
| 3793 (*current_liboctave_error_handler) | |
| 3794 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3795 rcond); | |
| 3796 } | |
| 3797 | |
| 3798 volatile double rcond_plus_one = rcond + 1.0; | |
| 3799 | |
| 3800 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3801 { | |
| 3802 err = -2; | |
| 3803 | |
| 3804 if (sing_handler) | |
| 5681 | 3805 { |
| 3806 sing_handler (rcond); | |
| 3807 mattype.mark_as_rectangular (); | |
| 3808 } | |
| 5164 | 3809 else |
| 3810 (*current_liboctave_error_handler) | |
| 3811 ("matrix singular to machine precision, rcond = %g", | |
| 3812 rcond); | |
| 3813 } | |
| 3814 } | |
| 3815 else | |
| 3816 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3817 } | |
| 3818 | |
| 3819 return retval; | |
| 3820 } | |
| 3821 | |
| 3822 Matrix | |
| 5785 | 3823 SparseMatrix::trisolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 3824 octave_idx_type& err, double& rcond, |
| 3825 solve_singularity_handler sing_handler, | |
| 3826 bool calc_cond) const | |
| 5164 | 3827 { |
| 3828 Matrix retval; | |
| 3829 | |
| 5275 | 3830 octave_idx_type nr = rows (); |
| 3831 octave_idx_type nc = cols (); | |
| 5164 | 3832 err = 0; |
| 3833 | |
| 6924 | 3834 if (nr != nc || nr != b.rows ()) |
| 5164 | 3835 (*current_liboctave_error_handler) |
| 3836 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3837 else if (nr == 0 || b.cols () == 0) |
| 3838 retval = Matrix (nc, b.cols (), 0.0); | |
| 5681 | 3839 else if (calc_cond) |
| 3840 (*current_liboctave_error_handler) | |
| 3841 ("calculation of condition number not implemented"); | |
| 5164 | 3842 else |
| 3843 { | |
| 3844 // Print spparms("spumoni") info if requested | |
| 3845 volatile int typ = mattype.type (); | |
| 3846 mattype.info (); | |
| 3847 | |
| 5785 | 3848 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3849 { |
| 3850 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 3851 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 3852 | |
| 3853 if (mattype.is_dense ()) | |
| 3854 { | |
| 5275 | 3855 octave_idx_type ii = 0; |
| 3856 | |
| 3857 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3858 { |
| 3859 D[j] = data(ii++); | |
| 3860 DL[j] = data(ii); | |
| 3861 ii += 2; | |
| 3862 } | |
| 3863 D[nc-1] = data(ii); | |
| 3864 } | |
| 3865 else | |
| 3866 { | |
| 3867 D[0] = 0.; | |
| 5275 | 3868 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3869 { |
| 3870 D[i+1] = 0.; | |
| 3871 DL[i] = 0.; | |
| 3872 } | |
| 3873 | |
| 5275 | 3874 for (octave_idx_type j = 0; j < nc; j++) |
| 3875 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3876 { |
| 3877 if (ridx(i) == j) | |
| 3878 D[j] = data(i); | |
| 3879 else if (ridx(i) == j + 1) | |
| 3880 DL[j] = data(i); | |
| 3881 } | |
| 3882 } | |
| 3883 | |
| 5275 | 3884 octave_idx_type b_nc = b.cols(); |
| 5164 | 3885 retval = b; |
| 3886 double *result = retval.fortran_vec (); | |
| 3887 | |
| 3888 F77_XFCN (dptsv, DPTSV, (nr, b_nc, D, DL, result, | |
| 3889 b.rows(), err)); | |
| 3890 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3891 if (err != 0) |
| 5164 | 3892 { |
| 3893 err = 0; | |
| 3894 mattype.mark_as_unsymmetric (); | |
| 5785 | 3895 typ = MatrixType::Tridiagonal; |
| 5164 | 3896 } |
| 3897 else | |
| 3898 rcond = 1.; | |
| 3899 } | |
| 3900 | |
| 5785 | 3901 if (typ == MatrixType::Tridiagonal) |
| 5164 | 3902 { |
| 3903 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 3904 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 3905 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 3906 | |
| 3907 if (mattype.is_dense ()) | |
| 3908 { | |
| 5275 | 3909 octave_idx_type ii = 0; |
| 3910 | |
| 3911 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3912 { |
| 3913 D[j] = data(ii++); | |
| 3914 DL[j] = data(ii++); | |
| 3915 DU[j] = data(ii++); | |
| 3916 } | |
| 3917 D[nc-1] = data(ii); | |
| 3918 } | |
| 3919 else | |
| 3920 { | |
| 3921 D[0] = 0.; | |
| 5275 | 3922 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3923 { |
| 3924 D[i+1] = 0.; | |
| 3925 DL[i] = 0.; | |
| 3926 DU[i] = 0.; | |
| 3927 } | |
| 3928 | |
| 5275 | 3929 for (octave_idx_type j = 0; j < nc; j++) |
| 3930 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3931 { |
| 3932 if (ridx(i) == j) | |
| 3933 D[j] = data(i); | |
| 3934 else if (ridx(i) == j + 1) | |
| 3935 DL[j] = data(i); | |
| 3936 else if (ridx(i) == j - 1) | |
| 5322 | 3937 DU[j-1] = data(i); |
| 5164 | 3938 } |
| 3939 } | |
| 3940 | |
| 5275 | 3941 octave_idx_type b_nc = b.cols(); |
| 5164 | 3942 retval = b; |
| 3943 double *result = retval.fortran_vec (); | |
| 3944 | |
| 3945 F77_XFCN (dgtsv, DGTSV, (nr, b_nc, DL, D, DU, result, | |
| 3946 b.rows(), err)); | |
| 3947 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3948 if (err != 0) |
| 5164 | 3949 { |
| 3950 rcond = 0.; | |
| 3951 err = -2; | |
| 3952 | |
| 3953 if (sing_handler) | |
| 5681 | 3954 { |
| 3955 sing_handler (rcond); | |
| 3956 mattype.mark_as_rectangular (); | |
| 3957 } | |
| 5164 | 3958 else |
| 3959 (*current_liboctave_error_handler) | |
| 3960 ("matrix singular to machine precision"); | |
| 3961 | |
| 3962 } | |
| 3963 else | |
| 3964 rcond = 1.; | |
| 3965 } | |
| 5785 | 3966 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3967 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 3968 } | |
| 3969 | |
| 3970 return retval; | |
| 3971 } | |
| 3972 | |
| 3973 SparseMatrix | |
| 5785 | 3974 SparseMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 3975 octave_idx_type& err, double& rcond, |
| 3976 solve_singularity_handler sing_handler, | |
| 3977 bool calc_cond) const | |
| 5164 | 3978 { |
| 3979 SparseMatrix retval; | |
| 3980 | |
| 5275 | 3981 octave_idx_type nr = rows (); |
| 3982 octave_idx_type nc = cols (); | |
| 5164 | 3983 err = 0; |
| 3984 | |
| 6924 | 3985 if (nr != nc || nr != b.rows ()) |
| 5164 | 3986 (*current_liboctave_error_handler) |
| 3987 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3988 else if (nr == 0 || b.cols () == 0) |
| 3989 retval = SparseMatrix (nc, b.cols ()); | |
| 5681 | 3990 else if (calc_cond) |
| 3991 (*current_liboctave_error_handler) | |
| 3992 ("calculation of condition number not implemented"); | |
| 5164 | 3993 else |
| 3994 { | |
| 3995 // Print spparms("spumoni") info if requested | |
| 3996 int typ = mattype.type (); | |
| 3997 mattype.info (); | |
| 3998 | |
| 3999 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 4000 if (typ == MatrixType::Tridiagonal || |
| 4001 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 4002 { |
| 4003 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); | |
| 4004 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 4005 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 4006 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 5275 | 4007 Array<octave_idx_type> ipvt (nr); |
| 4008 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4009 |
| 4010 if (mattype.is_dense ()) | |
| 4011 { | |
| 5275 | 4012 octave_idx_type ii = 0; |
| 4013 | |
| 4014 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4015 { |
| 4016 D[j] = data(ii++); | |
| 4017 DL[j] = data(ii++); | |
| 4018 DU[j] = data(ii++); | |
| 4019 } | |
| 4020 D[nc-1] = data(ii); | |
| 4021 } | |
| 4022 else | |
| 4023 { | |
| 4024 D[0] = 0.; | |
| 5275 | 4025 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4026 { |
| 4027 D[i+1] = 0.; | |
| 4028 DL[i] = 0.; | |
| 4029 DU[i] = 0.; | |
| 4030 } | |
| 4031 | |
| 5275 | 4032 for (octave_idx_type j = 0; j < nc; j++) |
| 4033 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4034 { |
| 4035 if (ridx(i) == j) | |
| 4036 D[j] = data(i); | |
| 4037 else if (ridx(i) == j + 1) | |
| 4038 DL[j] = data(i); | |
| 4039 else if (ridx(i) == j - 1) | |
| 5322 | 4040 DU[j-1] = data(i); |
| 5164 | 4041 } |
| 4042 } | |
| 4043 | |
| 4044 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 4045 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4046 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4047 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4048 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4049 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4050 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4051 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4052 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4053 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4054 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4055 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4056 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4057 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4058 ("matrix singular to machine precision"); |
|
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 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4061 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4062 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4063 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4064 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4065 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
|
4066 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4067 retval = SparseMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4068 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4069 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4070 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4071 OCTAVE_LOCAL_BUFFER (double, work, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4072 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4073 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
|
4074 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4075 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
|
4076 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4077 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
|
4078 work[b.ridx(i)] = b.data(i); |
|
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 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4081 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4082 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4083 work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4084 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4085 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4086 // 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
|
4087 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4088 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4089 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
|
4090 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4091 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4092 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4093 if (ii + new_nnz > x_nz) |
| 5164 | 4094 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4095 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4096 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
|
4097 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4098 x_nz = sz; |
| 5164 | 4099 } |
| 4100 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4101 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
|
4102 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4103 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4104 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4105 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4106 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4107 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4108 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4109 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4110 retval.maybe_compress (); |
| 5164 | 4111 } |
| 4112 } | |
| 5785 | 4113 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4114 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4115 } | |
| 4116 | |
| 4117 return retval; | |
| 4118 } | |
| 4119 | |
| 4120 ComplexMatrix | |
| 5785 | 4121 SparseMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 4122 octave_idx_type& err, double& rcond, |
| 4123 solve_singularity_handler sing_handler, | |
| 4124 bool calc_cond) const | |
| 5164 | 4125 { |
| 4126 ComplexMatrix retval; | |
| 4127 | |
| 5275 | 4128 octave_idx_type nr = rows (); |
| 4129 octave_idx_type nc = cols (); | |
| 5164 | 4130 err = 0; |
| 4131 | |
| 6924 | 4132 if (nr != nc || nr != b.rows ()) |
| 5164 | 4133 (*current_liboctave_error_handler) |
| 4134 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4135 else if (nr == 0 || b.cols () == 0) |
| 4136 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5681 | 4137 else if (calc_cond) |
| 4138 (*current_liboctave_error_handler) | |
| 4139 ("calculation of condition number not implemented"); | |
| 5164 | 4140 else |
| 4141 { | |
| 4142 // Print spparms("spumoni") info if requested | |
| 4143 volatile int typ = mattype.type (); | |
| 4144 mattype.info (); | |
| 4145 | |
| 5785 | 4146 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4147 { |
| 5322 | 4148 OCTAVE_LOCAL_BUFFER (double, D, nr); |
| 5164 | 4149 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); |
| 4150 | |
| 4151 if (mattype.is_dense ()) | |
| 4152 { | |
| 5275 | 4153 octave_idx_type ii = 0; |
| 4154 | |
| 4155 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4156 { |
| 4157 D[j] = data(ii++); | |
| 4158 DL[j] = data(ii); | |
| 4159 ii += 2; | |
| 4160 } | |
| 4161 D[nc-1] = data(ii); | |
| 4162 } | |
| 4163 else | |
| 4164 { | |
| 4165 D[0] = 0.; | |
| 5275 | 4166 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4167 { |
| 4168 D[i+1] = 0.; | |
| 4169 DL[i] = 0.; | |
| 4170 } | |
| 4171 | |
| 5275 | 4172 for (octave_idx_type j = 0; j < nc; j++) |
| 4173 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4174 { |
| 4175 if (ridx(i) == j) | |
| 4176 D[j] = data(i); | |
| 4177 else if (ridx(i) == j + 1) | |
| 4178 DL[j] = data(i); | |
| 4179 } | |
| 4180 } | |
| 4181 | |
| 5275 | 4182 octave_idx_type b_nr = b.rows (); |
| 4183 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4184 rcond = 1.; |
| 4185 | |
| 4186 retval = b; | |
| 4187 Complex *result = retval.fortran_vec (); | |
| 4188 | |
| 4189 F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, | |
| 4190 b_nr, err)); | |
| 4191 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4192 if (err != 0) |
| 5164 | 4193 { |
| 4194 err = 0; | |
| 4195 mattype.mark_as_unsymmetric (); | |
| 5785 | 4196 typ = MatrixType::Tridiagonal; |
| 5164 | 4197 } |
| 4198 } | |
| 4199 | |
| 5785 | 4200 if (typ == MatrixType::Tridiagonal) |
| 5164 | 4201 { |
| 4202 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); | |
| 4203 OCTAVE_LOCAL_BUFFER (Complex, D, nr); | |
| 4204 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); | |
| 4205 | |
| 4206 if (mattype.is_dense ()) | |
| 4207 { | |
| 5275 | 4208 octave_idx_type ii = 0; |
| 4209 | |
| 4210 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4211 { |
| 4212 D[j] = data(ii++); | |
| 4213 DL[j] = data(ii++); | |
| 4214 DU[j] = data(ii++); | |
| 4215 } | |
| 4216 D[nc-1] = data(ii); | |
| 4217 } | |
| 4218 else | |
| 4219 { | |
| 4220 D[0] = 0.; | |
| 5275 | 4221 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4222 { |
| 4223 D[i+1] = 0.; | |
| 4224 DL[i] = 0.; | |
| 4225 DU[i] = 0.; | |
| 4226 } | |
| 4227 | |
| 5275 | 4228 for (octave_idx_type j = 0; j < nc; j++) |
| 4229 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4230 { |
| 4231 if (ridx(i) == j) | |
| 4232 D[j] = data(i); | |
| 4233 else if (ridx(i) == j + 1) | |
| 4234 DL[j] = data(i); | |
| 4235 else if (ridx(i) == j - 1) | |
| 5322 | 4236 DU[j-1] = data(i); |
| 5164 | 4237 } |
| 4238 } | |
| 4239 | |
| 5275 | 4240 octave_idx_type b_nr = b.rows(); |
| 4241 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4242 rcond = 1.; |
| 4243 | |
| 4244 retval = b; | |
| 4245 Complex *result = retval.fortran_vec (); | |
| 4246 | |
| 4247 F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, | |
| 4248 b_nr, err)); | |
| 4249 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4250 if (err != 0) |
| 5164 | 4251 { |
| 4252 rcond = 0.; | |
| 4253 err = -2; | |
| 4254 | |
| 4255 if (sing_handler) | |
| 5681 | 4256 { |
| 4257 sing_handler (rcond); | |
| 4258 mattype.mark_as_rectangular (); | |
| 4259 } | |
| 5164 | 4260 else |
| 4261 (*current_liboctave_error_handler) | |
| 4262 ("matrix singular to machine precision"); | |
| 4263 } | |
| 4264 } | |
| 5785 | 4265 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4266 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4267 } | |
| 4268 | |
| 4269 return retval; | |
| 4270 } | |
| 4271 | |
| 4272 SparseComplexMatrix | |
| 5785 | 4273 SparseMatrix::trisolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5681 | 4274 octave_idx_type& err, double& rcond, |
| 4275 solve_singularity_handler sing_handler, | |
| 4276 bool calc_cond) const | |
| 5164 | 4277 { |
| 4278 SparseComplexMatrix retval; | |
| 4279 | |
| 5275 | 4280 octave_idx_type nr = rows (); |
| 4281 octave_idx_type nc = cols (); | |
| 5164 | 4282 err = 0; |
| 4283 | |
| 6924 | 4284 if (nr != nc || nr != b.rows ()) |
| 5164 | 4285 (*current_liboctave_error_handler) |
| 4286 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4287 else if (nr == 0 || b.cols () == 0) |
| 4288 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5681 | 4289 else if (calc_cond) |
| 4290 (*current_liboctave_error_handler) | |
| 4291 ("calculation of condition number not implemented"); | |
| 5164 | 4292 else |
| 4293 { | |
| 4294 // Print spparms("spumoni") info if requested | |
| 4295 int typ = mattype.type (); | |
| 4296 mattype.info (); | |
| 4297 | |
| 4298 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 4299 if (typ == MatrixType::Tridiagonal || |
| 4300 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 4301 { |
| 4302 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); | |
| 4303 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 4304 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 4305 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 5275 | 4306 Array<octave_idx_type> ipvt (nr); |
| 4307 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4308 |
| 4309 if (mattype.is_dense ()) | |
| 4310 { | |
| 5275 | 4311 octave_idx_type ii = 0; |
| 4312 | |
| 4313 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4314 { |
| 4315 D[j] = data(ii++); | |
| 4316 DL[j] = data(ii++); | |
| 4317 DU[j] = data(ii++); | |
| 4318 } | |
| 4319 D[nc-1] = data(ii); | |
| 4320 } | |
| 4321 else | |
| 4322 { | |
| 4323 D[0] = 0.; | |
| 5275 | 4324 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4325 { |
| 4326 D[i+1] = 0.; | |
| 4327 DL[i] = 0.; | |
| 4328 DU[i] = 0.; | |
| 4329 } | |
| 4330 | |
| 5275 | 4331 for (octave_idx_type j = 0; j < nc; j++) |
| 4332 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4333 { |
| 4334 if (ridx(i) == j) | |
| 4335 D[j] = data(i); | |
| 4336 else if (ridx(i) == j + 1) | |
| 4337 DL[j] = data(i); | |
| 4338 else if (ridx(i) == j - 1) | |
| 5322 | 4339 DU[j-1] = data(i); |
| 5164 | 4340 } |
| 4341 } | |
| 4342 | |
| 4343 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 4344 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4345 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4346 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4347 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4348 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4349 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4350 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4351 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4352 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4353 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4354 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4355 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4356 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4357 ("matrix singular to machine precision"); |
|
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 else |
|
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 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4362 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4363 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4364 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4365 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4366 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
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 // 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
|
4369 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4370 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
|
4371 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4372 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
|
4373 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4374 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4375 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
|
4376 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4377 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4378 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5681 | 4379 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4380 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4381 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4382 Bz[i] = std::imag (c); |
| 5681 | 4383 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4384 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4385 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4386 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4387 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4388 Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4389 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4390 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4391 if (err != 0) |
| 5164 | 4392 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4393 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4394 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4395 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4396 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4397 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4398 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4399 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4400 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4401 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4402 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4403 Bz, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4404 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4405 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4406 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4407 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4408 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4409 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4410 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4411 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4412 break; |
| 5164 | 4413 } |
| 4414 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4415 // 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
|
4416 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4417 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4418 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
|
4419 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4420 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4421 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4422 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4423 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4424 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4425 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
|
4426 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4427 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4428 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4429 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4430 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
|
4431 if (Bx[i] != 0. || Bz[i] != 0.) |
|
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 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4434 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4435 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4436 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4437 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4438 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4439 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4440 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4441 retval.maybe_compress (); |
| 5164 | 4442 } |
| 4443 } | |
| 5785 | 4444 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4445 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4446 } | |
| 4447 | |
| 4448 return retval; | |
| 4449 } | |
| 4450 | |
| 4451 Matrix | |
| 5785 | 4452 SparseMatrix::bsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 4453 octave_idx_type& err, double& rcond, |
| 4454 solve_singularity_handler sing_handler, | |
| 4455 bool calc_cond) const | |
| 5164 | 4456 { |
| 4457 Matrix retval; | |
| 4458 | |
| 5275 | 4459 octave_idx_type nr = rows (); |
| 4460 octave_idx_type nc = cols (); | |
| 5164 | 4461 err = 0; |
| 4462 | |
| 6924 | 4463 if (nr != nc || nr != b.rows ()) |
| 5164 | 4464 (*current_liboctave_error_handler) |
| 4465 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4466 else if (nr == 0 || b.cols () == 0) |
| 4467 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 4468 else |
| 4469 { | |
| 4470 // Print spparms("spumoni") info if requested | |
| 4471 volatile int typ = mattype.type (); | |
| 4472 mattype.info (); | |
| 4473 | |
| 5785 | 4474 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4475 { |
| 5275 | 4476 octave_idx_type n_lower = mattype.nlower (); |
| 4477 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4478 Matrix m_band (ldm, nc); |
| 4479 double *tmp_data = m_band.fortran_vec (); | |
| 4480 | |
| 4481 if (! mattype.is_dense ()) | |
| 4482 { | |
| 5275 | 4483 octave_idx_type ii = 0; |
| 4484 | |
| 4485 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4486 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4487 tmp_data[ii++] = 0.; |
| 4488 } | |
| 4489 | |
| 5275 | 4490 for (octave_idx_type j = 0; j < nc; j++) |
| 4491 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4492 { |
| 5275 | 4493 octave_idx_type ri = ridx (i); |
| 5164 | 4494 if (ri >= j) |
| 4495 m_band(ri - j, j) = data(i); | |
| 4496 } | |
| 4497 | |
| 4498 // Calculate the norm of the matrix, for later use. | |
| 5681 | 4499 double anorm; |
| 4500 if (calc_cond) | |
| 4501 anorm = m_band.abs().sum().row(0).max(); | |
| 5164 | 4502 |
| 4503 char job = 'L'; | |
| 4504 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4505 nr, n_lower, tmp_data, ldm, err | |
| 4506 F77_CHAR_ARG_LEN (1))); | |
| 4507 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4508 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4509 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4510 // 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
|
4511 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4512 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4513 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4514 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4515 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4516 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4517 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4518 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4519 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4520 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4521 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4522 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4523 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4524 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4525 |
| 7776 | 4526 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4527 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4528 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4529 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4530 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4531 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4532 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4533 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4534 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4535 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
|
4536 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4537 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4538 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4539 err = -2; |
|
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 (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4542 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4543 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4544 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4547 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4548 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4549 rcond); |
| 5681 | 4550 } |
|
7482
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4553 rcond = 1.; |
|
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 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4556 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4557 retval = b; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4558 double *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4559 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4560 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4561 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4562 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4563 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4564 nr, n_lower, b_nc, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4565 ldm, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4566 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4567 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4568 if (err != 0) |
| 5681 | 4569 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4570 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4571 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4572 err = -1; |
| 5164 | 4573 } |
| 4574 } | |
| 4575 } | |
| 4576 } | |
| 4577 | |
| 5785 | 4578 if (typ == MatrixType::Banded) |
| 5164 | 4579 { |
| 4580 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 4581 octave_idx_type n_upper = mattype.nupper (); |
| 4582 octave_idx_type n_lower = mattype.nlower (); | |
| 4583 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4584 |
| 4585 Matrix m_band (ldm, nc); | |
| 4586 double *tmp_data = m_band.fortran_vec (); | |
| 4587 | |
| 4588 if (! mattype.is_dense ()) | |
| 4589 { | |
| 5275 | 4590 octave_idx_type ii = 0; |
| 4591 | |
| 4592 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4593 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4594 tmp_data[ii++] = 0.; |
| 4595 } | |
| 4596 | |
| 5275 | 4597 for (octave_idx_type j = 0; j < nc; j++) |
| 4598 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4599 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4600 | |
| 5681 | 4601 // Calculate the norm of the matrix, for later use. |
| 4602 double anorm; | |
| 4603 if (calc_cond) | |
| 4604 { | |
| 4605 for (octave_idx_type j = 0; j < nr; j++) | |
| 4606 { | |
| 4607 double atmp = 0.; | |
| 4608 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4609 atmp += fabs(data(i)); | |
| 4610 if (atmp > anorm) | |
| 4611 anorm = atmp; | |
| 4612 } | |
| 4613 } | |
| 4614 | |
| 5275 | 4615 Array<octave_idx_type> ipvt (nr); |
| 4616 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4617 |
| 4618 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 4619 ldm, pipvt, err)); | |
| 4620 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4621 // 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
|
4622 // change output. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4623 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4624 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4625 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4626 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4627 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4628 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4629 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4630 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4631 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4632 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4633 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4634 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4635 ("matrix singular to machine precision"); |
|
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 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4638 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4639 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4640 if (calc_cond) |
|
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 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4643 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4644 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4645 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4646 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4647 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4648 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4649 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4650 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
|
4651 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4652 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4653 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4654 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4655 err = -2; |
|
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 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
|
4658 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4659 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4660 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4661 err = -2; |
|
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 (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4664 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4665 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4666 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4669 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4670 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4671 rcond); |
| 5681 | 4672 } |
|
7482
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4675 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4676 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4677 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4678 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4679 retval = b; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4680 double *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4681 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4682 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4683 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4684 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4685 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4686 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4687 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
|
4688 ldm, pipvt, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4689 F77_CHAR_ARG_LEN (1))); |
| 5164 | 4690 } |
| 4691 } | |
| 4692 } | |
| 5785 | 4693 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 4694 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4695 } | |
| 4696 | |
| 4697 return retval; | |
| 4698 } | |
| 4699 | |
| 4700 SparseMatrix | |
| 5785 | 4701 SparseMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 4702 octave_idx_type& err, double& rcond, |
| 4703 solve_singularity_handler sing_handler, | |
| 4704 bool calc_cond) const | |
| 5164 | 4705 { |
| 4706 SparseMatrix retval; | |
| 4707 | |
| 5275 | 4708 octave_idx_type nr = rows (); |
| 4709 octave_idx_type nc = cols (); | |
| 5164 | 4710 err = 0; |
| 4711 | |
| 6924 | 4712 if (nr != nc || nr != b.rows ()) |
| 5164 | 4713 (*current_liboctave_error_handler) |
| 4714 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4715 else if (nr == 0 || b.cols () == 0) |
| 4716 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 4717 else |
| 4718 { | |
| 4719 // Print spparms("spumoni") info if requested | |
| 4720 volatile int typ = mattype.type (); | |
| 4721 mattype.info (); | |
| 4722 | |
| 5785 | 4723 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4724 { |
| 6242 | 4725 octave_idx_type n_lower = mattype.nlower (); |
| 4726 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4727 |
| 4728 Matrix m_band (ldm, nc); | |
| 4729 double *tmp_data = m_band.fortran_vec (); | |
| 4730 | |
| 4731 if (! mattype.is_dense ()) | |
| 4732 { | |
| 5275 | 4733 octave_idx_type ii = 0; |
| 4734 | |
| 4735 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4736 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4737 tmp_data[ii++] = 0.; |
| 4738 } | |
| 4739 | |
| 5275 | 4740 for (octave_idx_type j = 0; j < nc; j++) |
| 4741 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4742 { |
| 5275 | 4743 octave_idx_type ri = ridx (i); |
| 5164 | 4744 if (ri >= j) |
| 4745 m_band(ri - j, j) = data(i); | |
| 4746 } | |
| 4747 | |
| 5681 | 4748 // Calculate the norm of the matrix, for later use. |
| 4749 double anorm; | |
| 4750 if (calc_cond) | |
| 4751 anorm = m_band.abs().sum().row(0).max(); | |
| 4752 | |
| 5164 | 4753 char job = 'L'; |
| 4754 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4755 nr, n_lower, tmp_data, ldm, err | |
| 4756 F77_CHAR_ARG_LEN (1))); | |
| 4757 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4758 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4759 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4760 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4761 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4762 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4763 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4764 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4765 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4766 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4767 if (calc_cond) |
|
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 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4770 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4771 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4772 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4773 |
| 7776 | 4774 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4775 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4776 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4777 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4778 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4779 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4780 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4781 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4782 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4783 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
|
4784 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4785 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4786 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4787 err = -2; |
|
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 (sing_handler) |
| 5681 | 4790 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4791 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4792 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4795 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4796 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4797 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4798 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4799 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4800 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4801 rcond = 1.; |
|
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 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4804 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4805 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4806 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4807 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
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 // 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
|
4810 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4811 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
|
4812 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4813 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
|
4814 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4815 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4816 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
|
4817 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4818 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
|
4819 Bx[i] = b.elem (i, j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4820 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4821 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4822 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4823 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4824 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4825 F77_CHAR_ARG_LEN (1))); |
|
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 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4828 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4829 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4830 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4831 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4832 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4833 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4834 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4835 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
|
4836 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4837 double tmp = Bx[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4838 if (tmp != 0.0) |
| 5681 | 4839 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4840 if (ii == x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4841 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4842 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4843 octave_idx_type sz = x_nz * |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4844 (b_nc - j) / b_nc; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4845 sz = (sz > 10 ? sz : 10) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4846 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4847 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4848 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4849 retval.xdata(ii) = tmp; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4850 retval.xridx(ii++) = i; |
| 5681 | 4851 } |
| 5164 | 4852 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4853 retval.xcidx(j+1) = ii; |
| 5164 | 4854 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4855 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4856 retval.maybe_compress (); |
| 5164 | 4857 } |
| 4858 } | |
| 4859 } | |
| 4860 | |
| 5785 | 4861 if (typ == MatrixType::Banded) |
| 5164 | 4862 { |
| 4863 // Create the storage for the banded form of the sparse matrix | |
| 5275 | 4864 octave_idx_type n_upper = mattype.nupper (); |
| 4865 octave_idx_type n_lower = mattype.nlower (); | |
| 4866 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4867 |
| 4868 Matrix m_band (ldm, nc); | |
| 4869 double *tmp_data = m_band.fortran_vec (); | |
| 4870 | |
| 4871 if (! mattype.is_dense ()) | |
| 4872 { | |
| 5275 | 4873 octave_idx_type ii = 0; |
| 4874 | |
| 4875 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4876 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4877 tmp_data[ii++] = 0.; |
| 4878 } | |
| 4879 | |
| 5275 | 4880 for (octave_idx_type j = 0; j < nc; j++) |
| 4881 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4882 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4883 | |
| 5681 | 4884 // Calculate the norm of the matrix, for later use. |
| 4885 double anorm; | |
| 4886 if (calc_cond) | |
| 4887 { | |
| 4888 for (octave_idx_type j = 0; j < nr; j++) | |
| 4889 { | |
| 4890 double atmp = 0.; | |
| 4891 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4892 atmp += fabs(data(i)); | |
| 4893 if (atmp > anorm) | |
| 4894 anorm = atmp; | |
| 4895 } | |
| 4896 } | |
| 4897 | |
| 5275 | 4898 Array<octave_idx_type> ipvt (nr); |
| 4899 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4900 |
| 4901 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 4902 ldm, pipvt, err)); | |
| 4903 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4904 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4905 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4906 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4907 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4908 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4909 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4910 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4911 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4912 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4913 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4914 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4915 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4916 ("matrix singular to machine precision"); |
|
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 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4919 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4920 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4921 if (calc_cond) |
|
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 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4924 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4925 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4926 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4927 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4928 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4929 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4930 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4931 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
|
4932 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4933 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4934 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4935 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4936 err = -2; |
|
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 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
|
4939 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4940 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4941 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4942 err = -2; |
|
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 (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4945 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4946 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4947 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4950 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4951 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4952 rcond); |
| 5681 | 4953 } |
|
7482
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4956 rcond = 1.; |
|
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 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4959 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4960 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4961 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
|
4962 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4963 retval = SparseMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4964 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4965 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4966 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4967 OCTAVE_LOCAL_BUFFER (double, work, nr); |
|
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 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 4970 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4971 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
|
4972 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4973 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
|
4974 i < b.cidx(j+1); i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4975 work[b.ridx(i)] = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4976 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4977 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4978 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4979 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
|
4980 ldm, pipvt, work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4981 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4982 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4983 // 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
|
4984 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4985 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4986 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
|
4987 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4988 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4989 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4990 if (ii + new_nnz > x_nz) |
| 5164 | 4991 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4992 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4993 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
|
4994 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4995 x_nz = sz; |
| 5164 | 4996 } |
| 4997 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4998 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
|
4999 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5000 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5001 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5002 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5003 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5004 retval.xcidx(j+1) = ii; |
| 5164 | 5005 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5006 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5007 retval.maybe_compress (); |
| 5164 | 5008 } |
| 5009 } | |
| 5010 } | |
| 5785 | 5011 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5012 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5013 } | |
| 5014 | |
| 5015 return retval; | |
| 5016 } | |
| 5017 | |
| 5018 ComplexMatrix | |
| 5785 | 5019 SparseMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 5020 octave_idx_type& err, double& rcond, |
| 5021 solve_singularity_handler sing_handler, | |
| 5022 bool calc_cond) const | |
| 5164 | 5023 { |
| 5024 ComplexMatrix retval; | |
| 5025 | |
| 5275 | 5026 octave_idx_type nr = rows (); |
| 5027 octave_idx_type nc = cols (); | |
| 5164 | 5028 err = 0; |
| 5029 | |
| 6924 | 5030 if (nr != nc || nr != b.rows ()) |
| 5164 | 5031 (*current_liboctave_error_handler) |
| 5032 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5033 else if (nr == 0 || b.cols () == 0) |
| 5034 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 5035 else |
| 5036 { | |
| 5037 // Print spparms("spumoni") info if requested | |
| 5038 volatile int typ = mattype.type (); | |
| 5039 mattype.info (); | |
| 5040 | |
| 5785 | 5041 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 5042 { |
| 5275 | 5043 octave_idx_type n_lower = mattype.nlower (); |
| 5044 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 5045 |
| 5046 Matrix m_band (ldm, nc); | |
| 5047 double *tmp_data = m_band.fortran_vec (); | |
| 5048 | |
| 5049 if (! mattype.is_dense ()) | |
| 5050 { | |
| 5275 | 5051 octave_idx_type ii = 0; |
| 5052 | |
| 5053 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5054 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5055 tmp_data[ii++] = 0.; |
| 5056 } | |
| 5057 | |
| 5275 | 5058 for (octave_idx_type j = 0; j < nc; j++) |
| 5059 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5060 { |
| 5275 | 5061 octave_idx_type ri = ridx (i); |
| 5164 | 5062 if (ri >= j) |
| 5063 m_band(ri - j, j) = data(i); | |
| 5064 } | |
| 5065 | |
| 5681 | 5066 // Calculate the norm of the matrix, for later use. |
| 5067 double anorm; | |
| 5068 if (calc_cond) | |
| 5069 anorm = m_band.abs().sum().row(0).max(); | |
| 5070 | |
| 5164 | 5071 char job = 'L'; |
| 5072 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 5073 nr, n_lower, tmp_data, ldm, err | |
| 5074 F77_CHAR_ARG_LEN (1))); | |
| 5075 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5076 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5077 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5078 // 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
|
5079 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5080 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5081 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5082 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5083 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5084 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5085 else |
|
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 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5088 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5089 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5090 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5091 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5092 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5093 |
| 7776 | 5094 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5095 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5096 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5097 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5098 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5099 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5100 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5101 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5102 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5103 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
|
5104 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5105 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5106 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5107 err = -2; |
|
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 (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5110 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5111 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5112 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5115 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5116 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5117 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5118 } |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5121 rcond = 1.; |
|
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 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5124 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5125 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5126 octave_idx_type b_nc = b.cols (); |
|
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 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5129 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5130 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5131 retval.resize (b_nr, b_nc); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5132 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5133 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
|
5134 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5135 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 5136 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5137 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5138 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5139 Bz[i] = std::imag (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5140 } |
|
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 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5143 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5144 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5145 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5146 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5147 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5148 if (err != 0) |
|
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 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5151 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5152 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5153 break; |
| 5164 | 5154 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5155 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5156 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5157 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5158 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5159 ldm, Bz, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5160 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5161 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5162 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5163 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5164 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5165 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5166 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5167 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5168 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5169 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5170 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
|
5171 retval (i, j) = Complex (Bx[i], Bz[i]); |
| 5164 | 5172 } |
| 5173 } | |
| 5174 } | |
| 5175 } | |
| 5176 | |
| 5785 | 5177 if (typ == MatrixType::Banded) |
| 5164 | 5178 { |
| 5179 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 5180 octave_idx_type n_upper = mattype.nupper (); |
| 5181 octave_idx_type n_lower = mattype.nlower (); | |
| 5182 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 5183 |
| 5184 Matrix m_band (ldm, nc); | |
| 5185 double *tmp_data = m_band.fortran_vec (); | |
| 5186 | |
| 5187 if (! mattype.is_dense ()) | |
| 5188 { | |
| 5275 | 5189 octave_idx_type ii = 0; |
| 5190 | |
| 5191 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5192 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5193 tmp_data[ii++] = 0.; |
| 5194 } | |
| 5195 | |
| 5275 | 5196 for (octave_idx_type j = 0; j < nc; j++) |
| 5197 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5198 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5199 | |
| 5681 | 5200 // Calculate the norm of the matrix, for later use. |
| 5201 double anorm; | |
| 5202 if (calc_cond) | |
| 5203 { | |
| 5204 for (octave_idx_type j = 0; j < nr; j++) | |
| 5205 { | |
| 5206 double atmp = 0.; | |
| 5207 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5208 atmp += fabs(data(i)); | |
| 5209 if (atmp > anorm) | |
| 5210 anorm = atmp; | |
| 5211 } | |
| 5212 } | |
| 5213 | |
| 5275 | 5214 Array<octave_idx_type> ipvt (nr); |
| 5215 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5216 |
| 5217 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5218 ldm, pipvt, err)); | |
| 5219 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5220 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5221 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5222 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5223 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5224 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5225 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5226 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5227 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5228 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5229 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5230 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5231 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5232 ("matrix singular to machine precision"); |
|
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 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5235 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5236 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5237 if (calc_cond) |
|
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 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5240 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5241 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5242 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5243 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5244 |
| 7776 | 5245 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5246 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5247 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5248 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5249 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5250 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5251 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5252 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5253 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5254 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
|
5255 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5256 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 5257 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5258 err = -2; |
|
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 (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5261 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5262 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5263 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5266 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5267 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5268 rcond); |
| 5681 | 5269 } |
|
7482
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5272 rcond = 1.; |
|
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 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5275 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5276 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5277 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5278 retval.resize (nr,b_nc); |
|
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 OCTAVE_LOCAL_BUFFER (double, Bz, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5281 OCTAVE_LOCAL_BUFFER (double, Bx, nr); |
|
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 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 5284 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5285 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 5286 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5287 Complex c = b (i, j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5288 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5289 Bz[i] = std::imag (c); |
| 5164 | 5290 } |
|
7482
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 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5293 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5294 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
|
5295 ldm, pipvt, Bx, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5296 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5297 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5298 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5299 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5300 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
|
5301 ldm, pipvt, Bz, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5302 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5303 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5304 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
|
5305 retval (i, j) = Complex (Bx[i], Bz[i]); |
| 5164 | 5306 } |
| 5307 } | |
| 5308 } | |
| 5309 } | |
| 5785 | 5310 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5311 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5312 } | |
| 5313 | |
| 5314 return retval; | |
| 5315 } | |
| 5316 | |
| 5317 SparseComplexMatrix | |
| 5785 | 5318 SparseMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5681 | 5319 octave_idx_type& err, double& rcond, |
| 5320 solve_singularity_handler sing_handler, | |
| 5321 bool calc_cond) const | |
| 5164 | 5322 { |
| 5323 SparseComplexMatrix retval; | |
| 5324 | |
| 5275 | 5325 octave_idx_type nr = rows (); |
| 5326 octave_idx_type nc = cols (); | |
| 5164 | 5327 err = 0; |
| 5328 | |
| 6924 | 5329 if (nr != nc || nr != b.rows ()) |
| 5164 | 5330 (*current_liboctave_error_handler) |
| 5331 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5332 else if (nr == 0 || b.cols () == 0) |
| 5333 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 5334 else |
| 5335 { | |
| 5336 // Print spparms("spumoni") info if requested | |
| 5337 volatile int typ = mattype.type (); | |
| 5338 mattype.info (); | |
| 5339 | |
| 5785 | 5340 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 5341 { |
| 6242 | 5342 octave_idx_type n_lower = mattype.nlower (); |
| 5343 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 5344 |
| 5345 Matrix m_band (ldm, nc); | |
| 5346 double *tmp_data = m_band.fortran_vec (); | |
| 5347 | |
| 5348 if (! mattype.is_dense ()) | |
| 5349 { | |
| 5275 | 5350 octave_idx_type ii = 0; |
| 5351 | |
| 5352 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5353 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5354 tmp_data[ii++] = 0.; |
| 5355 } | |
| 5356 | |
| 5275 | 5357 for (octave_idx_type j = 0; j < nc; j++) |
| 5358 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5359 { |
| 5275 | 5360 octave_idx_type ri = ridx (i); |
| 5164 | 5361 if (ri >= j) |
| 5362 m_band(ri - j, j) = data(i); | |
| 5363 } | |
| 5364 | |
| 5681 | 5365 // Calculate the norm of the matrix, for later use. |
| 5366 double anorm; | |
| 5367 if (calc_cond) | |
| 5368 anorm = m_band.abs().sum().row(0).max(); | |
| 5369 | |
| 5164 | 5370 char job = 'L'; |
| 5371 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 5372 nr, n_lower, tmp_data, ldm, err | |
| 5373 F77_CHAR_ARG_LEN (1))); | |
| 5374 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5375 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5376 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5377 // 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
|
5378 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5379 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5380 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5381 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5382 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5383 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5384 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5385 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5386 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5387 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5388 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5389 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5390 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5391 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5392 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5393 |
| 7776 | 5394 F77_XFCN (dpbcon, DPBCON, |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5395 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5396 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5397 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5398 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5399 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5400 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5401 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5402 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5403 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
|
5404 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5405 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 5406 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5407 err = -2; |
|
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 (sing_handler) |
| 5164 | 5410 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5411 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5412 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5415 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5416 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5417 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5418 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5419 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5420 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5421 rcond = 1.; |
|
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 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5424 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5425 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5426 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5427 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5428 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5429 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5430 // 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
|
5431 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5432 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
|
5433 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5434 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
|
5435 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5436 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5437 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
|
5438 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5439 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5440 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
|
5441 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5442 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5443 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5444 Bz[i] = std::imag (c); |
| 5164 | 5445 } |
| 5446 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5447 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5448 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5449 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5450 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5451 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5452 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5453 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5454 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5455 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5456 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5457 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5458 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5459 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5460 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5461 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5462 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5463 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5464 ldm, Bz, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5465 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5466 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5467 if (err != 0) |
|
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 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5470 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5471 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5472 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5473 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5474 } |
|
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 // 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
|
5477 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5478 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5479 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
|
5480 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5481 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5482 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5483 if (ii + new_nnz > x_nz) |
|
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 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5486 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
|
5487 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5488 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5489 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5490 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5491 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
|
5492 if (Bx[i] != 0. || Bz[i] != 0.) |
|
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 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5495 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5496 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5497 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5498 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5499 retval.xcidx(j+1) = ii; |
| 5164 | 5500 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5501 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5502 retval.maybe_compress (); |
| 5164 | 5503 } |
| 5504 } | |
| 5505 } | |
| 5506 | |
| 5785 | 5507 if (typ == MatrixType::Banded) |
| 5164 | 5508 { |
| 5509 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 5510 octave_idx_type n_upper = mattype.nupper (); |
| 5511 octave_idx_type n_lower = mattype.nlower (); | |
| 5512 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 5513 |
| 5514 Matrix m_band (ldm, nc); | |
| 5515 double *tmp_data = m_band.fortran_vec (); | |
| 5516 | |
| 5517 if (! mattype.is_dense ()) | |
| 5518 { | |
| 5275 | 5519 octave_idx_type ii = 0; |
| 5520 | |
| 5521 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5522 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5523 tmp_data[ii++] = 0.; |
| 5524 } | |
| 5525 | |
| 5275 | 5526 for (octave_idx_type j = 0; j < nc; j++) |
| 5527 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5528 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5529 | |
| 5681 | 5530 // Calculate the norm of the matrix, for later use. |
| 5531 double anorm; | |
| 5532 if (calc_cond) | |
| 5533 { | |
| 5534 for (octave_idx_type j = 0; j < nr; j++) | |
| 5535 { | |
| 5536 double atmp = 0.; | |
| 5537 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5538 atmp += fabs(data(i)); | |
| 5539 if (atmp > anorm) | |
| 5540 anorm = atmp; | |
| 5541 } | |
| 5542 } | |
| 5543 | |
| 5275 | 5544 Array<octave_idx_type> ipvt (nr); |
| 5545 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5546 |
| 5547 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5548 ldm, pipvt, err)); | |
| 5549 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5550 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5551 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5552 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5553 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5554 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5555 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5556 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5557 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5558 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5559 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5560 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5561 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5562 ("matrix singular to machine precision"); |
|
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 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5565 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5566 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5567 if (calc_cond) |
|
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 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5570 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5571 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5572 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5573 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5574 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5575 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5576 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5577 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
|
5578 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5579 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5580 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5581 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5582 err = -2; |
|
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 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
|
5585 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5586 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5587 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5588 err = -2; |
|
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 (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5591 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5592 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5593 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5596 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5597 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5598 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5599 } |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5602 rcond = 1.; |
|
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 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5605 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5606 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5607 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
|
5608 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5609 retval = SparseComplexMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5610 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5611 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5612 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5613 OCTAVE_LOCAL_BUFFER (double, Bx, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5614 OCTAVE_LOCAL_BUFFER (double, Bz, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5615 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5616 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
|
5617 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5618 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
|
5619 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5620 Bx[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5621 Bz[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5622 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5623 for (octave_idx_type i = b.cidx(j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5624 i < b.cidx(j+1); i++) |
| 5164 | 5625 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5626 Complex c = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5627 Bx[b.ridx(i)] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5628 Bz[b.ridx(i)] = std::imag (c); |
| 5164 | 5629 } |
| 5630 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5631 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5632 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5633 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
|
5634 ldm, pipvt, Bx, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5635 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5636 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5637 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5638 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5639 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
|
5640 ldm, pipvt, Bz, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5641 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5642 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5643 // 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
|
5644 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5645 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5646 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
|
5647 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5648 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5649 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5650 if (ii + new_nnz > x_nz) |
|
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 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5653 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
|
5654 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5655 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5656 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5657 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5658 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
|
5659 if (Bx[i] != 0. || Bz[i] != 0.) |
|
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 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5662 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5663 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5664 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5665 retval.xcidx(j+1) = ii; |
| 5164 | 5666 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5667 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5668 retval.maybe_compress (); |
| 5164 | 5669 } |
| 5670 } | |
| 5671 } | |
| 5785 | 5672 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5673 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5674 } | |
| 5675 | |
| 5676 return retval; | |
| 5677 } | |
| 5678 | |
| 5679 void * | |
| 5681 | 5680 SparseMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control, |
| 5681 Matrix &Info, solve_singularity_handler sing_handler, | |
| 5682 bool calc_cond) const | |
| 5164 | 5683 { |
| 5684 // The return values | |
| 5404 | 5685 void *Numeric = 0; |
| 5164 | 5686 err = 0; |
| 5687 | |
| 5203 | 5688 #ifdef HAVE_UMFPACK |
| 5164 | 5689 // Setup the control parameters |
| 5690 Control = Matrix (UMFPACK_CONTROL, 1); | |
| 5691 double *control = Control.fortran_vec (); | |
| 5322 | 5692 UMFPACK_DNAME (defaults) (control); |
| 5164 | 5693 |
| 5893 | 5694 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 5695 if (!xisnan (tmp)) |
| 5696 Control (UMFPACK_PRL) = tmp; | |
| 5893 | 5697 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 5698 if (!xisnan (tmp)) |
| 5699 { | |
| 5700 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 5701 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 5702 } | |
| 5703 | |
| 5704 // Set whether we are allowed to modify Q or not | |
| 5893 | 5705 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 5706 if (!xisnan (tmp)) |
| 5707 Control (UMFPACK_FIXQ) = tmp; | |
| 5708 | |
| 5322 | 5709 UMFPACK_DNAME (report_control) (control); |
| 5164 | 5710 |
| 5275 | 5711 const octave_idx_type *Ap = cidx (); |
| 5712 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5713 const double *Ax = data (); |
| 5275 | 5714 octave_idx_type nr = rows (); |
| 5715 octave_idx_type nc = cols (); | |
| 5164 | 5716 |
| 5322 | 5717 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control); |
| 5164 | 5718 |
| 5719 void *Symbolic; | |
| 5720 Info = Matrix (1, UMFPACK_INFO); | |
| 5721 double *info = Info.fortran_vec (); | |
| 7520 | 5722 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, Ax, 0, |
| 5164 | 5723 &Symbolic, control, info); |
| 5724 | |
| 5725 if (status < 0) | |
| 5726 { | |
| 5727 (*current_liboctave_error_handler) | |
| 5728 ("SparseMatrix::solve symbolic factorization failed"); | |
| 5729 err = -1; | |
| 5730 | |
| 5322 | 5731 UMFPACK_DNAME (report_status) (control, status); |
| 5732 UMFPACK_DNAME (report_info) (control, info); | |
| 5733 | |
| 5734 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 5735 } |
| 5736 else | |
| 5737 { | |
| 5322 | 5738 UMFPACK_DNAME (report_symbolic) (Symbolic, control); |
| 5739 | |
| 5740 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, | |
| 5741 &Numeric, control, info) ; | |
| 5742 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 5743 |
| 5681 | 5744 if (calc_cond) |
| 5745 rcond = Info (UMFPACK_RCOND); | |
| 5746 else | |
| 5747 rcond = 1.; | |
| 5164 | 5748 volatile double rcond_plus_one = rcond + 1.0; |
| 5749 | |
| 5750 if (status == UMFPACK_WARNING_singular_matrix || | |
| 5751 rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5752 { | |
| 5322 | 5753 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 5754 |
| 5755 err = -2; | |
| 5756 | |
| 5757 if (sing_handler) | |
| 5758 sing_handler (rcond); | |
| 5759 else | |
| 5760 (*current_liboctave_error_handler) | |
| 5761 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5762 rcond); | |
| 5763 | |
| 5764 } | |
| 5610 | 5765 else if (status < 0) |
| 5164 | 5766 { |
| 5767 (*current_liboctave_error_handler) | |
| 5768 ("SparseMatrix::solve numeric factorization failed"); | |
| 5769 | |
| 5322 | 5770 UMFPACK_DNAME (report_status) (control, status); |
| 5771 UMFPACK_DNAME (report_info) (control, info); | |
| 5164 | 5772 |
| 5773 err = -1; | |
| 5774 } | |
| 5775 else | |
| 5776 { | |
| 5322 | 5777 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 5778 } |
| 5779 } | |
| 5780 | |
| 5781 if (err != 0) | |
| 5322 | 5782 UMFPACK_DNAME (free_numeric) (&Numeric); |
| 5164 | 5783 |
| 5203 | 5784 #else |
| 5785 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 5786 #endif | |
| 5787 | |
| 5164 | 5788 return Numeric; |
| 5789 } | |
| 5790 | |
| 5791 Matrix | |
| 5785 | 5792 SparseMatrix::fsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 5793 octave_idx_type& err, double& rcond, |
| 5794 solve_singularity_handler sing_handler, | |
| 5795 bool calc_cond) const | |
| 5164 | 5796 { |
| 5797 Matrix retval; | |
| 5798 | |
| 5275 | 5799 octave_idx_type nr = rows (); |
| 5800 octave_idx_type nc = cols (); | |
| 5164 | 5801 err = 0; |
| 5802 | |
| 6924 | 5803 if (nr != nc || nr != b.rows ()) |
| 5164 | 5804 (*current_liboctave_error_handler) |
| 5805 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5806 else if (nr == 0 || b.cols () == 0) |
| 5807 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 5808 else |
| 5809 { | |
| 5810 // Print spparms("spumoni") info if requested | |
| 5506 | 5811 volatile int typ = mattype.type (); |
| 5164 | 5812 mattype.info (); |
| 5813 | |
| 5785 | 5814 if (typ == MatrixType::Hermitian) |
| 5164 | 5815 { |
| 5506 | 5816 #ifdef HAVE_CHOLMOD |
| 5817 cholmod_common Common; | |
| 5818 cholmod_common *cm = &Common; | |
| 5819 | |
| 5820 // Setup initial parameters | |
| 5821 CHOLMOD_NAME(start) (cm); | |
| 5526 | 5822 cm->prefer_zomplex = false; |
| 5506 | 5823 |
| 5893 | 5824 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 5825 if (spu == 0.) |
| 5826 { | |
| 5827 cm->print = -1; | |
| 7520 | 5828 cm->print_function = 0; |
| 5506 | 5829 } |
| 5830 else | |
| 5831 { | |
| 5760 | 5832 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 5833 cm->print_function =&SparseCholPrint; |
| 5834 } | |
| 5835 | |
| 5836 cm->error_handler = &SparseCholError; | |
| 5837 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 5838 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 5839 | |
| 5526 | 5840 cm->final_ll = true; |
| 5506 | 5841 |
| 5842 cholmod_sparse Astore; | |
| 5843 cholmod_sparse *A = &Astore; | |
| 5844 double dummy; | |
| 5845 A->nrow = nr; | |
| 5846 A->ncol = nc; | |
| 5847 | |
| 5848 A->p = cidx(); | |
| 5849 A->i = ridx(); | |
| 5604 | 5850 A->nzmax = nnz(); |
| 5526 | 5851 A->packed = true; |
| 5852 A->sorted = true; | |
| 7520 | 5853 A->nz = 0; |
| 5506 | 5854 #ifdef IDX_TYPE_LONG |
| 5855 A->itype = CHOLMOD_LONG; | |
| 5856 #else | |
| 5857 A->itype = CHOLMOD_INT; | |
| 5858 #endif | |
| 5859 A->dtype = CHOLMOD_DOUBLE; | |
| 5860 A->stype = 1; | |
| 5861 A->xtype = CHOLMOD_REAL; | |
| 5862 | |
| 5863 if (nr < 1) | |
| 5864 A->x = &dummy; | |
| 5865 else | |
| 5866 A->x = data(); | |
| 5867 | |
| 5868 cholmod_dense Bstore; | |
| 5869 cholmod_dense *B = &Bstore; | |
| 5870 B->nrow = b.rows(); | |
| 5871 B->ncol = b.cols(); | |
| 5872 B->d = B->nrow; | |
| 5873 B->nzmax = B->nrow * B->ncol; | |
| 5874 B->dtype = CHOLMOD_DOUBLE; | |
| 5875 B->xtype = CHOLMOD_REAL; | |
| 5876 if (nc < 1 || b.cols() < 1) | |
| 5877 B->x = &dummy; | |
| 5878 else | |
| 5879 // We won't alter it, honest :-) | |
| 5880 B->x = const_cast<double *>(b.fortran_vec()); | |
| 5881 | |
| 5882 cholmod_factor *L; | |
| 5883 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5884 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 5885 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 5886 if (calc_cond) |
| 5887 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 5888 else | |
| 5889 rcond = 1.0; | |
| 5890 | |
| 5506 | 5891 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5892 | |
| 5893 if (rcond == 0.0) | |
| 5894 { | |
| 5895 // Either its indefinite or singular. Try UMFPACK | |
| 5896 mattype.mark_as_unsymmetric (); | |
| 5785 | 5897 typ = MatrixType::Full; |
| 5506 | 5898 } |
| 5899 else | |
| 5900 { | |
| 5901 volatile double rcond_plus_one = rcond + 1.0; | |
| 5902 | |
| 5903 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5904 { | |
| 5905 err = -2; | |
| 5906 | |
| 5907 if (sing_handler) | |
| 5681 | 5908 { |
| 5909 sing_handler (rcond); | |
| 5910 mattype.mark_as_rectangular (); | |
| 5911 } | |
| 5506 | 5912 else |
| 5913 (*current_liboctave_error_handler) | |
| 5914 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5915 rcond); | |
| 5916 | |
| 5917 return retval; | |
| 5918 } | |
| 5919 | |
| 5920 cholmod_dense *X; | |
| 5921 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5922 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 5923 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5924 | |
| 5925 retval.resize (b.rows (), b.cols()); | |
| 5926 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 5927 { | |
| 5928 octave_idx_type jr = j * b.rows(); | |
| 5929 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 5930 retval.xelem(i,j) = static_cast<double *>(X->x)[jr + i]; | |
| 5931 } | |
| 5932 | |
| 5933 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5934 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 5935 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 5936 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 5937 static char tmp[] = " "; |
| 5938 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 5939 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5940 } | |
| 5941 #else | |
| 5164 | 5942 (*current_liboctave_warning_handler) |
| 5506 | 5943 ("CHOLMOD not installed"); |
| 5164 | 5944 |
| 5945 mattype.mark_as_unsymmetric (); | |
| 5785 | 5946 typ = MatrixType::Full; |
| 5506 | 5947 #endif |
| 5164 | 5948 } |
| 5949 | |
| 5785 | 5950 if (typ == MatrixType::Full) |
| 5164 | 5951 { |
| 5203 | 5952 #ifdef HAVE_UMFPACK |
| 5164 | 5953 Matrix Control, Info; |
| 5954 void *Numeric = | |
| 5681 | 5955 factorize (err, rcond, Control, Info, sing_handler, calc_cond); |
| 5164 | 5956 |
| 5957 if (err == 0) | |
| 5958 { | |
| 5959 const double *Bx = b.fortran_vec (); | |
| 5960 retval.resize (b.rows (), b.cols()); | |
| 5961 double *result = retval.fortran_vec (); | |
| 5275 | 5962 octave_idx_type b_nr = b.rows (); |
| 5963 octave_idx_type b_nc = b.cols (); | |
| 5164 | 5964 int status = 0; |
| 5965 double *control = Control.fortran_vec (); | |
| 5966 double *info = Info.fortran_vec (); | |
| 5275 | 5967 const octave_idx_type *Ap = cidx (); |
| 5968 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5969 const double *Ax = data (); |
| 5970 | |
| 5275 | 5971 for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) |
| 5164 | 5972 { |
| 5322 | 5973 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 5974 Ai, Ax, &result[iidx], &Bx[iidx], | |
| 5164 | 5975 Numeric, control, info); |
| 5976 if (status < 0) | |
| 5977 { | |
| 5978 (*current_liboctave_error_handler) | |
| 5979 ("SparseMatrix::solve solve failed"); | |
| 5980 | |
| 5322 | 5981 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 5982 |
| 5983 err = -1; | |
| 5984 | |
| 5985 break; | |
| 5986 } | |
| 5987 } | |
| 5988 | |
| 5322 | 5989 UMFPACK_DNAME (report_info) (control, info); |
| 5164 | 5990 |
| 5322 | 5991 UMFPACK_DNAME (free_numeric) (&Numeric); |
| 5164 | 5992 } |
| 5681 | 5993 else |
| 5994 mattype.mark_as_rectangular (); | |
| 5995 | |
| 5203 | 5996 #else |
| 5997 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 5998 #endif | |
| 5164 | 5999 } |
| 5785 | 6000 else if (typ != MatrixType::Hermitian) |
| 5164 | 6001 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6002 } | |
| 6003 | |
| 6004 return retval; | |
| 6005 } | |
| 6006 | |
| 6007 SparseMatrix | |
| 5785 | 6008 SparseMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 6009 octave_idx_type& err, double& rcond, |
| 6010 solve_singularity_handler sing_handler, | |
| 6011 bool calc_cond) const | |
| 5164 | 6012 { |
| 6013 SparseMatrix retval; | |
| 6014 | |
| 5275 | 6015 octave_idx_type nr = rows (); |
| 6016 octave_idx_type nc = cols (); | |
| 5164 | 6017 err = 0; |
| 6018 | |
| 6924 | 6019 if (nr != nc || nr != b.rows ()) |
| 5164 | 6020 (*current_liboctave_error_handler) |
| 6021 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6022 else if (nr == 0 || b.cols () == 0) |
| 6023 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 6024 else |
| 6025 { | |
| 6026 // Print spparms("spumoni") info if requested | |
| 5506 | 6027 volatile int typ = mattype.type (); |
| 5164 | 6028 mattype.info (); |
| 6029 | |
| 5785 | 6030 if (typ == MatrixType::Hermitian) |
| 5164 | 6031 { |
| 5506 | 6032 #ifdef HAVE_CHOLMOD |
| 6033 cholmod_common Common; | |
| 6034 cholmod_common *cm = &Common; | |
| 6035 | |
| 6036 // Setup initial parameters | |
| 6037 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6038 cm->prefer_zomplex = false; |
| 5506 | 6039 |
| 5893 | 6040 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6041 if (spu == 0.) |
| 6042 { | |
| 6043 cm->print = -1; | |
| 7520 | 6044 cm->print_function = 0; |
| 5506 | 6045 } |
| 6046 else | |
| 6047 { | |
| 5760 | 6048 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6049 cm->print_function =&SparseCholPrint; |
| 6050 } | |
| 6051 | |
| 6052 cm->error_handler = &SparseCholError; | |
| 6053 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6054 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6055 | |
| 5526 | 6056 cm->final_ll = true; |
| 5506 | 6057 |
| 6058 cholmod_sparse Astore; | |
| 6059 cholmod_sparse *A = &Astore; | |
| 6060 double dummy; | |
| 6061 A->nrow = nr; | |
| 6062 A->ncol = nc; | |
| 6063 | |
| 6064 A->p = cidx(); | |
| 6065 A->i = ridx(); | |
| 5604 | 6066 A->nzmax = nnz(); |
| 5526 | 6067 A->packed = true; |
| 6068 A->sorted = true; | |
| 7520 | 6069 A->nz = 0; |
| 5506 | 6070 #ifdef IDX_TYPE_LONG |
| 6071 A->itype = CHOLMOD_LONG; | |
| 6072 #else | |
| 6073 A->itype = CHOLMOD_INT; | |
| 6074 #endif | |
| 6075 A->dtype = CHOLMOD_DOUBLE; | |
| 6076 A->stype = 1; | |
| 6077 A->xtype = CHOLMOD_REAL; | |
| 6078 | |
| 6079 if (nr < 1) | |
| 6080 A->x = &dummy; | |
| 6081 else | |
| 6082 A->x = data(); | |
| 6083 | |
| 6084 cholmod_sparse Bstore; | |
| 6085 cholmod_sparse *B = &Bstore; | |
| 6086 B->nrow = b.rows(); | |
| 6087 B->ncol = b.cols(); | |
| 6088 B->p = b.cidx(); | |
| 6089 B->i = b.ridx(); | |
| 5604 | 6090 B->nzmax = b.nnz(); |
| 5526 | 6091 B->packed = true; |
| 6092 B->sorted = true; | |
| 7520 | 6093 B->nz = 0; |
| 5506 | 6094 #ifdef IDX_TYPE_LONG |
| 6095 B->itype = CHOLMOD_LONG; | |
| 6096 #else | |
| 6097 B->itype = CHOLMOD_INT; | |
| 6098 #endif | |
| 6099 B->dtype = CHOLMOD_DOUBLE; | |
| 6100 B->stype = 0; | |
| 6101 B->xtype = CHOLMOD_REAL; | |
| 6102 | |
| 6103 if (b.rows() < 1 || b.cols() < 1) | |
| 6104 B->x = &dummy; | |
| 6105 else | |
| 6106 B->x = b.data(); | |
| 6107 | |
| 6108 cholmod_factor *L; | |
| 6109 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6110 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6111 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6112 if (calc_cond) |
| 6113 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6114 else | |
| 6115 rcond = 1.; | |
| 5506 | 6116 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6117 | |
| 6118 if (rcond == 0.0) | |
| 6119 { | |
| 6120 // Either its indefinite or singular. Try UMFPACK | |
| 6121 mattype.mark_as_unsymmetric (); | |
| 5785 | 6122 typ = MatrixType::Full; |
| 5506 | 6123 } |
| 6124 else | |
| 6125 { | |
| 6126 volatile double rcond_plus_one = rcond + 1.0; | |
| 6127 | |
| 6128 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6129 { | |
| 6130 err = -2; | |
| 6131 | |
| 6132 if (sing_handler) | |
| 5681 | 6133 { |
| 6134 sing_handler (rcond); | |
| 6135 mattype.mark_as_rectangular (); | |
| 6136 } | |
| 5506 | 6137 else |
| 6138 (*current_liboctave_error_handler) | |
| 6139 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6140 rcond); | |
| 6141 | |
| 6142 return retval; | |
| 6143 } | |
| 6144 | |
| 6145 cholmod_sparse *X; | |
| 6146 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6147 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 6148 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6149 | |
| 6150 retval = SparseMatrix (static_cast<octave_idx_type>(X->nrow), | |
| 6151 static_cast<octave_idx_type>(X->ncol), | |
| 6152 static_cast<octave_idx_type>(X->nzmax)); | |
| 6153 for (octave_idx_type j = 0; | |
| 6154 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 6155 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 6156 for (octave_idx_type j = 0; | |
| 6157 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 6158 { | |
| 6159 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 6160 retval.xdata(j) = static_cast<double *>(X->x)[j]; | |
| 6161 } | |
| 6162 | |
| 6163 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6164 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 6165 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6166 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6167 static char tmp[] = " "; |
| 6168 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6169 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6170 } | |
| 6171 #else | |
| 5164 | 6172 (*current_liboctave_warning_handler) |
| 5506 | 6173 ("CHOLMOD not installed"); |
| 5164 | 6174 |
| 6175 mattype.mark_as_unsymmetric (); | |
| 5785 | 6176 typ = MatrixType::Full; |
| 5506 | 6177 #endif |
| 5164 | 6178 } |
| 6179 | |
| 5785 | 6180 if (typ == MatrixType::Full) |
| 5164 | 6181 { |
| 5203 | 6182 #ifdef HAVE_UMFPACK |
| 5164 | 6183 Matrix Control, Info; |
| 6184 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6185 sing_handler, calc_cond); |
| 5164 | 6186 |
| 6187 if (err == 0) | |
| 6188 { | |
| 5275 | 6189 octave_idx_type b_nr = b.rows (); |
| 6190 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6191 int status = 0; |
| 6192 double *control = Control.fortran_vec (); | |
| 6193 double *info = Info.fortran_vec (); | |
| 5275 | 6194 const octave_idx_type *Ap = cidx (); |
| 6195 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6196 const double *Ax = data (); |
| 6197 | |
| 6198 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6199 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6200 | |
| 6201 // Take a first guess that the number of non-zero terms | |
| 6202 // will be as many as in b | |
| 5681 | 6203 octave_idx_type x_nz = b.nnz (); |
| 5275 | 6204 octave_idx_type ii = 0; |
| 5164 | 6205 retval = SparseMatrix (b_nr, b_nc, x_nz); |
| 6206 | |
| 6207 retval.xcidx(0) = 0; | |
| 5275 | 6208 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6209 { |
| 6210 | |
| 5275 | 6211 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6212 Bx[i] = b.elem (i, j); |
| 6213 | |
| 5322 | 6214 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6215 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6216 info); |
| 6217 if (status < 0) | |
| 6218 { | |
| 6219 (*current_liboctave_error_handler) | |
| 6220 ("SparseMatrix::solve solve failed"); | |
| 6221 | |
| 5322 | 6222 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6223 |
| 6224 err = -1; | |
| 6225 | |
| 6226 break; | |
| 6227 } | |
| 6228 | |
| 5275 | 6229 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6230 { |
| 6231 double tmp = Xx[i]; | |
| 6232 if (tmp != 0.0) | |
| 6233 { | |
| 6234 if (ii == x_nz) | |
| 6235 { | |
| 6236 // Resize the sparse matrix | |
| 5275 | 6237 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6238 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6239 retval.change_capacity (sz); | |
| 6240 x_nz = sz; | |
| 6241 } | |
| 6242 retval.xdata(ii) = tmp; | |
| 6243 retval.xridx(ii++) = i; | |
| 6244 } | |
| 6245 } | |
| 6246 retval.xcidx(j+1) = ii; | |
| 6247 } | |
| 6248 | |
| 6249 retval.maybe_compress (); | |
| 6250 | |
| 5322 | 6251 UMFPACK_DNAME (report_info) (control, info); |
| 6252 | |
| 6253 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6254 } |
| 5681 | 6255 else |
| 6256 mattype.mark_as_rectangular (); | |
| 6257 | |
| 5203 | 6258 #else |
| 6259 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6260 #endif | |
| 5164 | 6261 } |
| 5785 | 6262 else if (typ != MatrixType::Hermitian) |
| 5164 | 6263 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6264 } | |
| 6265 | |
| 6266 return retval; | |
| 6267 } | |
| 6268 | |
| 6269 ComplexMatrix | |
| 5785 | 6270 SparseMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 6271 octave_idx_type& err, double& rcond, |
| 6272 solve_singularity_handler sing_handler, | |
| 6273 bool calc_cond) const | |
| 5164 | 6274 { |
| 6275 ComplexMatrix retval; | |
| 6276 | |
| 5275 | 6277 octave_idx_type nr = rows (); |
| 6278 octave_idx_type nc = cols (); | |
| 5164 | 6279 err = 0; |
| 6280 | |
| 6924 | 6281 if (nr != nc || nr != b.rows ()) |
| 5164 | 6282 (*current_liboctave_error_handler) |
| 6283 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6284 else if (nr == 0 || b.cols () == 0) |
| 6285 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 6286 else |
| 6287 { | |
| 6288 // Print spparms("spumoni") info if requested | |
| 5506 | 6289 volatile int typ = mattype.type (); |
| 5164 | 6290 mattype.info (); |
| 6291 | |
| 5785 | 6292 if (typ == MatrixType::Hermitian) |
| 5164 | 6293 { |
| 5506 | 6294 #ifdef HAVE_CHOLMOD |
| 6295 cholmod_common Common; | |
| 6296 cholmod_common *cm = &Common; | |
| 6297 | |
| 6298 // Setup initial parameters | |
| 6299 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6300 cm->prefer_zomplex = false; |
| 5506 | 6301 |
| 5893 | 6302 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6303 if (spu == 0.) |
| 6304 { | |
| 6305 cm->print = -1; | |
| 7520 | 6306 cm->print_function = 0; |
| 5506 | 6307 } |
| 6308 else | |
| 6309 { | |
| 5760 | 6310 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6311 cm->print_function =&SparseCholPrint; |
| 6312 } | |
| 6313 | |
| 6314 cm->error_handler = &SparseCholError; | |
| 6315 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6316 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6317 | |
| 5526 | 6318 cm->final_ll = true; |
| 5506 | 6319 |
| 6320 cholmod_sparse Astore; | |
| 6321 cholmod_sparse *A = &Astore; | |
| 6322 double dummy; | |
| 6323 A->nrow = nr; | |
| 6324 A->ncol = nc; | |
| 6325 | |
| 6326 A->p = cidx(); | |
| 6327 A->i = ridx(); | |
| 5604 | 6328 A->nzmax = nnz(); |
| 5526 | 6329 A->packed = true; |
| 6330 A->sorted = true; | |
| 7520 | 6331 A->nz = 0; |
| 5506 | 6332 #ifdef IDX_TYPE_LONG |
| 6333 A->itype = CHOLMOD_LONG; | |
| 6334 #else | |
| 6335 A->itype = CHOLMOD_INT; | |
| 6336 #endif | |
| 6337 A->dtype = CHOLMOD_DOUBLE; | |
| 6338 A->stype = 1; | |
| 6339 A->xtype = CHOLMOD_REAL; | |
| 6340 | |
| 6341 if (nr < 1) | |
| 6342 A->x = &dummy; | |
| 6343 else | |
| 6344 A->x = data(); | |
| 6345 | |
| 6346 cholmod_dense Bstore; | |
| 6347 cholmod_dense *B = &Bstore; | |
| 6348 B->nrow = b.rows(); | |
| 6349 B->ncol = b.cols(); | |
| 6350 B->d = B->nrow; | |
| 6351 B->nzmax = B->nrow * B->ncol; | |
| 6352 B->dtype = CHOLMOD_DOUBLE; | |
| 6353 B->xtype = CHOLMOD_COMPLEX; | |
| 6354 if (nc < 1 || b.cols() < 1) | |
| 6355 B->x = &dummy; | |
| 6356 else | |
| 6357 // We won't alter it, honest :-) | |
| 6358 B->x = const_cast<Complex *>(b.fortran_vec()); | |
| 6359 | |
| 6360 cholmod_factor *L; | |
| 6361 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6362 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6363 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6364 if (calc_cond) |
| 6365 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6366 else | |
| 6367 rcond = 1.0; | |
| 5506 | 6368 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6369 | |
| 6370 if (rcond == 0.0) | |
| 6371 { | |
| 6372 // Either its indefinite or singular. Try UMFPACK | |
| 6373 mattype.mark_as_unsymmetric (); | |
| 5785 | 6374 typ = MatrixType::Full; |
| 5506 | 6375 } |
| 6376 else | |
| 6377 { | |
| 6378 volatile double rcond_plus_one = rcond + 1.0; | |
| 6379 | |
| 6380 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6381 { | |
| 6382 err = -2; | |
| 6383 | |
| 6384 if (sing_handler) | |
| 5681 | 6385 { |
| 6386 sing_handler (rcond); | |
| 6387 mattype.mark_as_rectangular (); | |
| 6388 } | |
| 5506 | 6389 else |
| 6390 (*current_liboctave_error_handler) | |
| 6391 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6392 rcond); | |
| 6393 | |
| 6394 return retval; | |
| 6395 } | |
| 6396 | |
| 6397 cholmod_dense *X; | |
| 6398 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6399 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 6400 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6401 | |
| 6402 retval.resize (b.rows (), b.cols()); | |
| 6403 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 6404 { | |
| 6405 octave_idx_type jr = j * b.rows(); | |
| 6406 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 6407 retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; | |
| 6408 } | |
| 6409 | |
| 6410 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6411 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 6412 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6413 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6414 static char tmp[] = " "; |
| 6415 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6416 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6417 } | |
| 6418 #else | |
| 5164 | 6419 (*current_liboctave_warning_handler) |
| 5506 | 6420 ("CHOLMOD not installed"); |
| 5164 | 6421 |
| 6422 mattype.mark_as_unsymmetric (); | |
| 5785 | 6423 typ = MatrixType::Full; |
| 5506 | 6424 #endif |
| 5164 | 6425 } |
| 6426 | |
| 5785 | 6427 if (typ == MatrixType::Full) |
| 5164 | 6428 { |
| 5203 | 6429 #ifdef HAVE_UMFPACK |
| 5164 | 6430 Matrix Control, Info; |
| 6431 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6432 sing_handler, calc_cond); |
| 5164 | 6433 |
| 6434 if (err == 0) | |
| 6435 { | |
| 5275 | 6436 octave_idx_type b_nr = b.rows (); |
| 6437 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6438 int status = 0; |
| 6439 double *control = Control.fortran_vec (); | |
| 6440 double *info = Info.fortran_vec (); | |
| 5275 | 6441 const octave_idx_type *Ap = cidx (); |
| 6442 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6443 const double *Ax = data (); |
| 6444 | |
| 6445 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6446 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 6447 | |
| 6448 retval.resize (b_nr, b_nc); | |
| 6449 | |
| 6450 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6451 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); | |
| 6452 | |
| 5275 | 6453 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6454 { |
| 5275 | 6455 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6456 { |
| 6457 Complex c = b (i,j); | |
| 5261 | 6458 Bx[i] = std::real (c); |
| 6459 Bz[i] = std::imag (c); | |
| 5164 | 6460 } |
| 6461 | |
| 5322 | 6462 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6463 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6464 info); |
| 5322 | 6465 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, |
| 6466 Ap, Ai, Ax, Xz, Bz, Numeric, | |
| 5164 | 6467 control, info) ; |
| 6468 | |
| 6469 if (status < 0 || status2 < 0) | |
| 6470 { | |
| 6471 (*current_liboctave_error_handler) | |
| 6472 ("SparseMatrix::solve solve failed"); | |
| 6473 | |
| 5322 | 6474 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6475 |
| 6476 err = -1; | |
| 6477 | |
| 6478 break; | |
| 6479 } | |
| 6480 | |
| 5275 | 6481 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6482 retval (i, j) = Complex (Xx[i], Xz[i]); |
| 6483 } | |
| 6484 | |
| 5322 | 6485 UMFPACK_DNAME (report_info) (control, info); |
| 6486 | |
| 6487 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6488 } |
| 5681 | 6489 else |
| 6490 mattype.mark_as_rectangular (); | |
| 6491 | |
| 5203 | 6492 #else |
| 6493 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6494 #endif | |
| 5164 | 6495 } |
| 5785 | 6496 else if (typ != MatrixType::Hermitian) |
| 5164 | 6497 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6498 } | |
| 6499 | |
| 6500 return retval; | |
| 6501 } | |
| 6502 | |
| 6503 SparseComplexMatrix | |
| 5785 | 6504 SparseMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6505 octave_idx_type& err, double& rcond, |
| 5681 | 6506 solve_singularity_handler sing_handler, |
| 6507 bool calc_cond) const | |
| 5164 | 6508 { |
| 6509 SparseComplexMatrix retval; | |
| 6510 | |
| 5275 | 6511 octave_idx_type nr = rows (); |
| 6512 octave_idx_type nc = cols (); | |
| 5164 | 6513 err = 0; |
| 6514 | |
| 6924 | 6515 if (nr != nc || nr != b.rows ()) |
| 5164 | 6516 (*current_liboctave_error_handler) |
| 6517 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6518 else if (nr == 0 || b.cols () == 0) |
| 6519 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 6520 else |
| 6521 { | |
| 6522 // Print spparms("spumoni") info if requested | |
| 5506 | 6523 volatile int typ = mattype.type (); |
| 5164 | 6524 mattype.info (); |
| 6525 | |
| 5785 | 6526 if (typ == MatrixType::Hermitian) |
| 5164 | 6527 { |
| 5506 | 6528 #ifdef HAVE_CHOLMOD |
| 6529 cholmod_common Common; | |
| 6530 cholmod_common *cm = &Common; | |
| 6531 | |
| 6532 // Setup initial parameters | |
| 6533 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6534 cm->prefer_zomplex = false; |
| 5506 | 6535 |
| 5893 | 6536 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6537 if (spu == 0.) |
| 6538 { | |
| 6539 cm->print = -1; | |
| 7520 | 6540 cm->print_function = 0; |
| 5506 | 6541 } |
| 6542 else | |
| 6543 { | |
| 5760 | 6544 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6545 cm->print_function =&SparseCholPrint; |
| 6546 } | |
| 6547 | |
| 6548 cm->error_handler = &SparseCholError; | |
| 6549 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6550 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6551 | |
| 5526 | 6552 cm->final_ll = true; |
| 5506 | 6553 |
| 6554 cholmod_sparse Astore; | |
| 6555 cholmod_sparse *A = &Astore; | |
| 6556 double dummy; | |
| 6557 A->nrow = nr; | |
| 6558 A->ncol = nc; | |
| 6559 | |
| 6560 A->p = cidx(); | |
| 6561 A->i = ridx(); | |
| 5604 | 6562 A->nzmax = nnz(); |
| 5526 | 6563 A->packed = true; |
| 6564 A->sorted = true; | |
| 7520 | 6565 A->nz = 0; |
| 5506 | 6566 #ifdef IDX_TYPE_LONG |
| 6567 A->itype = CHOLMOD_LONG; | |
| 6568 #else | |
| 6569 A->itype = CHOLMOD_INT; | |
| 6570 #endif | |
| 6571 A->dtype = CHOLMOD_DOUBLE; | |
| 6572 A->stype = 1; | |
| 6573 A->xtype = CHOLMOD_REAL; | |
| 6574 | |
| 6575 if (nr < 1) | |
| 6576 A->x = &dummy; | |
| 6577 else | |
| 6578 A->x = data(); | |
| 6579 | |
| 6580 cholmod_sparse Bstore; | |
| 6581 cholmod_sparse *B = &Bstore; | |
| 6582 B->nrow = b.rows(); | |
| 6583 B->ncol = b.cols(); | |
| 6584 B->p = b.cidx(); | |
| 6585 B->i = b.ridx(); | |
| 5604 | 6586 B->nzmax = b.nnz(); |
| 5526 | 6587 B->packed = true; |
| 6588 B->sorted = true; | |
| 7520 | 6589 B->nz = 0; |
| 5506 | 6590 #ifdef IDX_TYPE_LONG |
| 6591 B->itype = CHOLMOD_LONG; | |
| 6592 #else | |
| 6593 B->itype = CHOLMOD_INT; | |
| 6594 #endif | |
| 6595 B->dtype = CHOLMOD_DOUBLE; | |
| 6596 B->stype = 0; | |
| 6597 B->xtype = CHOLMOD_COMPLEX; | |
| 6598 | |
| 6599 if (b.rows() < 1 || b.cols() < 1) | |
| 6600 B->x = &dummy; | |
| 6601 else | |
| 6602 B->x = b.data(); | |
| 6603 | |
| 6604 cholmod_factor *L; | |
| 6605 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6606 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6607 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6608 if (calc_cond) |
| 6609 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6610 else | |
| 6611 rcond = 1.0; | |
| 5506 | 6612 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6613 | |
| 6614 if (rcond == 0.0) | |
| 6615 { | |
| 6616 // Either its indefinite or singular. Try UMFPACK | |
| 6617 mattype.mark_as_unsymmetric (); | |
| 5785 | 6618 typ = MatrixType::Full; |
| 5506 | 6619 } |
| 6620 else | |
| 6621 { | |
| 6622 volatile double rcond_plus_one = rcond + 1.0; | |
| 6623 | |
| 6624 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6625 { | |
| 6626 err = -2; | |
| 6627 | |
| 6628 if (sing_handler) | |
| 5681 | 6629 { |
| 6630 sing_handler (rcond); | |
| 6631 mattype.mark_as_rectangular (); | |
| 6632 } | |
| 5506 | 6633 else |
| 6634 (*current_liboctave_error_handler) | |
| 6635 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6636 rcond); | |
| 6637 | |
| 6638 return retval; | |
| 6639 } | |
| 6640 | |
| 6641 cholmod_sparse *X; | |
| 6642 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6643 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 6644 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6645 | |
| 6646 retval = SparseComplexMatrix | |
| 6647 (static_cast<octave_idx_type>(X->nrow), | |
| 6648 static_cast<octave_idx_type>(X->ncol), | |
| 6649 static_cast<octave_idx_type>(X->nzmax)); | |
| 6650 for (octave_idx_type j = 0; | |
| 6651 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 6652 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 6653 for (octave_idx_type j = 0; | |
| 6654 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 6655 { | |
| 6656 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 6657 retval.xdata(j) = static_cast<Complex *>(X->x)[j]; | |
| 6658 } | |
| 6659 | |
| 6660 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6661 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 6662 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6663 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6664 static char tmp[] = " "; |
| 6665 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6666 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6667 } | |
| 6668 #else | |
| 5164 | 6669 (*current_liboctave_warning_handler) |
| 5506 | 6670 ("CHOLMOD not installed"); |
| 5164 | 6671 |
| 6672 mattype.mark_as_unsymmetric (); | |
| 5785 | 6673 typ = MatrixType::Full; |
| 5506 | 6674 #endif |
| 5164 | 6675 } |
| 6676 | |
| 5785 | 6677 if (typ == MatrixType::Full) |
| 5164 | 6678 { |
| 5203 | 6679 #ifdef HAVE_UMFPACK |
| 5164 | 6680 Matrix Control, Info; |
| 6681 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6682 sing_handler, calc_cond); |
| 5164 | 6683 |
| 6684 if (err == 0) | |
| 6685 { | |
| 5275 | 6686 octave_idx_type b_nr = b.rows (); |
| 6687 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6688 int status = 0; |
| 6689 double *control = Control.fortran_vec (); | |
| 6690 double *info = Info.fortran_vec (); | |
| 5275 | 6691 const octave_idx_type *Ap = cidx (); |
| 6692 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6693 const double *Ax = data (); |
| 6694 | |
| 6695 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6696 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 6697 | |
| 6698 // Take a first guess that the number of non-zero terms | |
| 6699 // will be as many as in b | |
| 5681 | 6700 octave_idx_type x_nz = b.nnz (); |
| 5275 | 6701 octave_idx_type ii = 0; |
| 5164 | 6702 retval = SparseComplexMatrix (b_nr, b_nc, x_nz); |
| 6703 | |
| 6704 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6705 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); | |
| 6706 | |
| 6707 retval.xcidx(0) = 0; | |
| 5275 | 6708 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6709 { |
| 5275 | 6710 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6711 { |
| 6712 Complex c = b (i,j); | |
| 5261 | 6713 Bx[i] = std::real (c); |
| 6714 Bz[i] = std::imag (c); | |
| 5164 | 6715 } |
| 6716 | |
| 5322 | 6717 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6718 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6719 info); |
| 5322 | 6720 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, |
| 6721 Ap, Ai, Ax, Xz, Bz, Numeric, | |
| 5164 | 6722 control, info) ; |
| 6723 | |
| 6724 if (status < 0 || status2 < 0) | |
| 6725 { | |
| 6726 (*current_liboctave_error_handler) | |
| 6727 ("SparseMatrix::solve solve failed"); | |
| 6728 | |
| 5322 | 6729 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6730 |
| 6731 err = -1; | |
| 6732 | |
| 6733 break; | |
| 6734 } | |
| 6735 | |
| 5275 | 6736 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6737 { |
| 6738 Complex tmp = Complex (Xx[i], Xz[i]); | |
| 6739 if (tmp != 0.0) | |
| 6740 { | |
| 6741 if (ii == x_nz) | |
| 6742 { | |
| 6743 // Resize the sparse matrix | |
| 5275 | 6744 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6745 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6746 retval.change_capacity (sz); | |
| 6747 x_nz = sz; | |
| 6748 } | |
| 6749 retval.xdata(ii) = tmp; | |
| 6750 retval.xridx(ii++) = i; | |
| 6751 } | |
| 6752 } | |
| 6753 retval.xcidx(j+1) = ii; | |
| 6754 } | |
| 6755 | |
| 6756 retval.maybe_compress (); | |
| 6757 | |
| 5322 | 6758 UMFPACK_DNAME (report_info) (control, info); |
| 6759 | |
| 6760 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6761 } |
| 5681 | 6762 else |
| 6763 mattype.mark_as_rectangular (); | |
| 5203 | 6764 #else |
| 6765 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6766 #endif | |
| 5164 | 6767 } |
| 5785 | 6768 else if (typ != MatrixType::Hermitian) |
| 5164 | 6769 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6770 } | |
| 6771 | |
| 6772 return retval; | |
| 6773 } | |
| 6774 | |
| 6775 Matrix | |
| 5785 | 6776 SparseMatrix::solve (MatrixType &mattype, const Matrix& b) const |
| 5164 | 6777 { |
| 5275 | 6778 octave_idx_type info; |
| 5164 | 6779 double rcond; |
| 6780 return solve (mattype, b, info, rcond, 0); | |
| 6781 } | |
| 6782 | |
| 6783 Matrix | |
| 5785 | 6784 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, |
| 5697 | 6785 octave_idx_type& info) const |
| 5164 | 6786 { |
| 6787 double rcond; | |
| 6788 return solve (mattype, b, info, rcond, 0); | |
| 6789 } | |
| 6790 | |
| 6791 Matrix | |
| 5785 | 6792 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, |
| 5164 | 6793 double& rcond) const |
| 6794 { | |
| 6795 return solve (mattype, b, info, rcond, 0); | |
| 6796 } | |
| 6797 | |
| 6798 Matrix | |
| 5785 | 6799 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, |
| 5697 | 6800 double& rcond, solve_singularity_handler sing_handler, |
| 6801 bool singular_fallback) const | |
| 5164 | 6802 { |
| 5681 | 6803 Matrix retval; |
| 5322 | 6804 int typ = mattype.type (false); |
| 5164 | 6805 |
| 5785 | 6806 if (typ == MatrixType::Unknown) |
| 5164 | 6807 typ = mattype.type (*this); |
| 6808 | |
| 5681 | 6809 // Only calculate the condition number for CHOLMOD/UMFPACK |
| 5785 | 6810 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6811 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6812 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6813 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6814 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6815 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6816 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6817 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6818 else if (typ == MatrixType::Tridiagonal || |
| 6819 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6820 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6821 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6822 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6823 else if (typ != MatrixType::Rectangular) |
| 5164 | 6824 { |
| 5681 | 6825 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6826 return Matrix (); |
| 6827 } | |
| 5681 | 6828 |
| 6829 // Rectangular or one of the above solvers flags a singular matrix | |
| 5785 | 6830 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) |
| 5681 | 6831 { |
| 6832 rcond = 1.; | |
| 6833 #ifdef USE_QRSOLVE | |
| 6834 retval = qrsolve (*this, b, err); | |
| 6835 #else | |
| 6836 retval = dmsolve<Matrix, SparseMatrix, Matrix> (*this, b, err); | |
| 6837 #endif | |
| 6838 } | |
| 6839 | |
| 6840 return retval; | |
| 5164 | 6841 } |
| 6842 | |
| 6843 SparseMatrix | |
| 5785 | 6844 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b) const |
| 5164 | 6845 { |
| 5275 | 6846 octave_idx_type info; |
| 5164 | 6847 double rcond; |
| 6848 return solve (mattype, b, info, rcond, 0); | |
| 6849 } | |
| 6850 | |
| 6851 SparseMatrix | |
| 5785 | 6852 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6853 octave_idx_type& info) const |
| 5164 | 6854 { |
| 6855 double rcond; | |
| 6856 return solve (mattype, b, info, rcond, 0); | |
| 6857 } | |
| 6858 | |
| 6859 SparseMatrix | |
| 5785 | 6860 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6861 octave_idx_type& info, double& rcond) const |
| 5164 | 6862 { |
| 6863 return solve (mattype, b, info, rcond, 0); | |
| 6864 } | |
| 6865 | |
| 6866 SparseMatrix | |
| 5785 | 6867 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6868 octave_idx_type& err, double& rcond, |
| 5697 | 6869 solve_singularity_handler sing_handler, |
| 6870 bool singular_fallback) const | |
| 5164 | 6871 { |
| 5681 | 6872 SparseMatrix retval; |
| 5322 | 6873 int typ = mattype.type (false); |
| 5164 | 6874 |
| 5785 | 6875 if (typ == MatrixType::Unknown) |
| 5164 | 6876 typ = mattype.type (*this); |
| 6877 | |
| 5785 | 6878 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6879 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6880 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6881 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6882 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6883 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6884 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6885 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6886 else if (typ == MatrixType::Tridiagonal || |
| 6887 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6888 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6889 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6890 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6891 else if (typ != MatrixType::Rectangular) |
| 5164 | 6892 { |
| 5681 | 6893 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6894 return SparseMatrix (); |
| 6895 } | |
| 5681 | 6896 |
| 5785 | 6897 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) |
| 5681 | 6898 { |
| 6899 rcond = 1.; | |
| 6900 #ifdef USE_QRSOLVE | |
| 6901 retval = qrsolve (*this, b, err); | |
| 6902 #else | |
| 6903 retval = dmsolve<SparseMatrix, SparseMatrix, | |
| 6904 SparseMatrix> (*this, b, err); | |
| 6905 #endif | |
| 6906 } | |
| 6907 | |
| 6908 return retval; | |
| 5164 | 6909 } |
| 6910 | |
| 6911 ComplexMatrix | |
| 5785 | 6912 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b) const |
| 5164 | 6913 { |
| 5275 | 6914 octave_idx_type info; |
| 5164 | 6915 double rcond; |
| 6916 return solve (mattype, b, info, rcond, 0); | |
| 6917 } | |
| 6918 | |
| 6919 ComplexMatrix | |
| 5785 | 6920 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6921 octave_idx_type& info) const |
| 5164 | 6922 { |
| 6923 double rcond; | |
| 6924 return solve (mattype, b, info, rcond, 0); | |
| 6925 } | |
| 6926 | |
| 6927 ComplexMatrix | |
| 5785 | 6928 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6929 octave_idx_type& info, double& rcond) const |
| 5164 | 6930 { |
| 6931 return solve (mattype, b, info, rcond, 0); | |
| 6932 } | |
| 6933 | |
| 6934 ComplexMatrix | |
| 5785 | 6935 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6936 octave_idx_type& err, double& rcond, |
| 5697 | 6937 solve_singularity_handler sing_handler, |
| 6938 bool singular_fallback) const | |
| 5164 | 6939 { |
| 5681 | 6940 ComplexMatrix retval; |
| 5322 | 6941 int typ = mattype.type (false); |
| 5164 | 6942 |
| 5785 | 6943 if (typ == MatrixType::Unknown) |
| 5164 | 6944 typ = mattype.type (*this); |
| 6945 | |
| 5785 | 6946 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6947 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6948 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6949 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6950 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6951 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6952 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6953 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6954 else if (typ == MatrixType::Tridiagonal || |
| 6955 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6956 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6957 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6958 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6959 else if (typ != MatrixType::Rectangular) |
| 5164 | 6960 { |
| 5681 | 6961 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6962 return ComplexMatrix (); |
| 6963 } | |
| 5681 | 6964 |
| 5785 | 6965 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6966 { |
| 6967 rcond = 1.; | |
| 6968 #ifdef USE_QRSOLVE | |
| 6969 retval = qrsolve (*this, b, err); | |
| 6970 #else | |
| 6971 retval = dmsolve<ComplexMatrix, SparseMatrix, | |
| 6972 ComplexMatrix> (*this, b, err); | |
| 6973 #endif | |
| 6974 } | |
| 6975 | |
| 6976 return retval; | |
| 5164 | 6977 } |
| 6978 | |
| 6979 SparseComplexMatrix | |
| 5785 | 6980 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b) const |
| 5164 | 6981 { |
| 5275 | 6982 octave_idx_type info; |
| 5164 | 6983 double rcond; |
| 6984 return solve (mattype, b, info, rcond, 0); | |
| 6985 } | |
| 6986 | |
| 6987 SparseComplexMatrix | |
| 5785 | 6988 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6989 octave_idx_type& info) const |
| 5164 | 6990 { |
| 6991 double rcond; | |
| 6992 return solve (mattype, b, info, rcond, 0); | |
| 6993 } | |
| 6994 | |
| 6995 SparseComplexMatrix | |
| 5785 | 6996 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6997 octave_idx_type& info, double& rcond) const |
| 5164 | 6998 { |
| 6999 return solve (mattype, b, info, rcond, 0); | |
| 7000 } | |
| 7001 | |
| 7002 SparseComplexMatrix | |
| 5785 | 7003 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 7004 octave_idx_type& err, double& rcond, |
| 5697 | 7005 solve_singularity_handler sing_handler, |
| 7006 bool singular_fallback) const | |
| 5164 | 7007 { |
| 5681 | 7008 SparseComplexMatrix retval; |
| 5322 | 7009 int typ = mattype.type (false); |
| 5164 | 7010 |
| 5785 | 7011 if (typ == MatrixType::Unknown) |
| 5164 | 7012 typ = mattype.type (*this); |
| 7013 | |
| 5785 | 7014 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 7015 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7016 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 7017 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7018 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 7019 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7020 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 7021 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7022 else if (typ == MatrixType::Tridiagonal || |
| 7023 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 7024 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 7025 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 7026 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 7027 else if (typ != MatrixType::Rectangular) |
| 5164 | 7028 { |
| 5681 | 7029 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 7030 return SparseComplexMatrix (); |
| 7031 } | |
| 5681 | 7032 |
| 5785 | 7033 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 7034 { |
| 7035 rcond = 1.; | |
| 7036 #ifdef USE_QRSOLVE | |
| 7037 retval = qrsolve (*this, b, err); | |
| 7038 #else | |
| 7039 retval = dmsolve<SparseComplexMatrix, SparseMatrix, | |
| 7040 SparseComplexMatrix> (*this, b, err); | |
| 7041 #endif | |
| 7042 } | |
| 7043 | |
| 7044 return retval; | |
| 5164 | 7045 } |
| 7046 | |
| 7047 ColumnVector | |
| 5785 | 7048 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b) const |
| 5164 | 7049 { |
| 5275 | 7050 octave_idx_type info; double rcond; |
| 5164 | 7051 return solve (mattype, b, info, rcond); |
| 7052 } | |
| 7053 | |
| 7054 ColumnVector | |
| 5785 | 7055 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info) const |
| 5164 | 7056 { |
| 7057 double rcond; | |
| 7058 return solve (mattype, b, info, rcond); | |
| 7059 } | |
| 7060 | |
| 7061 ColumnVector | |
| 5785 | 7062 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond) const |
| 5164 | 7063 { |
| 7064 return solve (mattype, b, info, rcond, 0); | |
| 7065 } | |
| 7066 | |
| 7067 ColumnVector | |
| 5785 | 7068 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7069 solve_singularity_handler sing_handler) const |
| 7070 { | |
| 7071 Matrix tmp (b); | |
| 5275 | 7072 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7073 } |
| 7074 | |
| 7075 ComplexColumnVector | |
| 5785 | 7076 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b) const |
| 5164 | 7077 { |
| 5275 | 7078 octave_idx_type info; |
| 5164 | 7079 double rcond; |
| 7080 return solve (mattype, b, info, rcond, 0); | |
| 7081 } | |
| 7082 | |
| 7083 ComplexColumnVector | |
| 5785 | 7084 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info) const |
| 5164 | 7085 { |
| 7086 double rcond; | |
| 7087 return solve (mattype, b, info, rcond, 0); | |
| 7088 } | |
| 7089 | |
| 7090 ComplexColumnVector | |
| 5785 | 7091 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7092 double& rcond) const |
| 7093 { | |
| 7094 return solve (mattype, b, info, rcond, 0); | |
| 7095 } | |
| 7096 | |
| 7097 ComplexColumnVector | |
| 5785 | 7098 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7099 solve_singularity_handler sing_handler) const |
| 7100 { | |
| 7101 ComplexMatrix tmp (b); | |
| 5275 | 7102 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7103 } |
| 7104 | |
| 7105 Matrix | |
| 7106 SparseMatrix::solve (const Matrix& b) const | |
| 7107 { | |
| 5275 | 7108 octave_idx_type info; |
| 5164 | 7109 double rcond; |
| 7110 return solve (b, info, rcond, 0); | |
| 7111 } | |
| 7112 | |
| 7113 Matrix | |
| 5275 | 7114 SparseMatrix::solve (const Matrix& b, octave_idx_type& info) const |
| 5164 | 7115 { |
| 7116 double rcond; | |
| 7117 return solve (b, info, rcond, 0); | |
| 7118 } | |
| 7119 | |
| 7120 Matrix | |
| 5275 | 7121 SparseMatrix::solve (const Matrix& b, octave_idx_type& info, |
| 5164 | 7122 double& rcond) const |
| 7123 { | |
| 7124 return solve (b, info, rcond, 0); | |
| 7125 } | |
| 7126 | |
| 7127 Matrix | |
| 5275 | 7128 SparseMatrix::solve (const Matrix& b, octave_idx_type& err, |
| 5164 | 7129 double& rcond, |
| 7130 solve_singularity_handler sing_handler) const | |
| 7131 { | |
| 5785 | 7132 MatrixType mattype (*this); |
| 5164 | 7133 return solve (mattype, b, err, rcond, sing_handler); |
| 7134 } | |
| 7135 | |
| 7136 SparseMatrix | |
| 7137 SparseMatrix::solve (const SparseMatrix& b) const | |
| 7138 { | |
| 5275 | 7139 octave_idx_type info; |
| 5164 | 7140 double rcond; |
| 7141 return solve (b, info, rcond, 0); | |
| 7142 } | |
| 7143 | |
| 7144 SparseMatrix | |
| 7145 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7146 octave_idx_type& info) const |
| 5164 | 7147 { |
| 7148 double rcond; | |
| 7149 return solve (b, info, rcond, 0); | |
| 7150 } | |
| 7151 | |
| 7152 SparseMatrix | |
| 7153 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7154 octave_idx_type& info, double& rcond) const |
| 5164 | 7155 { |
| 7156 return solve (b, info, rcond, 0); | |
| 7157 } | |
| 7158 | |
| 7159 SparseMatrix | |
| 7160 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7161 octave_idx_type& err, double& rcond, |
| 5164 | 7162 solve_singularity_handler sing_handler) const |
| 7163 { | |
| 5785 | 7164 MatrixType mattype (*this); |
| 5164 | 7165 return solve (mattype, b, err, rcond, sing_handler); |
| 7166 } | |
| 7167 | |
| 7168 ComplexMatrix | |
| 7169 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7170 octave_idx_type& info) const |
| 5164 | 7171 { |
| 7172 double rcond; | |
| 7173 return solve (b, info, rcond, 0); | |
| 7174 } | |
| 7175 | |
| 7176 ComplexMatrix | |
| 7177 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7178 octave_idx_type& info, double& rcond) const |
| 5164 | 7179 { |
| 7180 return solve (b, info, rcond, 0); | |
| 7181 } | |
| 7182 | |
| 7183 ComplexMatrix | |
| 7184 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7185 octave_idx_type& err, double& rcond, |
| 5164 | 7186 solve_singularity_handler sing_handler) const |
| 7187 { | |
| 5785 | 7188 MatrixType mattype (*this); |
| 5164 | 7189 return solve (mattype, b, err, rcond, sing_handler); |
| 7190 } | |
| 7191 | |
| 7192 SparseComplexMatrix | |
| 7193 SparseMatrix::solve (const SparseComplexMatrix& b) const | |
| 7194 { | |
| 5275 | 7195 octave_idx_type info; |
| 5164 | 7196 double rcond; |
| 7197 return solve (b, info, rcond, 0); | |
| 7198 } | |
| 7199 | |
| 7200 SparseComplexMatrix | |
| 7201 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7202 octave_idx_type& info) const |
| 5164 | 7203 { |
| 7204 double rcond; | |
| 7205 return solve (b, info, rcond, 0); | |
| 7206 } | |
| 7207 | |
| 7208 SparseComplexMatrix | |
| 7209 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7210 octave_idx_type& info, double& rcond) const |
| 5164 | 7211 { |
| 7212 return solve (b, info, rcond, 0); | |
| 7213 } | |
| 7214 | |
| 7215 SparseComplexMatrix | |
| 7216 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7217 octave_idx_type& err, double& rcond, |
| 5164 | 7218 solve_singularity_handler sing_handler) const |
| 7219 { | |
| 5785 | 7220 MatrixType mattype (*this); |
| 5164 | 7221 return solve (mattype, b, err, rcond, sing_handler); |
| 7222 } | |
| 7223 | |
| 7224 ColumnVector | |
| 7225 SparseMatrix::solve (const ColumnVector& b) const | |
| 7226 { | |
| 5275 | 7227 octave_idx_type info; double rcond; |
| 5164 | 7228 return solve (b, info, rcond); |
| 7229 } | |
| 7230 | |
| 7231 ColumnVector | |
| 5275 | 7232 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info) const |
| 5164 | 7233 { |
| 7234 double rcond; | |
| 7235 return solve (b, info, rcond); | |
| 7236 } | |
| 7237 | |
| 7238 ColumnVector | |
| 5275 | 7239 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond) const |
| 5164 | 7240 { |
| 7241 return solve (b, info, rcond, 0); | |
| 7242 } | |
| 7243 | |
| 7244 ColumnVector | |
| 5275 | 7245 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7246 solve_singularity_handler sing_handler) const |
| 7247 { | |
| 7248 Matrix tmp (b); | |
| 5275 | 7249 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7250 } |
| 7251 | |
| 7252 ComplexColumnVector | |
| 7253 SparseMatrix::solve (const ComplexColumnVector& b) const | |
| 7254 { | |
| 5275 | 7255 octave_idx_type info; |
| 5164 | 7256 double rcond; |
| 7257 return solve (b, info, rcond, 0); | |
| 7258 } | |
| 7259 | |
| 7260 ComplexColumnVector | |
| 5275 | 7261 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const |
| 5164 | 7262 { |
| 7263 double rcond; | |
| 7264 return solve (b, info, rcond, 0); | |
| 7265 } | |
| 7266 | |
| 7267 ComplexColumnVector | |
| 5275 | 7268 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7269 double& rcond) const |
| 7270 { | |
| 7271 return solve (b, info, rcond, 0); | |
| 7272 } | |
| 7273 | |
| 7274 ComplexColumnVector | |
| 5275 | 7275 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7276 solve_singularity_handler sing_handler) const |
| 7277 { | |
| 7278 ComplexMatrix tmp (b); | |
| 5275 | 7279 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7280 } |
| 7281 | |
| 7282 // other operations. | |
| 7283 | |
| 7284 bool | |
| 7285 SparseMatrix::any_element_is_negative (bool neg_zero) const | |
| 7286 { | |
| 5681 | 7287 octave_idx_type nel = nnz (); |
| 5164 | 7288 |
| 7289 if (neg_zero) | |
| 7290 { | |
| 5275 | 7291 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7292 if (lo_ieee_signbit (data (i))) |
| 7293 return true; | |
| 7294 } | |
| 7295 else | |
| 7296 { | |
| 5275 | 7297 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7298 if (data (i) < 0) |
| 7299 return true; | |
| 7300 } | |
| 7301 | |
| 7302 return false; | |
| 7303 } | |
| 7304 | |
| 7305 bool | |
|
7922
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7306 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
|
7307 { |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7308 octave_idx_type nel = nnz (); |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7309 |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7310 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
|
7311 { |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7312 double val = data (i); |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7313 if (xisnan (val)) |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7314 return true; |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7315 } |
|
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 return false; |
|
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 |
|
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7802
diff
changeset
|
7320 bool |
| 5164 | 7321 SparseMatrix::any_element_is_inf_or_nan (void) const |
| 7322 { | |
| 5681 | 7323 octave_idx_type nel = nnz (); |
| 5275 | 7324 |
| 7325 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7326 { |
| 7327 double val = data (i); | |
| 7328 if (xisinf (val) || xisnan (val)) | |
| 7329 return true; | |
| 7330 } | |
| 7331 | |
| 7332 return false; | |
| 7333 } | |
| 7334 | |
| 7335 bool | |
| 6989 | 7336 SparseMatrix::all_elements_are_zero (void) const |
| 7337 { | |
| 7338 octave_idx_type nel = nnz (); | |
| 7339 | |
| 7340 for (octave_idx_type i = 0; i < nel; i++) | |
| 7341 if (data (i) != 0) | |
| 7342 return false; | |
| 7343 | |
| 7344 return true; | |
| 7345 } | |
| 7346 | |
| 7347 bool | |
| 5164 | 7348 SparseMatrix::all_elements_are_int_or_inf_or_nan (void) const |
| 7349 { | |
| 5681 | 7350 octave_idx_type nel = nnz (); |
| 5275 | 7351 |
| 7352 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7353 { |
| 7354 double val = data (i); | |
| 7355 if (xisnan (val) || D_NINT (val) == val) | |
| 7356 continue; | |
| 7357 else | |
| 7358 return false; | |
| 7359 } | |
| 7360 | |
| 7361 return true; | |
| 7362 } | |
| 7363 | |
| 7364 // Return nonzero if any element of M is not an integer. Also extract | |
| 7365 // the largest and smallest values and return them in MAX_VAL and MIN_VAL. | |
| 7366 | |
| 7367 bool | |
| 7368 SparseMatrix::all_integers (double& max_val, double& min_val) const | |
| 7369 { | |
| 5681 | 7370 octave_idx_type nel = nnz (); |
| 5164 | 7371 |
| 7372 if (nel == 0) | |
| 7373 return false; | |
| 7374 | |
| 7375 max_val = data (0); | |
| 7376 min_val = data (0); | |
| 7377 | |
| 5275 | 7378 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7379 { |
| 7380 double val = data (i); | |
| 7381 | |
| 7382 if (val > max_val) | |
| 7383 max_val = val; | |
| 7384 | |
| 7385 if (val < min_val) | |
| 7386 min_val = val; | |
| 7387 | |
| 7388 if (D_NINT (val) != val) | |
| 7389 return false; | |
| 7390 } | |
| 7391 | |
| 7392 return true; | |
| 7393 } | |
| 7394 | |
| 7395 bool | |
| 7396 SparseMatrix::too_large_for_float (void) const | |
| 7397 { | |
| 5681 | 7398 octave_idx_type nel = nnz (); |
| 5275 | 7399 |
| 7400 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7401 { |
| 7402 double val = data (i); | |
| 7403 | |
| 7404 if (val > FLT_MAX || val < FLT_MIN) | |
| 7405 return true; | |
| 7406 } | |
| 7407 | |
| 7408 return false; | |
| 7409 } | |
| 7410 | |
| 7411 SparseBoolMatrix | |
| 7412 SparseMatrix::operator ! (void) const | |
| 7413 { | |
| 5275 | 7414 octave_idx_type nr = rows (); |
| 7415 octave_idx_type nc = cols (); | |
| 5681 | 7416 octave_idx_type nz1 = nnz (); |
| 5275 | 7417 octave_idx_type nz2 = nr*nc - nz1; |
| 5164 | 7418 |
| 7419 SparseBoolMatrix r (nr, nc, nz2); | |
| 7420 | |
| 5275 | 7421 octave_idx_type ii = 0; |
| 7422 octave_idx_type jj = 0; | |
| 5164 | 7423 r.cidx (0) = 0; |
| 5275 | 7424 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 7425 { |
| 5275 | 7426 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 7427 { |
| 7428 if (jj < cidx(i+1) && ridx(jj) == j) | |
| 7429 jj++; | |
| 7430 else | |
| 7431 { | |
| 7432 r.data(ii) = true; | |
| 7433 r.ridx(ii++) = j; | |
| 7434 } | |
| 7435 } | |
| 7436 r.cidx (i+1) = ii; | |
| 7437 } | |
| 7438 | |
| 7439 return r; | |
| 7440 } | |
| 7441 | |
| 5775 | 7442 // FIXME Do these really belong here? Maybe they should be |
| 5164 | 7443 // in a base class? |
| 7444 | |
| 7445 SparseBoolMatrix | |
| 7446 SparseMatrix::all (int dim) const | |
| 7447 { | |
| 7448 SPARSE_ALL_OP (dim); | |
| 7449 } | |
| 7450 | |
| 7451 SparseBoolMatrix | |
| 7452 SparseMatrix::any (int dim) const | |
| 7453 { | |
| 7454 SPARSE_ANY_OP (dim); | |
| 7455 } | |
| 7456 | |
| 7457 SparseMatrix | |
| 7458 SparseMatrix::cumprod (int dim) const | |
| 7459 { | |
| 7460 SPARSE_CUMPROD (SparseMatrix, double, cumprod); | |
| 7461 } | |
| 7462 | |
| 7463 SparseMatrix | |
| 7464 SparseMatrix::cumsum (int dim) const | |
| 7465 { | |
| 7466 SPARSE_CUMSUM (SparseMatrix, double, cumsum); | |
| 7467 } | |
| 7468 | |
| 7469 SparseMatrix | |
| 7470 SparseMatrix::prod (int dim) const | |
| 7471 { | |
| 7269 | 7472 if ((rows() == 1 && dim == -1) || dim == 1) |
| 7473 return transpose (). prod (0). transpose(); | |
| 7474 else | |
| 7475 { | |
| 7476 SPARSE_REDUCTION_OP (SparseMatrix, double, *=, | |
| 7477 (cidx(j+1) - cidx(j) < nc ? 0.0 : 1.0), 1.0); | |
| 7478 } | |
| 5164 | 7479 } |
| 7480 | |
| 7481 SparseMatrix | |
| 7482 SparseMatrix::sum (int dim) const | |
| 7483 { | |
| 7484 SPARSE_REDUCTION_OP (SparseMatrix, double, +=, 0.0, 0.0); | |
| 7485 } | |
| 7486 | |
| 7487 SparseMatrix | |
| 7488 SparseMatrix::sumsq (int dim) const | |
| 7489 { | |
| 7490 #define ROW_EXPR \ | |
| 7269 | 7491 double d = data (i); \ |
| 7492 tmp[ridx(i)] += d * d | |
| 5164 | 7493 |
| 7494 #define COL_EXPR \ | |
| 7269 | 7495 double d = data (i); \ |
| 5164 | 7496 tmp[j] += d * d |
| 7497 | |
| 7498 SPARSE_BASE_REDUCTION_OP (SparseMatrix, double, ROW_EXPR, COL_EXPR, | |
| 7499 0.0, 0.0); | |
| 7500 | |
| 7501 #undef ROW_EXPR | |
| 7502 #undef COL_EXPR | |
| 7503 } | |
| 7504 | |
| 7505 SparseMatrix | |
| 7506 SparseMatrix::abs (void) const | |
| 7507 { | |
| 5681 | 7508 octave_idx_type nz = nnz (); |
| 5164 | 7509 |
| 7510 SparseMatrix retval (*this); | |
| 7511 | |
| 5275 | 7512 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7513 retval.data(i) = fabs(retval.data(i)); |
| 7514 | |
| 7515 return retval; | |
| 7516 } | |
| 7517 | |
| 7518 SparseMatrix | |
| 5275 | 7519 SparseMatrix::diag (octave_idx_type k) const |
| 5164 | 7520 { |
|
7620
36594d5bbe13
Move diag function into the octave_value class
David Bateman <dbateman@free.fr>
parents:
7602
diff
changeset
|
7521 return MSparse<double>::diag (k); |
| 5164 | 7522 } |
| 7523 | |
| 7524 Matrix | |
| 7525 SparseMatrix::matrix_value (void) const | |
| 7526 { | |
| 5275 | 7527 octave_idx_type nr = rows (); |
| 7528 octave_idx_type nc = cols (); | |
| 5164 | 7529 |
| 7530 Matrix retval (nr, nc, 0.0); | |
| 5275 | 7531 for (octave_idx_type j = 0; j < nc; j++) |
| 7532 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 7533 retval.elem (ridx(i), j) = data (i); |
| 7534 | |
| 7535 return retval; | |
| 7536 } | |
| 7537 | |
|
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7538 SparseMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7539 SparseMatrix::map (dmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7540 { |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
7541 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
|
7542 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7543 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7544 SparseComplexMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7545 SparseMatrix::map (cmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7546 { |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
7547 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
|
7548 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7549 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7550 SparseBoolMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7551 SparseMatrix::map (bmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7552 { |
|
7602
7bfaa9611558
Rewrite sparse mappers in terms of a functor template function
David Bateman <dbateman@free.fr>
parents:
7520
diff
changeset
|
7553 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
|
7554 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7555 |
| 5164 | 7556 std::ostream& |
| 7557 operator << (std::ostream& os, const SparseMatrix& a) | |
| 7558 { | |
| 5275 | 7559 octave_idx_type nc = a.cols (); |
| 5164 | 7560 |
| 7561 // add one to the printed indices to go from | |
| 7562 // zero-based to one-based arrays | |
| 5275 | 7563 for (octave_idx_type j = 0; j < nc; j++) { |
| 5164 | 7564 OCTAVE_QUIT; |
| 5275 | 7565 for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) { |
| 5164 | 7566 os << a.ridx(i) + 1 << " " << j + 1 << " "; |
| 7567 octave_write_double (os, a.data(i)); | |
| 7568 os << "\n"; | |
| 7569 } | |
| 7570 } | |
| 7571 | |
| 7572 return os; | |
| 7573 } | |
| 7574 | |
| 7575 std::istream& | |
| 7576 operator >> (std::istream& is, SparseMatrix& a) | |
| 7577 { | |
| 5275 | 7578 octave_idx_type nr = a.rows (); |
| 7579 octave_idx_type nc = a.cols (); | |
| 5604 | 7580 octave_idx_type nz = a.nzmax (); |
| 5164 | 7581 |
| 7582 if (nr < 1 || nc < 1) | |
| 7583 is.clear (std::ios::badbit); | |
| 7584 else | |
| 7585 { | |
| 5275 | 7586 octave_idx_type itmp, jtmp, jold = 0; |
| 5164 | 7587 double tmp; |
| 5275 | 7588 octave_idx_type ii = 0; |
| 5164 | 7589 |
| 7590 a.cidx (0) = 0; | |
| 5275 | 7591 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7592 { |
| 7593 is >> itmp; | |
| 7594 itmp--; | |
| 7595 is >> jtmp; | |
| 7596 jtmp--; | |
| 7597 tmp = octave_read_double (is); | |
| 7598 | |
| 7599 if (is) | |
| 7600 { | |
| 7601 if (jold != jtmp) | |
| 7602 { | |
| 5275 | 7603 for (octave_idx_type j = jold; j < jtmp; j++) |
| 5164 | 7604 a.cidx(j+1) = ii; |
| 7605 | |
| 7606 jold = jtmp; | |
| 7607 } | |
| 7608 a.data (ii) = tmp; | |
| 7609 a.ridx (ii++) = itmp; | |
| 7610 } | |
| 7611 else | |
| 7612 goto done; | |
| 7613 } | |
| 7614 | |
| 5275 | 7615 for (octave_idx_type j = jold; j < nc; j++) |
| 5164 | 7616 a.cidx(j+1) = ii; |
| 7617 } | |
| 7618 | |
| 7619 done: | |
| 7620 | |
| 7621 return is; | |
| 7622 } | |
| 7623 | |
| 7624 SparseMatrix | |
| 7625 SparseMatrix::squeeze (void) const | |
| 7626 { | |
| 7627 return MSparse<double>::squeeze (); | |
| 7628 } | |
| 7629 | |
| 7630 SparseMatrix | |
| 7631 SparseMatrix::index (idx_vector& i, int resize_ok) const | |
| 7632 { | |
| 7633 return MSparse<double>::index (i, resize_ok); | |
| 7634 } | |
| 7635 | |
| 7636 SparseMatrix | |
| 7637 SparseMatrix::index (idx_vector& i, idx_vector& j, int resize_ok) const | |
| 7638 { | |
| 7639 return MSparse<double>::index (i, j, resize_ok); | |
| 7640 } | |
| 7641 | |
| 7642 SparseMatrix | |
| 7643 SparseMatrix::index (Array<idx_vector>& ra_idx, int resize_ok) const | |
| 7644 { | |
| 7645 return MSparse<double>::index (ra_idx, resize_ok); | |
| 7646 } | |
| 7647 | |
| 7648 SparseMatrix | |
| 7649 SparseMatrix::reshape (const dim_vector& new_dims) const | |
| 7650 { | |
| 7651 return MSparse<double>::reshape (new_dims); | |
| 7652 } | |
| 7653 | |
| 7654 SparseMatrix | |
| 5275 | 7655 SparseMatrix::permute (const Array<octave_idx_type>& vec, bool inv) const |
| 5164 | 7656 { |
| 7657 return MSparse<double>::permute (vec, inv); | |
| 7658 } | |
| 7659 | |
| 7660 SparseMatrix | |
| 5275 | 7661 SparseMatrix::ipermute (const Array<octave_idx_type>& vec) const |
| 5164 | 7662 { |
| 7663 return MSparse<double>::ipermute (vec); | |
| 7664 } | |
| 7665 | |
| 7666 // matrix by matrix -> matrix operations | |
| 7667 | |
| 7668 SparseMatrix | |
| 7669 operator * (const SparseMatrix& m, const SparseMatrix& a) | |
| 7670 { | |
| 5681 | 7671 SPARSE_SPARSE_MUL (SparseMatrix, double, double); |
| 5164 | 7672 } |
| 7673 | |
| 5429 | 7674 Matrix |
| 7675 operator * (const Matrix& m, const SparseMatrix& a) | |
| 7676 { | |
| 5681 | 7677 FULL_SPARSE_MUL (Matrix, double, 0.); |
| 5429 | 7678 } |
| 7679 | |
| 7680 Matrix | |
|
7802
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7681 mul_trans (const Matrix& m, const SparseMatrix& a) |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7682 { |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7683 FULL_SPARSE_MUL_TRANS (Matrix, double, 0., ); |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7684 } |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7685 |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7686 Matrix |
| 5429 | 7687 operator * (const SparseMatrix& m, const Matrix& a) |
| 7688 { | |
| 5681 | 7689 SPARSE_FULL_MUL (Matrix, double, 0.); |
| 5429 | 7690 } |
| 7691 | |
|
7802
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7692 Matrix |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7693 trans_mul (const SparseMatrix& m, const Matrix& a) |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7694 { |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7695 SPARSE_FULL_TRANS_MUL (Matrix, double, 0., ); |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7696 } |
|
1a446f28ce68
implement optimized sparse-dense transposed multiplication
Jaroslav Hajek <highegg@gmail.com>
parents:
7776
diff
changeset
|
7697 |
| 5775 | 7698 // FIXME -- it would be nice to share code among the min/max |
| 5164 | 7699 // functions below. |
| 7700 | |
| 7701 #define EMPTY_RETURN_CHECK(T) \ | |
| 7702 if (nr == 0 || nc == 0) \ | |
| 7703 return T (nr, nc); | |
| 7704 | |
| 7705 SparseMatrix | |
| 7706 min (double d, const SparseMatrix& m) | |
| 7707 { | |
| 7708 SparseMatrix result; | |
| 7709 | |
| 5275 | 7710 octave_idx_type nr = m.rows (); |
| 7711 octave_idx_type nc = m.columns (); | |
| 5164 | 7712 |
| 7713 EMPTY_RETURN_CHECK (SparseMatrix); | |
| 7714 | |
| 7715 // Count the number of non-zero elements | |
| 7716 if (d < 0.) | |
| 7717 { | |
| 7718 result = SparseMatrix (nr, nc, d); | |
| 5275 | 7719 for (octave_idx_type j = 0; j < nc; j++) |
| 7720 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7721 { |
| 7722 double tmp = xmin (d, m.data (i)); | |
| 7723 if (tmp != 0.) | |
| 7724 { | |
| 5275 | 7725 octave_idx_type idx = m.ridx(i) + j * nr; |
| 5164 | 7726 result.xdata(idx) = tmp; |
| 7727 result.xridx(idx) = m.ridx(i); | |
| 7728 } | |
| 7729 } | |
| 7730 } | |
| 7731 else | |
| 7732 { | |
| 5275 | 7733 octave_idx_type nel = 0; |
| 7734 for (octave_idx_type j = 0; j < nc; j++) | |
| 7735 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7736 if (xmin (d, m.data (i)) != 0.) |
| 7737 nel++; | |
| 7738 | |
| 7739 result = SparseMatrix (nr, nc, nel); | |
| 7740 | |
| 5275 | 7741 octave_idx_type ii = 0; |
| 5164 | 7742 result.xcidx(0) = 0; |
| 5275 | 7743 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 7744 { |
| 5275 | 7745 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
| 5164 | 7746 { |
| 7747 double tmp = xmin (d, m.data (i)); | |
| 7748 | |
| 7749 if (tmp != 0.) | |
| 7750 { | |
| 7751 result.xdata(ii) = tmp; | |
| 7752 result.xridx(ii++) = m.ridx(i); | |
| 7753 } | |
| 7754 } | |
| 7755 result.xcidx(j+1) = ii; | |
| 7756 } | |
| 7757 } | |
| 7758 | |
| 7759 return result; | |
| 7760 } | |
| 7761 | |
| 7762 SparseMatrix | |
| 7763 min (const SparseMatrix& m, double d) | |
| 7764 { | |
| 7765 return min (d, m); | |
| 7766 } | |
| 7767 | |
| 7768 SparseMatrix | |
| 7769 min (const SparseMatrix& a, const SparseMatrix& b) | |
| 7770 { | |
| 7771 SparseMatrix r; | |
| 7772 | |
| 7773 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 7774 { | |
| 5275 | 7775 octave_idx_type a_nr = a.rows (); |
| 7776 octave_idx_type a_nc = a.cols (); | |
| 7777 | |
| 7778 octave_idx_type b_nr = b.rows (); | |
| 7779 octave_idx_type b_nc = b.cols (); | |
| 5164 | 7780 |
| 7781 if (a_nr != b_nr || a_nc != b_nc) | |
| 7782 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 7783 else | |
| 7784 { | |
| 5681 | 7785 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 7786 |
| 5275 | 7787 octave_idx_type jx = 0; |
| 5164 | 7788 r.cidx (0) = 0; |
| 5275 | 7789 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 7790 { |
| 5275 | 7791 octave_idx_type ja = a.cidx(i); |
| 7792 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 7793 bool ja_lt_max= ja < ja_max; |
| 7794 | |
| 5275 | 7795 octave_idx_type jb = b.cidx(i); |
| 7796 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 7797 bool jb_lt_max = jb < jb_max; |
| 7798 | |
| 7799 while (ja_lt_max || jb_lt_max ) | |
| 7800 { | |
| 7801 OCTAVE_QUIT; | |
| 7802 if ((! jb_lt_max) || | |
| 7803 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 7804 { | |
| 7805 double tmp = xmin (a.data(ja), 0.); | |
| 7806 if (tmp != 0.) | |
| 7807 { | |
| 7808 r.ridx(jx) = a.ridx(ja); | |
| 7809 r.data(jx) = tmp; | |
| 7810 jx++; | |
| 7811 } | |
| 7812 ja++; | |
| 7813 ja_lt_max= ja < ja_max; | |
| 7814 } | |
| 7815 else if (( !ja_lt_max ) || | |
| 7816 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 7817 { | |
| 7818 double tmp = xmin (0., b.data(jb)); | |
| 7819 if (tmp != 0.) | |
| 7820 { | |
| 7821 r.ridx(jx) = b.ridx(jb); | |
| 7822 r.data(jx) = tmp; | |
| 7823 jx++; | |
| 7824 } | |
| 7825 jb++; | |
| 7826 jb_lt_max= jb < jb_max; | |
| 7827 } | |
| 7828 else | |
| 7829 { | |
| 7830 double tmp = xmin (a.data(ja), b.data(jb)); | |
| 7831 if (tmp != 0.) | |
| 7832 { | |
| 7833 r.data(jx) = tmp; | |
| 7834 r.ridx(jx) = a.ridx(ja); | |
| 7835 jx++; | |
| 7836 } | |
| 7837 ja++; | |
| 7838 ja_lt_max= ja < ja_max; | |
| 7839 jb++; | |
| 7840 jb_lt_max= jb < jb_max; | |
| 7841 } | |
| 7842 } | |
| 7843 r.cidx(i+1) = jx; | |
| 7844 } | |
| 7845 | |
| 7846 r.maybe_compress (); | |
| 7847 } | |
| 7848 } | |
| 7849 else | |
| 7850 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 7851 | |
| 7852 return r; | |
| 7853 } | |
| 7854 | |
| 7855 SparseMatrix | |
| 7856 max (double d, const SparseMatrix& m) | |
| 7857 { | |
| 7858 SparseMatrix result; | |
| 7859 | |
| 5275 | 7860 octave_idx_type nr = m.rows (); |
| 7861 octave_idx_type nc = m.columns (); | |
| 5164 | 7862 |
| 7863 EMPTY_RETURN_CHECK (SparseMatrix); | |
| 7864 | |
| 7865 // Count the number of non-zero elements | |
| 7866 if (d > 0.) | |
| 7867 { | |
| 7868 result = SparseMatrix (nr, nc, d); | |
| 5275 | 7869 for (octave_idx_type j = 0; j < nc; j++) |
| 7870 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7871 { |
| 7872 double tmp = xmax (d, m.data (i)); | |
| 7873 | |
| 7874 if (tmp != 0.) | |
| 7875 { | |
| 5275 | 7876 octave_idx_type idx = m.ridx(i) + j * nr; |
| 5164 | 7877 result.xdata(idx) = tmp; |
| 7878 result.xridx(idx) = m.ridx(i); | |
| 7879 } | |
| 7880 } | |
| 7881 } | |
| 7882 else | |
| 7883 { | |
| 5275 | 7884 octave_idx_type nel = 0; |
| 7885 for (octave_idx_type j = 0; j < nc; j++) | |
| 7886 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7887 if (xmax (d, m.data (i)) != 0.) |
| 7888 nel++; | |
| 7889 | |
| 7890 result = SparseMatrix (nr, nc, nel); | |
| 7891 | |
| 5275 | 7892 octave_idx_type ii = 0; |
| 5164 | 7893 result.xcidx(0) = 0; |
| 5275 | 7894 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 7895 { |
| 5275 | 7896 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
| 5164 | 7897 { |
| 7898 double tmp = xmax (d, m.data (i)); | |
| 7899 if (tmp != 0.) | |
| 7900 { | |
| 7901 result.xdata(ii) = tmp; | |
| 7902 result.xridx(ii++) = m.ridx(i); | |
| 7903 } | |
| 7904 } | |
| 7905 result.xcidx(j+1) = ii; | |
| 7906 } | |
| 7907 } | |
| 7908 | |
| 7909 return result; | |
| 7910 } | |
| 7911 | |
| 7912 SparseMatrix | |
| 7913 max (const SparseMatrix& m, double d) | |
| 7914 { | |
| 7915 return max (d, m); | |
| 7916 } | |
| 7917 | |
| 7918 SparseMatrix | |
| 7919 max (const SparseMatrix& a, const SparseMatrix& b) | |
| 7920 { | |
| 7921 SparseMatrix r; | |
| 7922 | |
| 7923 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 7924 { | |
| 5275 | 7925 octave_idx_type a_nr = a.rows (); |
| 7926 octave_idx_type a_nc = a.cols (); | |
| 7927 | |
| 7928 octave_idx_type b_nr = b.rows (); | |
| 7929 octave_idx_type b_nc = b.cols (); | |
| 5164 | 7930 |
| 7931 if (a_nr != b_nr || a_nc != b_nc) | |
| 7932 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 7933 else | |
| 7934 { | |
| 5681 | 7935 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 7936 |
| 5275 | 7937 octave_idx_type jx = 0; |
| 5164 | 7938 r.cidx (0) = 0; |
| 5275 | 7939 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 7940 { |
| 5275 | 7941 octave_idx_type ja = a.cidx(i); |
| 7942 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 7943 bool ja_lt_max= ja < ja_max; |
| 7944 | |
| 5275 | 7945 octave_idx_type jb = b.cidx(i); |
| 7946 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 7947 bool jb_lt_max = jb < jb_max; |
| 7948 | |
| 7949 while (ja_lt_max || jb_lt_max ) | |
| 7950 { | |
| 7951 OCTAVE_QUIT; | |
| 7952 if ((! jb_lt_max) || | |
| 7953 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 7954 { | |
| 7955 double tmp = xmax (a.data(ja), 0.); | |
| 7956 if (tmp != 0.) | |
| 7957 { | |
| 7958 r.ridx(jx) = a.ridx(ja); | |
| 7959 r.data(jx) = tmp; | |
| 7960 jx++; | |
| 7961 } | |
| 7962 ja++; | |
| 7963 ja_lt_max= ja < ja_max; | |
| 7964 } | |
| 7965 else if (( !ja_lt_max ) || | |
| 7966 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 7967 { | |
| 7968 double tmp = xmax (0., b.data(jb)); | |
| 7969 if (tmp != 0.) | |
| 7970 { | |
| 7971 r.ridx(jx) = b.ridx(jb); | |
| 7972 r.data(jx) = tmp; | |
| 7973 jx++; | |
| 7974 } | |
| 7975 jb++; | |
| 7976 jb_lt_max= jb < jb_max; | |
| 7977 } | |
| 7978 else | |
| 7979 { | |
| 7980 double tmp = xmax (a.data(ja), b.data(jb)); | |
| 7981 if (tmp != 0.) | |
| 7982 { | |
| 7983 r.data(jx) = tmp; | |
| 7984 r.ridx(jx) = a.ridx(ja); | |
| 7985 jx++; | |
| 7986 } | |
| 7987 ja++; | |
| 7988 ja_lt_max= ja < ja_max; | |
| 7989 jb++; | |
| 7990 jb_lt_max= jb < jb_max; | |
| 7991 } | |
| 7992 } | |
| 7993 r.cidx(i+1) = jx; | |
| 7994 } | |
| 7995 | |
| 7996 r.maybe_compress (); | |
| 7997 } | |
| 7998 } | |
| 7999 else | |
| 8000 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 8001 | |
| 8002 return r; | |
| 8003 } | |
| 8004 | |
| 8005 SPARSE_SMS_CMP_OPS (SparseMatrix, 0.0, , double, 0.0, ) | |
| 8006 SPARSE_SMS_BOOL_OPS (SparseMatrix, double, 0.0) | |
| 8007 | |
| 8008 SPARSE_SSM_CMP_OPS (double, 0.0, , SparseMatrix, 0.0, ) | |
| 8009 SPARSE_SSM_BOOL_OPS (double, SparseMatrix, 0.0) | |
| 8010 | |
| 8011 SPARSE_SMSM_CMP_OPS (SparseMatrix, 0.0, , SparseMatrix, 0.0, ) | |
| 8012 SPARSE_SMSM_BOOL_OPS (SparseMatrix, SparseMatrix, 0.0) | |
| 8013 | |
| 8014 /* | |
| 8015 ;;; Local Variables: *** | |
| 8016 ;;; mode: C++ *** | |
| 8017 ;;; End: *** | |
| 8018 */ |