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