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