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