Mercurial > octave
annotate liboctave/dSparse.cc @ 7515:f3c00dc0912b
Eliminate the rest of the dispatched sparse functions
| author | David Bateman <dbateman@free.fr> |
|---|---|
| date | Fri, 22 Feb 2008 15:50:51 +0100 |
| parents | 8c32f95c2639 |
| children | b166043585a8 |
| 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" | |
| 42 #include "oct-spparms.h" | |
| 43 #include "SparsedbleLU.h" | |
| 5785 | 44 #include "MatrixType.h" |
| 5451 | 45 #include "oct-sparse.h" |
| 5506 | 46 #include "sparse-util.h" |
| 47 #include "SparsedbleCHOL.h" | |
| 5610 | 48 #include "SparseQR.h" |
| 5164 | 49 |
| 5681 | 50 // Define whether to use a basic QR solver or one that uses a Dulmange |
| 51 // Mendelsohn factorization to seperate the problem into under-determined, | |
| 52 // well-determined and over-determined parts and solves them seperately | |
| 53 #ifndef USE_QRSOLVE | |
| 54 #include "sparse-dmsolve.cc" | |
| 55 #endif | |
| 56 | |
| 5164 | 57 // Fortran functions we call. |
| 58 extern "C" | |
| 59 { | |
| 60 F77_RET_T | |
| 6242 | 61 F77_FUNC (dgbtrf, DGBTRF) (const octave_idx_type&, const octave_idx_type&, |
| 62 const octave_idx_type&, const octave_idx_type&, | |
| 63 double*, const octave_idx_type&, | |
| 64 octave_idx_type*, octave_idx_type&); | |
| 5164 | 65 |
| 66 F77_RET_T | |
| 5275 | 67 F77_FUNC (dgbtrs, DGBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 68 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
| 69 const double*, const octave_idx_type&, | |
| 70 const octave_idx_type*, double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 71 F77_CHAR_ARG_LEN_DECL); |
| 72 | |
| 73 F77_RET_T | |
| 5275 | 74 F77_FUNC (dgbcon, DGBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 75 const octave_idx_type&, const octave_idx_type&, double*, | |
| 76 const octave_idx_type&, const octave_idx_type*, const double&, | |
| 77 double&, double*, octave_idx_type*, octave_idx_type& | |
| 5164 | 78 F77_CHAR_ARG_LEN_DECL); |
| 79 | |
| 80 F77_RET_T | |
| 5275 | 81 F77_FUNC (dpbtrf, DPBTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 82 const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 83 F77_CHAR_ARG_LEN_DECL); |
| 84 | |
| 85 F77_RET_T | |
| 5275 | 86 F77_FUNC (dpbtrs, DPBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 87 const octave_idx_type&, const octave_idx_type&, double*, const octave_idx_type&, | |
| 88 double*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 89 F77_CHAR_ARG_LEN_DECL); |
| 90 | |
| 91 F77_RET_T | |
| 5275 | 92 F77_FUNC (dpbcon, DPBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 93 const octave_idx_type&, double*, const octave_idx_type&, | |
| 94 const double&, double&, double*, octave_idx_type*, octave_idx_type& | |
| 5164 | 95 F77_CHAR_ARG_LEN_DECL); |
| 96 F77_RET_T | |
| 5275 | 97 F77_FUNC (dptsv, DPTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, |
| 98 double*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 99 |
| 100 F77_RET_T | |
| 5275 | 101 F77_FUNC (dgtsv, DGTSV) (const octave_idx_type&, const octave_idx_type&, double*, double*, |
| 102 double*, double*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 103 |
| 104 F77_RET_T | |
| 5275 | 105 F77_FUNC (dgttrf, DGTTRF) (const octave_idx_type&, double*, double*, double*, double*, |
| 106 octave_idx_type*, octave_idx_type&); | |
| 5164 | 107 |
| 108 F77_RET_T | |
| 5275 | 109 F77_FUNC (dgttrs, DGTTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 110 const octave_idx_type&, const double*, const double*, | |
| 111 const double*, const double*, const octave_idx_type*, | |
| 112 double *, const octave_idx_type&, octave_idx_type& | |
| 5164 | 113 F77_CHAR_ARG_LEN_DECL); |
| 114 | |
| 115 F77_RET_T | |
| 5322 | 116 F77_FUNC (zptsv, ZPTSV) (const octave_idx_type&, const octave_idx_type&, double*, Complex*, |
| 5275 | 117 Complex*, const octave_idx_type&, octave_idx_type&); |
| 5164 | 118 |
| 119 F77_RET_T | |
| 5275 | 120 F77_FUNC (zgtsv, ZGTSV) (const octave_idx_type&, const octave_idx_type&, Complex*, Complex*, |
| 121 Complex*, Complex*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 122 |
| 123 } | |
| 124 | |
| 125 SparseMatrix::SparseMatrix (const SparseBoolMatrix &a) | |
| 5681 | 126 : MSparse<double> (a.rows (), a.cols (), a.nnz ()) |
| 5164 | 127 { |
| 5275 | 128 octave_idx_type nc = cols (); |
| 5681 | 129 octave_idx_type nz = a.nnz (); |
| 5275 | 130 |
| 131 for (octave_idx_type i = 0; i < nc + 1; i++) | |
| 5164 | 132 cidx (i) = a.cidx (i); |
| 133 | |
| 5275 | 134 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 135 { |
| 136 data (i) = a.data (i); | |
| 137 ridx (i) = a.ridx (i); | |
| 138 } | |
| 139 } | |
| 140 | |
| 141 bool | |
| 142 SparseMatrix::operator == (const SparseMatrix& a) const | |
| 143 { | |
| 5275 | 144 octave_idx_type nr = rows (); |
| 145 octave_idx_type nc = cols (); | |
| 5681 | 146 octave_idx_type nz = nnz (); |
| 5275 | 147 octave_idx_type nr_a = a.rows (); |
| 148 octave_idx_type nc_a = a.cols (); | |
| 5681 | 149 octave_idx_type nz_a = a.nnz (); |
| 5164 | 150 |
| 151 if (nr != nr_a || nc != nc_a || nz != nz_a) | |
| 152 return false; | |
| 153 | |
| 5275 | 154 for (octave_idx_type i = 0; i < nc + 1; i++) |
| 5164 | 155 if (cidx(i) != a.cidx(i)) |
| 156 return false; | |
| 157 | |
| 5275 | 158 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 159 if (data(i) != a.data(i) || ridx(i) != a.ridx(i)) |
| 160 return false; | |
| 161 | |
| 162 return true; | |
| 163 } | |
| 164 | |
| 165 bool | |
| 166 SparseMatrix::operator != (const SparseMatrix& a) const | |
| 167 { | |
| 168 return !(*this == a); | |
| 169 } | |
| 170 | |
| 171 bool | |
| 172 SparseMatrix::is_symmetric (void) const | |
| 173 { | |
| 6207 | 174 octave_idx_type nr = rows (); |
| 175 octave_idx_type nc = cols (); | |
| 176 | |
| 177 if (nr == nc && nr > 0) | |
| 5164 | 178 { |
| 6207 | 179 for (octave_idx_type j = 0; j < nc; j++) |
| 180 { | |
| 181 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 182 { | |
| 183 octave_idx_type ri = ridx(i); | |
| 184 | |
| 185 if (ri != j) | |
| 186 { | |
| 187 bool found = false; | |
| 188 | |
| 189 for (octave_idx_type k = cidx(ri); k < cidx(ri+1); k++) | |
| 190 { | |
| 191 if (ridx(k) == j) | |
| 192 { | |
| 193 if (data(i) == data(k)) | |
| 194 found = true; | |
| 195 break; | |
| 196 } | |
| 197 } | |
| 198 | |
| 199 if (! found) | |
| 200 return false; | |
| 201 } | |
| 202 } | |
| 203 } | |
| 5164 | 204 |
| 205 return true; | |
| 206 } | |
| 207 | |
| 208 return false; | |
| 209 } | |
| 210 | |
| 211 SparseMatrix& | |
| 5275 | 212 SparseMatrix::insert (const SparseMatrix& a, octave_idx_type r, octave_idx_type c) |
| 5164 | 213 { |
| 214 MSparse<double>::insert (a, r, c); | |
| 215 return *this; | |
| 216 } | |
| 217 | |
| 6823 | 218 SparseMatrix& |
| 219 SparseMatrix::insert (const SparseMatrix& a, const Array<octave_idx_type>& indx) | |
| 220 { | |
| 221 MSparse<double>::insert (a, indx); | |
| 222 return *this; | |
| 223 } | |
| 224 | |
| 5164 | 225 SparseMatrix |
| 226 SparseMatrix::max (int dim) const | |
| 227 { | |
| 5275 | 228 Array2<octave_idx_type> dummy_idx; |
| 5164 | 229 return max (dummy_idx, dim); |
| 230 } | |
| 231 | |
| 232 SparseMatrix | |
| 5275 | 233 SparseMatrix::max (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 234 { |
| 235 SparseMatrix result; | |
| 236 dim_vector dv = dims (); | |
| 237 | |
| 238 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 239 return result; | |
| 240 | |
| 5275 | 241 octave_idx_type nr = dv(0); |
| 242 octave_idx_type nc = dv(1); | |
| 5164 | 243 |
| 244 if (dim == 0) | |
| 245 { | |
| 246 idx_arg.resize (1, nc); | |
| 5275 | 247 octave_idx_type nel = 0; |
| 248 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 249 { |
| 250 double tmp_max = octave_NaN; | |
| 5275 | 251 octave_idx_type idx_j = 0; |
| 252 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 253 { |
| 254 if (ridx(i) != idx_j) | |
| 255 break; | |
| 256 else | |
| 257 idx_j++; | |
| 258 } | |
| 259 | |
| 260 if (idx_j != nr) | |
| 261 tmp_max = 0.; | |
| 262 | |
| 5275 | 263 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 264 { |
| 265 double tmp = data (i); | |
| 266 | |
| 5389 | 267 if (xisnan (tmp)) |
| 5164 | 268 continue; |
| 5389 | 269 else if (xisnan (tmp_max) || tmp > tmp_max) |
| 5164 | 270 { |
| 271 idx_j = ridx (i); | |
| 272 tmp_max = tmp; | |
| 273 } | |
| 274 | |
| 275 } | |
| 276 | |
| 5389 | 277 idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; |
| 5164 | 278 if (tmp_max != 0.) |
| 279 nel++; | |
| 280 } | |
| 281 | |
| 282 result = SparseMatrix (1, nc, nel); | |
| 283 | |
| 5275 | 284 octave_idx_type ii = 0; |
| 5164 | 285 result.xcidx (0) = 0; |
| 5275 | 286 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 287 { |
| 288 double tmp = elem (idx_arg(j), j); | |
| 289 if (tmp != 0.) | |
| 290 { | |
| 291 result.xdata (ii) = tmp; | |
| 292 result.xridx (ii++) = 0; | |
| 293 } | |
| 294 result.xcidx (j+1) = ii; | |
| 295 | |
| 296 } | |
| 297 } | |
| 298 else | |
| 299 { | |
| 300 idx_arg.resize (nr, 1, 0); | |
| 301 | |
| 5275 | 302 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 303 idx_arg.elem(ridx(i)) = -1; |
| 304 | |
| 5275 | 305 for (octave_idx_type j = 0; j < nc; j++) |
| 306 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 307 { |
| 308 if (idx_arg.elem(i) != -1) | |
| 309 continue; | |
| 310 bool found = false; | |
| 5275 | 311 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 312 if (ridx(k) == i) |
| 313 { | |
| 314 found = true; | |
| 315 break; | |
| 316 } | |
| 317 | |
| 318 if (!found) | |
| 319 idx_arg.elem(i) = j; | |
| 320 | |
| 321 } | |
| 322 | |
| 5275 | 323 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 324 { |
| 5275 | 325 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 326 { |
| 5275 | 327 octave_idx_type ir = ridx (i); |
| 328 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 329 double tmp = data (i); |
| 330 | |
| 5389 | 331 if (xisnan (tmp)) |
| 5164 | 332 continue; |
| 333 else if (ix == -1 || tmp > elem (ir, ix)) | |
| 334 idx_arg.elem (ir) = j; | |
| 335 } | |
| 336 } | |
| 337 | |
| 5275 | 338 octave_idx_type nel = 0; |
| 339 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 340 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 341 nel++; | |
| 342 | |
| 343 result = SparseMatrix (nr, 1, nel); | |
| 344 | |
| 5275 | 345 octave_idx_type ii = 0; |
| 5164 | 346 result.xcidx (0) = 0; |
| 347 result.xcidx (1) = nel; | |
| 5275 | 348 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 349 { |
| 350 if (idx_arg(j) == -1) | |
| 351 { | |
| 352 idx_arg(j) = 0; | |
| 353 result.xdata (ii) = octave_NaN; | |
| 354 result.xridx (ii++) = j; | |
| 355 } | |
| 356 else | |
| 357 { | |
| 358 double tmp = elem (j, idx_arg(j)); | |
| 359 if (tmp != 0.) | |
| 360 { | |
| 361 result.xdata (ii) = tmp; | |
| 362 result.xridx (ii++) = j; | |
| 363 } | |
| 364 } | |
| 365 } | |
| 366 } | |
| 367 | |
| 368 return result; | |
| 369 } | |
| 370 | |
| 371 SparseMatrix | |
| 372 SparseMatrix::min (int dim) const | |
| 373 { | |
| 5275 | 374 Array2<octave_idx_type> dummy_idx; |
| 5164 | 375 return min (dummy_idx, dim); |
| 376 } | |
| 377 | |
| 378 SparseMatrix | |
| 5275 | 379 SparseMatrix::min (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 380 { |
| 381 SparseMatrix result; | |
| 382 dim_vector dv = dims (); | |
| 383 | |
| 384 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 385 return result; | |
| 386 | |
| 5275 | 387 octave_idx_type nr = dv(0); |
| 388 octave_idx_type nc = dv(1); | |
| 5164 | 389 |
| 390 if (dim == 0) | |
| 391 { | |
| 392 idx_arg.resize (1, nc); | |
| 5275 | 393 octave_idx_type nel = 0; |
| 394 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 395 { |
| 396 double tmp_min = octave_NaN; | |
| 5275 | 397 octave_idx_type idx_j = 0; |
| 398 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 399 { |
| 400 if (ridx(i) != idx_j) | |
| 401 break; | |
| 402 else | |
| 403 idx_j++; | |
| 404 } | |
| 405 | |
| 406 if (idx_j != nr) | |
| 407 tmp_min = 0.; | |
| 408 | |
| 5275 | 409 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 410 { |
| 411 double tmp = data (i); | |
| 412 | |
| 5389 | 413 if (xisnan (tmp)) |
| 5164 | 414 continue; |
| 5389 | 415 else if (xisnan (tmp_min) || tmp < tmp_min) |
| 5164 | 416 { |
| 417 idx_j = ridx (i); | |
| 418 tmp_min = tmp; | |
| 419 } | |
| 420 | |
| 421 } | |
| 422 | |
| 5389 | 423 idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; |
| 5164 | 424 if (tmp_min != 0.) |
| 425 nel++; | |
| 426 } | |
| 427 | |
| 428 result = SparseMatrix (1, nc, nel); | |
| 429 | |
| 5275 | 430 octave_idx_type ii = 0; |
| 5164 | 431 result.xcidx (0) = 0; |
| 5275 | 432 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 433 { |
| 434 double tmp = elem (idx_arg(j), j); | |
| 435 if (tmp != 0.) | |
| 436 { | |
| 437 result.xdata (ii) = tmp; | |
| 438 result.xridx (ii++) = 0; | |
| 439 } | |
| 440 result.xcidx (j+1) = ii; | |
| 441 | |
| 442 } | |
| 443 } | |
| 444 else | |
| 445 { | |
| 446 idx_arg.resize (nr, 1, 0); | |
| 447 | |
| 5275 | 448 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 449 idx_arg.elem(ridx(i)) = -1; |
| 450 | |
| 5275 | 451 for (octave_idx_type j = 0; j < nc; j++) |
| 452 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 453 { |
| 454 if (idx_arg.elem(i) != -1) | |
| 455 continue; | |
| 456 bool found = false; | |
| 5275 | 457 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 458 if (ridx(k) == i) |
| 459 { | |
| 460 found = true; | |
| 461 break; | |
| 462 } | |
| 463 | |
| 464 if (!found) | |
| 465 idx_arg.elem(i) = j; | |
| 466 | |
| 467 } | |
| 468 | |
| 5275 | 469 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 470 { |
| 5275 | 471 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 472 { |
| 5275 | 473 octave_idx_type ir = ridx (i); |
| 474 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 475 double tmp = data (i); |
| 476 | |
| 5389 | 477 if (xisnan (tmp)) |
| 5164 | 478 continue; |
| 479 else if (ix == -1 || tmp < elem (ir, ix)) | |
| 480 idx_arg.elem (ir) = j; | |
| 481 } | |
| 482 } | |
| 483 | |
| 5275 | 484 octave_idx_type nel = 0; |
| 485 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 486 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 487 nel++; | |
| 488 | |
| 489 result = SparseMatrix (nr, 1, nel); | |
| 490 | |
| 5275 | 491 octave_idx_type ii = 0; |
| 5164 | 492 result.xcidx (0) = 0; |
| 493 result.xcidx (1) = nel; | |
| 5275 | 494 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 495 { |
| 496 if (idx_arg(j) == -1) | |
| 497 { | |
| 498 idx_arg(j) = 0; | |
| 499 result.xdata (ii) = octave_NaN; | |
| 500 result.xridx (ii++) = j; | |
| 501 } | |
| 502 else | |
| 503 { | |
| 504 double tmp = elem (j, idx_arg(j)); | |
| 505 if (tmp != 0.) | |
| 506 { | |
| 507 result.xdata (ii) = tmp; | |
| 508 result.xridx (ii++) = j; | |
| 509 } | |
| 510 } | |
| 511 } | |
| 512 } | |
| 513 | |
| 514 return result; | |
| 515 } | |
| 516 | |
| 517 SparseMatrix | |
| 5275 | 518 SparseMatrix::concat (const SparseMatrix& rb, const Array<octave_idx_type>& ra_idx) |
| 5164 | 519 { |
| 520 // Don't use numel to avoid all possiblity of an overflow | |
| 521 if (rb.rows () > 0 && rb.cols () > 0) | |
| 522 insert (rb, ra_idx(0), ra_idx(1)); | |
| 523 return *this; | |
| 524 } | |
| 525 | |
| 526 SparseComplexMatrix | |
| 5275 | 527 SparseMatrix::concat (const SparseComplexMatrix& rb, const Array<octave_idx_type>& ra_idx) |
| 5164 | 528 { |
| 529 SparseComplexMatrix retval (*this); | |
| 530 if (rb.rows () > 0 && rb.cols () > 0) | |
| 531 retval.insert (rb, ra_idx(0), ra_idx(1)); | |
| 532 return retval; | |
| 533 } | |
| 534 | |
| 535 SparseMatrix | |
| 536 real (const SparseComplexMatrix& a) | |
| 537 { | |
| 5275 | 538 octave_idx_type nr = a.rows (); |
| 539 octave_idx_type nc = a.cols (); | |
| 5681 | 540 octave_idx_type nz = a.nnz (); |
| 5164 | 541 SparseMatrix r (nr, nc, nz); |
| 542 | |
| 5275 | 543 for (octave_idx_type i = 0; i < nc +1; i++) |
| 5164 | 544 r.cidx(i) = a.cidx(i); |
| 545 | |
| 5275 | 546 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 547 { |
| 5261 | 548 r.data(i) = std::real (a.data(i)); |
| 5164 | 549 r.ridx(i) = a.ridx(i); |
| 550 } | |
| 551 | |
| 552 return r; | |
| 553 } | |
| 554 | |
| 555 SparseMatrix | |
| 556 imag (const SparseComplexMatrix& a) | |
| 557 { | |
| 5275 | 558 octave_idx_type nr = a.rows (); |
| 559 octave_idx_type nc = a.cols (); | |
| 5681 | 560 octave_idx_type nz = a.nnz (); |
| 5164 | 561 SparseMatrix r (nr, nc, nz); |
| 562 | |
| 5275 | 563 for (octave_idx_type i = 0; i < nc +1; i++) |
| 5164 | 564 r.cidx(i) = a.cidx(i); |
| 565 | |
| 5275 | 566 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 567 { |
| 5261 | 568 r.data(i) = std::imag (a.data(i)); |
| 5164 | 569 r.ridx(i) = a.ridx(i); |
| 570 } | |
| 571 | |
| 572 return r; | |
| 573 } | |
| 574 | |
| 575 SparseMatrix | |
| 576 atan2 (const double& x, const SparseMatrix& y) | |
| 577 { | |
| 5275 | 578 octave_idx_type nr = y.rows (); |
| 579 octave_idx_type nc = y.cols (); | |
| 5164 | 580 |
| 581 if (x == 0.) | |
| 582 return SparseMatrix (nr, nc); | |
| 583 else | |
| 584 { | |
| 585 // Its going to be basically full, so this is probably the | |
| 586 // best way to handle it. | |
| 587 Matrix tmp (nr, nc, atan2 (x, 0.)); | |
| 588 | |
| 5275 | 589 for (octave_idx_type j = 0; j < nc; j++) |
| 590 for (octave_idx_type i = y.cidx (j); i < y.cidx (j+1); i++) | |
| 5164 | 591 tmp.elem (y.ridx(i), j) = atan2 (x, y.data(i)); |
| 592 | |
| 593 return SparseMatrix (tmp); | |
| 594 } | |
| 595 } | |
| 596 | |
| 597 SparseMatrix | |
| 598 atan2 (const SparseMatrix& x, const double& y) | |
| 599 { | |
| 5275 | 600 octave_idx_type nr = x.rows (); |
| 601 octave_idx_type nc = x.cols (); | |
| 5681 | 602 octave_idx_type nz = x.nnz (); |
| 5164 | 603 |
| 604 SparseMatrix retval (nr, nc, nz); | |
| 605 | |
| 5275 | 606 octave_idx_type ii = 0; |
| 5164 | 607 retval.xcidx(0) = 0; |
| 5275 | 608 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 609 { |
| 5275 | 610 for (octave_idx_type j = x.cidx(i); j < x.cidx(i+1); j++) |
| 5164 | 611 { |
| 612 double tmp = atan2 (x.data(j), y); | |
| 613 if (tmp != 0.) | |
| 614 { | |
| 615 retval.xdata (ii) = tmp; | |
| 616 retval.xridx (ii++) = x.ridx (j); | |
| 617 } | |
| 618 } | |
| 619 retval.xcidx (i+1) = ii; | |
| 620 } | |
| 621 | |
| 622 if (ii != nz) | |
| 623 { | |
| 624 SparseMatrix retval2 (nr, nc, ii); | |
| 5275 | 625 for (octave_idx_type i = 0; i < nc+1; i++) |
| 5164 | 626 retval2.xcidx (i) = retval.cidx (i); |
| 5275 | 627 for (octave_idx_type i = 0; i < ii; i++) |
| 5164 | 628 { |
| 629 retval2.xdata (i) = retval.data (i); | |
| 630 retval2.xridx (i) = retval.ridx (i); | |
| 631 } | |
| 632 return retval2; | |
| 633 } | |
| 634 else | |
| 635 return retval; | |
| 636 } | |
| 637 | |
| 638 SparseMatrix | |
| 639 atan2 (const SparseMatrix& x, const SparseMatrix& y) | |
| 640 { | |
| 641 SparseMatrix r; | |
| 642 | |
| 643 if ((x.rows() == y.rows()) && (x.cols() == y.cols())) | |
| 644 { | |
| 5275 | 645 octave_idx_type x_nr = x.rows (); |
| 646 octave_idx_type x_nc = x.cols (); | |
| 647 | |
| 648 octave_idx_type y_nr = y.rows (); | |
| 649 octave_idx_type y_nc = y.cols (); | |
| 5164 | 650 |
| 651 if (x_nr != y_nr || x_nc != y_nc) | |
| 652 gripe_nonconformant ("atan2", x_nr, x_nc, y_nr, y_nc); | |
| 653 else | |
| 654 { | |
| 5681 | 655 r = SparseMatrix (x_nr, x_nc, (x.nnz () + y.nnz ())); |
| 5164 | 656 |
| 5275 | 657 octave_idx_type jx = 0; |
| 5164 | 658 r.cidx (0) = 0; |
| 5275 | 659 for (octave_idx_type i = 0 ; i < x_nc ; i++) |
| 5164 | 660 { |
| 5275 | 661 octave_idx_type ja = x.cidx(i); |
| 662 octave_idx_type ja_max = x.cidx(i+1); | |
| 5164 | 663 bool ja_lt_max= ja < ja_max; |
| 664 | |
| 5275 | 665 octave_idx_type jb = y.cidx(i); |
| 666 octave_idx_type jb_max = y.cidx(i+1); | |
| 5164 | 667 bool jb_lt_max = jb < jb_max; |
| 668 | |
| 669 while (ja_lt_max || jb_lt_max ) | |
| 670 { | |
| 671 OCTAVE_QUIT; | |
| 672 if ((! jb_lt_max) || | |
| 673 (ja_lt_max && (x.ridx(ja) < y.ridx(jb)))) | |
| 674 { | |
| 675 r.ridx(jx) = x.ridx(ja); | |
| 676 r.data(jx) = atan2 (x.data(ja), 0.); | |
| 677 jx++; | |
| 678 ja++; | |
| 679 ja_lt_max= ja < ja_max; | |
| 680 } | |
| 681 else if (( !ja_lt_max ) || | |
| 682 (jb_lt_max && (y.ridx(jb) < x.ridx(ja)) ) ) | |
| 683 { | |
| 684 jb++; | |
| 685 jb_lt_max= jb < jb_max; | |
| 686 } | |
| 687 else | |
| 688 { | |
| 689 double tmp = atan2 (x.data(ja), y.data(jb)); | |
| 690 if (tmp != 0.) | |
| 691 { | |
| 692 r.data(jx) = tmp; | |
| 693 r.ridx(jx) = x.ridx(ja); | |
| 694 jx++; | |
| 695 } | |
| 696 ja++; | |
| 697 ja_lt_max= ja < ja_max; | |
| 698 jb++; | |
| 699 jb_lt_max= jb < jb_max; | |
| 700 } | |
| 701 } | |
| 702 r.cidx(i+1) = jx; | |
| 703 } | |
| 704 | |
| 705 r.maybe_compress (); | |
| 706 } | |
| 707 } | |
| 708 else | |
| 709 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 710 | |
| 711 return r; | |
| 712 } | |
| 713 | |
| 714 SparseMatrix | |
| 715 SparseMatrix::inverse (void) const | |
| 716 { | |
| 5275 | 717 octave_idx_type info; |
| 5164 | 718 double rcond; |
| 5785 | 719 MatrixType mattype (*this); |
| 5506 | 720 return inverse (mattype, info, rcond, 0, 0); |
| 721 } | |
| 722 | |
| 723 SparseMatrix | |
| 5785 | 724 SparseMatrix::inverse (MatrixType& mattype) const |
| 5506 | 725 { |
| 726 octave_idx_type info; | |
| 727 double rcond; | |
| 728 return inverse (mattype, info, rcond, 0, 0); | |
| 5164 | 729 } |
| 730 | |
| 731 SparseMatrix | |
| 5785 | 732 SparseMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const |
| 5164 | 733 { |
| 734 double rcond; | |
| 5506 | 735 return inverse (mattype, info, rcond, 0, 0); |
| 736 } | |
| 737 | |
| 738 SparseMatrix | |
| 5785 | 739 SparseMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 740 double& rcond, const bool, |
| 5506 | 741 const bool calccond) const |
| 742 { | |
| 743 SparseMatrix retval; | |
| 744 | |
| 745 octave_idx_type nr = rows (); | |
| 746 octave_idx_type nc = cols (); | |
| 747 info = 0; | |
| 748 | |
| 749 if (nr == 0 || nc == 0 || nr != nc) | |
| 750 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 751 else | |
| 752 { | |
| 753 // Print spparms("spumoni") info if requested | |
| 754 int typ = mattyp.type (); | |
| 755 mattyp.info (); | |
| 756 | |
| 5785 | 757 if (typ == MatrixType::Diagonal || |
| 758 typ == MatrixType::Permuted_Diagonal) | |
| 5506 | 759 { |
| 5785 | 760 if (typ == MatrixType::Permuted_Diagonal) |
| 5506 | 761 retval = transpose(); |
| 762 else | |
| 763 retval = *this; | |
| 764 | |
| 765 // Force make_unique to be called | |
| 766 double *v = retval.data(); | |
| 767 | |
| 768 if (calccond) | |
| 769 { | |
| 770 double dmax = 0., dmin = octave_Inf; | |
| 771 for (octave_idx_type i = 0; i < nr; i++) | |
| 772 { | |
| 773 double tmp = fabs(v[i]); | |
| 774 if (tmp > dmax) | |
| 775 dmax = tmp; | |
| 776 if (tmp < dmin) | |
| 777 dmin = tmp; | |
| 778 } | |
| 779 rcond = dmin / dmax; | |
| 780 } | |
| 781 | |
| 782 for (octave_idx_type i = 0; i < nr; i++) | |
| 783 v[i] = 1.0 / v[i]; | |
| 784 } | |
| 785 else | |
| 786 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 787 } | |
| 788 | |
| 789 return retval; | |
| 790 } | |
| 791 | |
| 792 SparseMatrix | |
| 5785 | 793 SparseMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 794 double& rcond, const bool, |
| 5506 | 795 const bool calccond) const |
| 796 { | |
| 797 SparseMatrix retval; | |
| 798 | |
| 799 octave_idx_type nr = rows (); | |
| 800 octave_idx_type nc = cols (); | |
| 801 info = 0; | |
| 802 | |
| 803 if (nr == 0 || nc == 0 || nr != nc) | |
| 804 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 805 else | |
| 806 { | |
| 807 // Print spparms("spumoni") info if requested | |
| 808 int typ = mattyp.type (); | |
| 809 mattyp.info (); | |
| 810 | |
| 5785 | 811 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper || |
| 812 typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) | |
| 5506 | 813 { |
| 814 double anorm = 0.; | |
| 815 double ainvnorm = 0.; | |
| 816 | |
| 817 if (calccond) | |
| 818 { | |
| 819 // Calculate the 1-norm of matrix for rcond calculation | |
| 820 for (octave_idx_type j = 0; j < nr; j++) | |
| 821 { | |
| 822 double atmp = 0.; | |
| 823 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 824 atmp += fabs(data(i)); | |
| 825 if (atmp > anorm) | |
| 826 anorm = atmp; | |
| 827 } | |
| 828 } | |
| 829 | |
| 5785 | 830 if (typ == MatrixType::Upper || typ == MatrixType::Lower) |
| 5506 | 831 { |
| 5681 | 832 octave_idx_type nz = nnz (); |
| 5506 | 833 octave_idx_type cx = 0; |
| 834 octave_idx_type nz2 = nz; | |
| 835 retval = SparseMatrix (nr, nc, nz2); | |
| 836 | |
| 837 for (octave_idx_type i = 0; i < nr; i++) | |
| 838 { | |
| 839 OCTAVE_QUIT; | |
| 840 // place the 1 in the identity position | |
| 841 octave_idx_type cx_colstart = cx; | |
| 842 | |
| 843 if (cx == nz2) | |
| 844 { | |
| 845 nz2 *= 2; | |
| 846 retval.change_capacity (nz2); | |
| 847 } | |
| 848 | |
| 849 retval.xcidx(i) = cx; | |
| 850 retval.xridx(cx) = i; | |
| 851 retval.xdata(cx) = 1.0; | |
| 852 cx++; | |
| 853 | |
| 854 // iterate accross columns of input matrix | |
| 855 for (octave_idx_type j = i+1; j < nr; j++) | |
| 856 { | |
| 857 double v = 0.; | |
| 858 // iterate to calculate sum | |
| 859 octave_idx_type colXp = retval.xcidx(i); | |
| 860 octave_idx_type colUp = cidx(j); | |
| 861 octave_idx_type rpX, rpU; | |
| 5876 | 862 |
| 863 if (cidx(j) == cidx(j+1)) | |
| 864 { | |
| 865 (*current_liboctave_error_handler) | |
| 866 ("division by zero"); | |
| 867 goto inverse_singular; | |
| 868 } | |
| 869 | |
| 5506 | 870 do |
| 871 { | |
| 872 OCTAVE_QUIT; | |
| 873 rpX = retval.xridx(colXp); | |
| 874 rpU = ridx(colUp); | |
| 875 | |
| 876 if (rpX < rpU) | |
| 877 colXp++; | |
| 878 else if (rpX > rpU) | |
| 879 colUp++; | |
| 880 else | |
| 881 { | |
| 882 v -= retval.xdata(colXp) * data(colUp); | |
| 883 colXp++; | |
| 884 colUp++; | |
| 885 } | |
| 886 } while ((rpX<j) && (rpU<j) && | |
| 887 (colXp<cx) && (colUp<nz)); | |
| 888 | |
| 889 // get A(m,m) | |
| 5876 | 890 if (typ == MatrixType::Upper) |
| 891 colUp = cidx(j+1) - 1; | |
| 892 else | |
| 5877 | 893 colUp = cidx(j); |
| 5506 | 894 double pivot = data(colUp); |
| 5877 | 895 if (pivot == 0. || ridx(colUp) != j) |
| 5876 | 896 { |
| 897 (*current_liboctave_error_handler) | |
| 898 ("division by zero"); | |
| 899 goto inverse_singular; | |
| 900 } | |
| 5506 | 901 |
| 902 if (v != 0.) | |
| 903 { | |
| 904 if (cx == nz2) | |
| 905 { | |
| 906 nz2 *= 2; | |
| 907 retval.change_capacity (nz2); | |
| 908 } | |
| 909 | |
| 910 retval.xridx(cx) = j; | |
| 911 retval.xdata(cx) = v / pivot; | |
| 912 cx++; | |
| 913 } | |
| 914 } | |
| 915 | |
| 916 // get A(m,m) | |
| 5876 | 917 octave_idx_type colUp; |
| 918 if (typ == MatrixType::Upper) | |
| 919 colUp = cidx(i+1) - 1; | |
| 920 else | |
| 5877 | 921 colUp = cidx(i); |
| 5506 | 922 double pivot = data(colUp); |
| 5877 | 923 if (pivot == 0. || ridx(colUp) != i) |
| 5876 | 924 { |
| 925 (*current_liboctave_error_handler) ("division by zero"); | |
| 926 goto inverse_singular; | |
| 927 } | |
| 5506 | 928 |
| 929 if (pivot != 1.0) | |
| 930 for (octave_idx_type j = cx_colstart; j < cx; j++) | |
| 931 retval.xdata(j) /= pivot; | |
| 932 } | |
| 933 retval.xcidx(nr) = cx; | |
| 934 retval.maybe_compress (); | |
| 935 } | |
| 936 else | |
| 937 { | |
| 5681 | 938 octave_idx_type nz = nnz (); |
| 5506 | 939 octave_idx_type cx = 0; |
| 940 octave_idx_type nz2 = nz; | |
| 941 retval = SparseMatrix (nr, nc, nz2); | |
| 942 | |
| 943 OCTAVE_LOCAL_BUFFER (double, work, nr); | |
| 944 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); | |
| 945 | |
| 946 octave_idx_type *perm = mattyp.triangular_perm(); | |
| 5785 | 947 if (typ == MatrixType::Permuted_Upper) |
| 5506 | 948 { |
| 949 for (octave_idx_type i = 0; i < nr; i++) | |
| 950 rperm[perm[i]] = i; | |
| 951 } | |
| 952 else | |
| 953 { | |
| 954 for (octave_idx_type i = 0; i < nr; i++) | |
| 955 rperm[i] = perm[i]; | |
| 956 for (octave_idx_type i = 0; i < nr; i++) | |
| 957 perm[rperm[i]] = i; | |
| 958 } | |
| 959 | |
| 960 for (octave_idx_type i = 0; i < nr; i++) | |
| 961 { | |
| 962 OCTAVE_QUIT; | |
| 963 octave_idx_type iidx = rperm[i]; | |
| 964 | |
| 965 for (octave_idx_type j = 0; j < nr; j++) | |
| 966 work[j] = 0.; | |
| 967 | |
| 968 // place the 1 in the identity position | |
| 969 work[iidx] = 1.0; | |
| 970 | |
| 971 // iterate accross columns of input matrix | |
| 972 for (octave_idx_type j = iidx+1; j < nr; j++) | |
| 973 { | |
| 974 double v = 0.; | |
| 975 octave_idx_type jidx = perm[j]; | |
| 976 // iterate to calculate sum | |
| 977 for (octave_idx_type k = cidx(jidx); | |
| 978 k < cidx(jidx+1); k++) | |
| 979 { | |
| 980 OCTAVE_QUIT; | |
| 981 v -= work[ridx(k)] * data(k); | |
| 982 } | |
| 983 | |
| 984 // get A(m,m) | |
| 5876 | 985 double pivot; |
| 986 if (typ == MatrixType::Permuted_Upper) | |
| 987 pivot = data(cidx(jidx+1) - 1); | |
| 988 else | |
| 5877 | 989 pivot = data(cidx(jidx)); |
| 5506 | 990 if (pivot == 0.) |
| 5876 | 991 { |
| 992 (*current_liboctave_error_handler) | |
| 993 ("division by zero"); | |
| 994 goto inverse_singular; | |
| 995 } | |
| 5506 | 996 |
| 997 work[j] = v / pivot; | |
| 998 } | |
| 999 | |
| 1000 // get A(m,m) | |
| 5876 | 1001 octave_idx_type colUp; |
| 1002 if (typ == MatrixType::Permuted_Upper) | |
| 1003 colUp = cidx(perm[iidx]+1) - 1; | |
| 1004 else | |
| 5877 | 1005 colUp = cidx(perm[iidx]); |
| 5876 | 1006 |
| 5506 | 1007 double pivot = data(colUp); |
| 5876 | 1008 if (pivot == 0.) |
| 1009 { | |
| 1010 (*current_liboctave_error_handler) | |
| 1011 ("division by zero"); | |
| 1012 goto inverse_singular; | |
| 1013 } | |
| 5506 | 1014 |
| 1015 octave_idx_type new_cx = cx; | |
| 1016 for (octave_idx_type j = iidx; j < nr; j++) | |
| 1017 if (work[j] != 0.0) | |
| 1018 { | |
| 1019 new_cx++; | |
| 1020 if (pivot != 1.0) | |
| 1021 work[j] /= pivot; | |
| 1022 } | |
| 1023 | |
| 1024 if (cx < new_cx) | |
| 1025 { | |
| 1026 nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2); | |
| 1027 retval.change_capacity (nz2); | |
| 1028 } | |
| 1029 | |
| 1030 retval.xcidx(i) = cx; | |
| 1031 for (octave_idx_type j = iidx; j < nr; j++) | |
| 1032 if (work[j] != 0.) | |
| 1033 { | |
| 1034 retval.xridx(cx) = j; | |
| 1035 retval.xdata(cx++) = work[j]; | |
| 1036 } | |
| 1037 } | |
| 1038 | |
| 1039 retval.xcidx(nr) = cx; | |
| 1040 retval.maybe_compress (); | |
| 1041 } | |
| 1042 | |
| 1043 if (calccond) | |
| 1044 { | |
| 1045 // Calculate the 1-norm of inverse matrix for rcond calculation | |
| 1046 for (octave_idx_type j = 0; j < nr; j++) | |
| 1047 { | |
| 1048 double atmp = 0.; | |
| 1049 for (octave_idx_type i = retval.cidx(j); | |
| 1050 i < retval.cidx(j+1); i++) | |
| 1051 atmp += fabs(retval.data(i)); | |
| 1052 if (atmp > ainvnorm) | |
| 1053 ainvnorm = atmp; | |
| 1054 } | |
| 1055 | |
| 1056 rcond = 1. / ainvnorm / anorm; | |
| 1057 } | |
| 1058 } | |
| 1059 else | |
| 1060 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1061 } | |
| 1062 | |
| 1063 return retval; | |
| 5876 | 1064 |
| 1065 inverse_singular: | |
| 1066 return SparseMatrix(); | |
| 5164 | 1067 } |
| 1068 | |
| 1069 SparseMatrix | |
| 5785 | 1070 SparseMatrix::inverse (MatrixType &mattype, octave_idx_type& info, |
| 5610 | 1071 double& rcond, int, int calc_cond) const |
| 5506 | 1072 { |
| 1073 int typ = mattype.type (false); | |
| 1074 SparseMatrix ret; | |
| 1075 | |
| 5785 | 1076 if (typ == MatrixType::Unknown) |
| 5506 | 1077 typ = mattype.type (*this); |
| 1078 | |
| 5785 | 1079 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5506 | 1080 ret = dinverse (mattype, info, rcond, true, calc_cond); |
| 5785 | 1081 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5506 | 1082 ret = tinverse (mattype, info, rcond, true, calc_cond).transpose(); |
| 5785 | 1083 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 6185 | 1084 { |
| 1085 MatrixType newtype = mattype.transpose(); | |
| 1086 ret = transpose().tinverse (newtype, info, rcond, true, calc_cond); | |
| 1087 } | |
| 6840 | 1088 else |
| 5506 | 1089 { |
| 1090 if (mattype.is_hermitian()) | |
| 1091 { | |
| 5785 | 1092 MatrixType tmp_typ (MatrixType::Upper); |
| 5506 | 1093 SparseCHOL fact (*this, info, false); |
| 1094 rcond = fact.rcond(); | |
| 1095 if (info == 0) | |
| 1096 { | |
| 1097 double rcond2; | |
| 1098 SparseMatrix Q = fact.Q(); | |
| 1099 SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, | |
| 1100 info, rcond2, true, false); | |
| 1101 ret = Q * InvL.transpose() * InvL * Q.transpose(); | |
| 1102 } | |
| 1103 else | |
| 1104 { | |
| 1105 // Matrix is either singular or not positive definite | |
| 1106 mattype.mark_as_unsymmetric (); | |
| 5785 | 1107 typ = MatrixType::Full; |
| 5506 | 1108 } |
| 1109 } | |
| 1110 | |
| 1111 if (!mattype.is_hermitian()) | |
| 1112 { | |
| 1113 octave_idx_type n = rows(); | |
| 1114 ColumnVector Qinit(n); | |
| 1115 for (octave_idx_type i = 0; i < n; i++) | |
| 1116 Qinit(i) = i; | |
| 1117 | |
| 5785 | 1118 MatrixType tmp_typ (MatrixType::Upper); |
|
7515
f3c00dc0912b
Eliminate the rest of the dispatched sparse functions
David Bateman <dbateman@free.fr>
parents:
7503
diff
changeset
|
1119 SparseLU fact (*this, Qinit, Matrix(), false, false); |
| 5506 | 1120 rcond = fact.rcond(); |
| 1121 double rcond2; | |
| 1122 SparseMatrix InvL = fact.L().transpose().tinverse(tmp_typ, | |
| 1123 info, rcond2, true, false); | |
| 1124 SparseMatrix InvU = fact.U().tinverse(tmp_typ, info, rcond2, | |
| 1125 true, false).transpose(); | |
| 1126 ret = fact.Pc().transpose() * InvU * InvL * fact.Pr(); | |
| 1127 } | |
| 1128 } | |
| 1129 | |
| 1130 return ret; | |
| 5164 | 1131 } |
| 1132 | |
| 1133 DET | |
| 1134 SparseMatrix::determinant (void) const | |
| 1135 { | |
| 5275 | 1136 octave_idx_type info; |
| 5164 | 1137 double rcond; |
| 1138 return determinant (info, rcond, 0); | |
| 1139 } | |
| 1140 | |
| 1141 DET | |
| 5275 | 1142 SparseMatrix::determinant (octave_idx_type& info) const |
| 5164 | 1143 { |
| 1144 double rcond; | |
| 1145 return determinant (info, rcond, 0); | |
| 1146 } | |
| 1147 | |
| 1148 DET | |
| 5275 | 1149 SparseMatrix::determinant (octave_idx_type& err, double& rcond, int) const |
| 5164 | 1150 { |
| 1151 DET retval; | |
| 1152 | |
| 5203 | 1153 #ifdef HAVE_UMFPACK |
| 5275 | 1154 octave_idx_type nr = rows (); |
| 1155 octave_idx_type nc = cols (); | |
| 5164 | 1156 |
| 1157 if (nr == 0 || nc == 0 || nr != nc) | |
| 1158 { | |
| 1159 double d[2]; | |
| 1160 d[0] = 1.0; | |
| 1161 d[1] = 0.0; | |
| 1162 retval = DET (d); | |
| 1163 } | |
| 1164 else | |
| 1165 { | |
| 1166 err = 0; | |
| 1167 | |
| 1168 // Setup the control parameters | |
| 1169 Matrix Control (UMFPACK_CONTROL, 1); | |
| 1170 double *control = Control.fortran_vec (); | |
| 5322 | 1171 UMFPACK_DNAME (defaults) (control); |
| 5164 | 1172 |
| 5893 | 1173 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 1174 if (!xisnan (tmp)) |
| 1175 Control (UMFPACK_PRL) = tmp; | |
| 1176 | |
| 5893 | 1177 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 1178 if (!xisnan (tmp)) |
| 1179 { | |
| 1180 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 1181 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 1182 } | |
| 1183 | |
| 1184 // Set whether we are allowed to modify Q or not | |
| 5893 | 1185 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 1186 if (!xisnan (tmp)) |
| 1187 Control (UMFPACK_FIXQ) = tmp; | |
| 1188 | |
| 1189 // Turn-off UMFPACK scaling for LU | |
| 1190 Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; | |
| 1191 | |
| 5322 | 1192 UMFPACK_DNAME (report_control) (control); |
| 5164 | 1193 |
| 5275 | 1194 const octave_idx_type *Ap = cidx (); |
| 1195 const octave_idx_type *Ai = ridx (); | |
| 5164 | 1196 const double *Ax = data (); |
| 1197 | |
| 5322 | 1198 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control); |
| 5164 | 1199 |
| 1200 void *Symbolic; | |
| 1201 Matrix Info (1, UMFPACK_INFO); | |
| 1202 double *info = Info.fortran_vec (); | |
| 5322 | 1203 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, |
| 1204 Ax, NULL, &Symbolic, control, info); | |
| 5164 | 1205 |
| 1206 if (status < 0) | |
| 1207 { | |
| 1208 (*current_liboctave_error_handler) | |
| 1209 ("SparseMatrix::determinant symbolic factorization failed"); | |
| 1210 | |
| 5322 | 1211 UMFPACK_DNAME (report_status) (control, status); |
| 1212 UMFPACK_DNAME (report_info) (control, info); | |
| 1213 | |
| 1214 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 1215 } |
| 1216 else | |
| 1217 { | |
| 5322 | 1218 UMFPACK_DNAME (report_symbolic) (Symbolic, control); |
| 5164 | 1219 |
| 1220 void *Numeric; | |
| 5322 | 1221 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, |
| 1222 &Numeric, control, info) ; | |
| 1223 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 1224 |
| 1225 rcond = Info (UMFPACK_RCOND); | |
| 1226 | |
| 1227 if (status < 0) | |
| 1228 { | |
| 1229 (*current_liboctave_error_handler) | |
| 1230 ("SparseMatrix::determinant numeric factorization failed"); | |
| 1231 | |
| 5322 | 1232 UMFPACK_DNAME (report_status) (control, status); |
| 1233 UMFPACK_DNAME (report_info) (control, info); | |
| 1234 | |
| 1235 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 1236 } |
| 1237 else | |
| 1238 { | |
| 5322 | 1239 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 1240 |
| 1241 double d[2]; | |
| 1242 | |
| 5322 | 1243 status = UMFPACK_DNAME (get_determinant) (&d[0], |
| 1244 &d[1], Numeric, info); | |
| 5164 | 1245 |
| 1246 if (status < 0) | |
| 1247 { | |
| 1248 (*current_liboctave_error_handler) | |
| 1249 ("SparseMatrix::determinant error calculating determinant"); | |
| 1250 | |
| 5322 | 1251 UMFPACK_DNAME (report_status) (control, status); |
| 1252 UMFPACK_DNAME (report_info) (control, info); | |
| 5164 | 1253 } |
| 1254 else | |
| 1255 retval = DET (d); | |
| 5346 | 1256 |
| 1257 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 1258 } |
| 1259 } | |
| 1260 } | |
| 5203 | 1261 #else |
| 1262 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 1263 #endif | |
| 5164 | 1264 |
| 1265 return retval; | |
| 1266 } | |
| 1267 | |
| 1268 Matrix | |
| 5785 | 1269 SparseMatrix::dsolve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, |
| 5681 | 1270 double& rcond, solve_singularity_handler, |
| 1271 bool calc_cond) const | |
| 5164 | 1272 { |
| 1273 Matrix retval; | |
| 1274 | |
| 5275 | 1275 octave_idx_type nr = rows (); |
| 1276 octave_idx_type nc = cols (); | |
| 5630 | 1277 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1278 err = 0; |
| 1279 | |
| 6924 | 1280 if (nr != b.rows ()) |
| 5164 | 1281 (*current_liboctave_error_handler) |
| 1282 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1283 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1284 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 1285 else |
| 1286 { | |
| 1287 // Print spparms("spumoni") info if requested | |
| 1288 int typ = mattype.type (); | |
| 1289 mattype.info (); | |
| 1290 | |
| 5785 | 1291 if (typ == MatrixType::Diagonal || |
| 1292 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1293 { |
| 5630 | 1294 retval.resize (nc, b.cols(), 0.); |
| 5785 | 1295 if (typ == MatrixType::Diagonal) |
| 5275 | 1296 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1297 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1298 retval(i,j) = b(i,j) / data (i); |
| 1299 else | |
| 5275 | 1300 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1301 for (octave_idx_type k = 0; k < nc; k++) |
| 1302 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1303 retval(k,j) = b(ridx(i),j) / data (i); | |
| 1304 | |
| 5681 | 1305 if (calc_cond) |
| 1306 { | |
| 1307 double dmax = 0., dmin = octave_Inf; | |
| 1308 for (octave_idx_type i = 0; i < nm; i++) | |
| 1309 { | |
| 1310 double tmp = fabs(data(i)); | |
| 1311 if (tmp > dmax) | |
| 1312 dmax = tmp; | |
| 1313 if (tmp < dmin) | |
| 1314 dmin = tmp; | |
| 1315 } | |
| 1316 rcond = dmin / dmax; | |
| 1317 } | |
| 1318 else | |
| 1319 rcond = 1.; | |
| 5164 | 1320 } |
| 1321 else | |
| 1322 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1323 } | |
| 1324 | |
| 1325 return retval; | |
| 1326 } | |
| 1327 | |
| 1328 SparseMatrix | |
| 5785 | 1329 SparseMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 1330 octave_idx_type& err, double& rcond, |
| 1331 solve_singularity_handler, bool calc_cond) const | |
| 5164 | 1332 { |
| 1333 SparseMatrix retval; | |
| 1334 | |
| 5275 | 1335 octave_idx_type nr = rows (); |
| 1336 octave_idx_type nc = cols (); | |
| 5630 | 1337 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1338 err = 0; |
| 1339 | |
| 6924 | 1340 if (nr != b.rows ()) |
| 5164 | 1341 (*current_liboctave_error_handler) |
| 1342 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1343 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1344 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 1345 else |
| 1346 { | |
| 1347 // Print spparms("spumoni") info if requested | |
| 1348 int typ = mattype.type (); | |
| 1349 mattype.info (); | |
| 1350 | |
| 5785 | 1351 if (typ == MatrixType::Diagonal || |
| 1352 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1353 { |
| 5275 | 1354 octave_idx_type b_nc = b.cols (); |
| 5681 | 1355 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1356 retval = SparseMatrix (nc, b_nc, b_nz); |
| 5164 | 1357 |
| 1358 retval.xcidx(0) = 0; | |
| 5275 | 1359 octave_idx_type ii = 0; |
| 5785 | 1360 if (typ == MatrixType::Diagonal) |
| 5681 | 1361 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1362 { |
| 5275 | 1363 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1364 { |
| 5681 | 1365 if (b.ridx(i) >= nm) |
| 1366 break; | |
| 5164 | 1367 retval.xridx (ii) = b.ridx(i); |
| 1368 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1369 } | |
| 1370 retval.xcidx(j+1) = ii; | |
| 1371 } | |
| 1372 else | |
| 5681 | 1373 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1374 { |
| 5630 | 1375 for (octave_idx_type l = 0; l < nc; l++) |
| 1376 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1377 { | |
| 1378 bool found = false; | |
| 1379 octave_idx_type k; | |
| 1380 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1381 if (ridx(i) == b.ridx(k)) | |
| 1382 { | |
| 1383 found = true; | |
| 1384 break; | |
| 1385 } | |
| 1386 if (found) | |
| 5164 | 1387 { |
| 5630 | 1388 retval.xridx (ii) = l; |
| 1389 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1390 } |
| 5630 | 1391 } |
| 5164 | 1392 retval.xcidx(j+1) = ii; |
| 1393 } | |
| 5630 | 1394 |
| 5681 | 1395 if (calc_cond) |
| 1396 { | |
| 1397 double dmax = 0., dmin = octave_Inf; | |
| 1398 for (octave_idx_type i = 0; i < nm; i++) | |
| 1399 { | |
| 1400 double tmp = fabs(data(i)); | |
| 1401 if (tmp > dmax) | |
| 1402 dmax = tmp; | |
| 1403 if (tmp < dmin) | |
| 1404 dmin = tmp; | |
| 1405 } | |
| 1406 rcond = dmin / dmax; | |
| 1407 } | |
| 1408 else | |
| 1409 rcond = 1.; | |
| 5164 | 1410 } |
| 1411 else | |
| 1412 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1413 } | |
| 1414 | |
| 1415 return retval; | |
| 1416 } | |
| 1417 | |
| 1418 ComplexMatrix | |
| 5785 | 1419 SparseMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 1420 octave_idx_type& err, double& rcond, |
| 1421 solve_singularity_handler, bool calc_cond) const | |
| 5164 | 1422 { |
| 1423 ComplexMatrix retval; | |
| 1424 | |
| 5275 | 1425 octave_idx_type nr = rows (); |
| 1426 octave_idx_type nc = cols (); | |
| 5630 | 1427 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1428 err = 0; |
| 1429 | |
| 6924 | 1430 if (nr != b.rows ()) |
| 5164 | 1431 (*current_liboctave_error_handler) |
| 1432 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1433 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1434 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 1435 else |
| 1436 { | |
| 1437 // Print spparms("spumoni") info if requested | |
| 1438 int typ = mattype.type (); | |
| 1439 mattype.info (); | |
| 1440 | |
| 5785 | 1441 if (typ == MatrixType::Diagonal || |
| 1442 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1443 { |
| 5630 | 1444 retval.resize (nc, b.cols(), 0); |
| 5785 | 1445 if (typ == MatrixType::Diagonal) |
| 5275 | 1446 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1447 for (octave_idx_type i = 0; i < nm; i++) |
| 1448 retval(i,j) = b(i,j) / data (i); | |
| 5164 | 1449 else |
| 5275 | 1450 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1451 for (octave_idx_type k = 0; k < nc; k++) |
| 1452 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1453 retval(k,j) = b(ridx(i),j) / data (i); | |
| 5164 | 1454 |
| 5681 | 1455 if (calc_cond) |
| 1456 { | |
| 1457 double dmax = 0., dmin = octave_Inf; | |
| 1458 for (octave_idx_type i = 0; i < nm; i++) | |
| 1459 { | |
| 1460 double tmp = fabs(data(i)); | |
| 1461 if (tmp > dmax) | |
| 1462 dmax = tmp; | |
| 1463 if (tmp < dmin) | |
| 1464 dmin = tmp; | |
| 1465 } | |
| 1466 rcond = dmin / dmax; | |
| 1467 } | |
| 1468 else | |
| 1469 rcond = 1.; | |
| 5164 | 1470 } |
| 1471 else | |
| 1472 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1473 } | |
| 1474 | |
| 1475 return retval; | |
| 1476 } | |
| 1477 | |
| 1478 SparseComplexMatrix | |
| 5785 | 1479 SparseMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 1480 octave_idx_type& err, double& rcond, |
| 5681 | 1481 solve_singularity_handler, bool calc_cond) const |
| 5164 | 1482 { |
| 1483 SparseComplexMatrix retval; | |
| 1484 | |
| 5275 | 1485 octave_idx_type nr = rows (); |
| 1486 octave_idx_type nc = cols (); | |
| 5630 | 1487 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1488 err = 0; |
| 1489 | |
| 6924 | 1490 if (nr != b.rows ()) |
| 5164 | 1491 (*current_liboctave_error_handler) |
| 1492 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1493 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1494 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 1495 else |
| 1496 { | |
| 1497 // Print spparms("spumoni") info if requested | |
| 1498 int typ = mattype.type (); | |
| 1499 mattype.info (); | |
| 1500 | |
| 5785 | 1501 if (typ == MatrixType::Diagonal || |
| 1502 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1503 { |
| 5275 | 1504 octave_idx_type b_nc = b.cols (); |
| 5681 | 1505 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1506 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 1507 |
| 1508 retval.xcidx(0) = 0; | |
| 5275 | 1509 octave_idx_type ii = 0; |
| 5785 | 1510 if (typ == MatrixType::Diagonal) |
| 5275 | 1511 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1512 { |
| 5275 | 1513 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1514 { |
| 5681 | 1515 if (b.ridx(i) >= nm) |
| 1516 break; | |
| 5164 | 1517 retval.xridx (ii) = b.ridx(i); |
| 1518 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1519 } | |
| 1520 retval.xcidx(j+1) = ii; | |
| 1521 } | |
| 1522 else | |
| 5275 | 1523 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1524 { |
| 5630 | 1525 for (octave_idx_type l = 0; l < nc; l++) |
| 1526 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1527 { | |
| 1528 bool found = false; | |
| 1529 octave_idx_type k; | |
| 1530 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1531 if (ridx(i) == b.ridx(k)) | |
| 1532 { | |
| 1533 found = true; | |
| 1534 break; | |
| 1535 } | |
| 1536 if (found) | |
| 5164 | 1537 { |
| 5630 | 1538 retval.xridx (ii) = l; |
| 1539 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1540 } |
| 5630 | 1541 } |
| 5164 | 1542 retval.xcidx(j+1) = ii; |
| 1543 } | |
| 1544 | |
| 5681 | 1545 if (calc_cond) |
| 1546 { | |
| 1547 double dmax = 0., dmin = octave_Inf; | |
| 1548 for (octave_idx_type i = 0; i < nm; i++) | |
| 1549 { | |
| 1550 double tmp = fabs(data(i)); | |
| 1551 if (tmp > dmax) | |
| 1552 dmax = tmp; | |
| 1553 if (tmp < dmin) | |
| 1554 dmin = tmp; | |
| 1555 } | |
| 1556 rcond = dmin / dmax; | |
| 1557 } | |
| 1558 else | |
| 1559 rcond = 1.; | |
| 5164 | 1560 } |
| 1561 else | |
| 1562 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1563 } | |
| 1564 | |
| 1565 return retval; | |
| 1566 } | |
| 1567 | |
| 1568 Matrix | |
| 5785 | 1569 SparseMatrix::utsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 1570 octave_idx_type& err, double& rcond, |
| 5681 | 1571 solve_singularity_handler sing_handler, |
| 1572 bool calc_cond) const | |
| 5164 | 1573 { |
| 1574 Matrix retval; | |
| 1575 | |
| 5275 | 1576 octave_idx_type nr = rows (); |
| 1577 octave_idx_type nc = cols (); | |
| 5630 | 1578 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1579 err = 0; |
| 1580 | |
| 6924 | 1581 if (nr != b.rows ()) |
| 5164 | 1582 (*current_liboctave_error_handler) |
| 1583 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1584 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1585 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 1586 else |
| 1587 { | |
| 1588 // Print spparms("spumoni") info if requested | |
| 1589 int typ = mattype.type (); | |
| 1590 mattype.info (); | |
| 1591 | |
| 5785 | 1592 if (typ == MatrixType::Permuted_Upper || |
| 1593 typ == MatrixType::Upper) | |
| 5164 | 1594 { |
| 1595 double anorm = 0.; | |
| 1596 double ainvnorm = 0.; | |
| 5630 | 1597 octave_idx_type b_nc = b.cols (); |
| 5681 | 1598 rcond = 1.; |
| 1599 | |
| 1600 if (calc_cond) | |
| 1601 { | |
| 1602 // Calculate the 1-norm of matrix for rcond calculation | |
| 1603 for (octave_idx_type j = 0; j < nc; j++) | |
| 1604 { | |
| 1605 double atmp = 0.; | |
| 1606 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1607 atmp += fabs(data(i)); | |
| 1608 if (atmp > anorm) | |
| 1609 anorm = atmp; | |
| 1610 } | |
| 5164 | 1611 } |
| 1612 | |
| 5785 | 1613 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1614 { |
| 5630 | 1615 retval.resize (nc, b_nc); |
| 5322 | 1616 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 1617 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1618 | |
| 1619 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 1620 { |
| 5275 | 1621 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 1622 work[i] = b(i,j); |
| 5630 | 1623 for (octave_idx_type i = nr; i < nc; i++) |
| 1624 work[i] = 0.; | |
| 1625 | |
| 1626 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1627 { |
| 5322 | 1628 octave_idx_type kidx = perm[k]; |
| 1629 | |
| 1630 if (work[k] != 0.) | |
| 5164 | 1631 { |
| 5681 | 1632 if (ridx(cidx(kidx+1)-1) != k || |
| 1633 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1634 { |
| 1635 err = -2; | |
| 1636 goto triangular_error; | |
| 1637 } | |
| 1638 | |
| 5322 | 1639 double tmp = work[k] / data(cidx(kidx+1)-1); |
| 1640 work[k] = tmp; | |
| 1641 for (octave_idx_type i = cidx(kidx); | |
| 1642 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1643 { |
| 5322 | 1644 octave_idx_type iidx = ridx(i); |
| 1645 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1646 } |
| 1647 } | |
| 1648 } | |
| 1649 | |
| 5630 | 1650 for (octave_idx_type i = 0; i < nc; i++) |
| 1651 retval.xelem (perm[i], j) = work[i]; | |
| 5164 | 1652 } |
| 1653 | |
| 5681 | 1654 if (calc_cond) |
| 1655 { | |
| 1656 // Calculation of 1-norm of inv(*this) | |
| 1657 for (octave_idx_type i = 0; i < nm; i++) | |
| 1658 work[i] = 0.; | |
| 1659 | |
| 1660 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1661 { |
| 5681 | 1662 work[j] = 1.; |
| 1663 | |
| 1664 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1665 { |
| 5681 | 1666 octave_idx_type iidx = perm[k]; |
| 1667 | |
| 1668 if (work[k] != 0.) | |
| 5164 | 1669 { |
| 5681 | 1670 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 1671 work[k] = tmp; | |
| 1672 for (octave_idx_type i = cidx(iidx); | |
| 1673 i < cidx(iidx+1)-1; i++) | |
| 1674 { | |
| 1675 octave_idx_type idx2 = ridx(i); | |
| 1676 work[idx2] = work[idx2] - tmp * data(i); | |
| 1677 } | |
| 5164 | 1678 } |
| 1679 } | |
| 5681 | 1680 double atmp = 0; |
| 1681 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1682 { | |
| 1683 atmp += fabs(work[i]); | |
| 1684 work[i] = 0.; | |
| 1685 } | |
| 1686 if (atmp > ainvnorm) | |
| 1687 ainvnorm = atmp; | |
| 5164 | 1688 } |
| 5681 | 1689 rcond = 1. / ainvnorm / anorm; |
| 5164 | 1690 } |
| 1691 } | |
| 1692 else | |
| 1693 { | |
| 5630 | 1694 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1695 retval.resize (nc, b_nc); | |
| 1696 | |
| 1697 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 1698 { |
| 5630 | 1699 for (octave_idx_type i = 0; i < nr; i++) |
| 1700 work[i] = b(i,j); | |
| 1701 for (octave_idx_type i = nr; i < nc; i++) | |
| 1702 work[i] = 0.; | |
| 1703 | |
| 1704 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1705 { |
| 5630 | 1706 if (work[k] != 0.) |
| 5164 | 1707 { |
| 5681 | 1708 if (ridx(cidx(k+1)-1) != k || |
| 1709 data(cidx(k+1)-1) == 0.) | |
| 5164 | 1710 { |
| 1711 err = -2; | |
| 1712 goto triangular_error; | |
| 1713 } | |
| 1714 | |
| 5630 | 1715 double tmp = work[k] / data(cidx(k+1)-1); |
| 1716 work[k] = tmp; | |
| 5275 | 1717 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 1718 { |
| 5275 | 1719 octave_idx_type iidx = ridx(i); |
| 5630 | 1720 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 1721 } |
| 1722 } | |
| 1723 } | |
| 5630 | 1724 |
| 1725 for (octave_idx_type i = 0; i < nc; i++) | |
| 1726 retval.xelem (i, j) = work[i]; | |
| 5164 | 1727 } |
| 1728 | |
| 5681 | 1729 if (calc_cond) |
| 1730 { | |
| 1731 // Calculation of 1-norm of inv(*this) | |
| 1732 for (octave_idx_type i = 0; i < nm; i++) | |
| 1733 work[i] = 0.; | |
| 1734 | |
| 1735 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1736 { |
| 5681 | 1737 work[j] = 1.; |
| 1738 | |
| 1739 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1740 { |
| 5681 | 1741 if (work[k] != 0.) |
| 5164 | 1742 { |
| 5681 | 1743 double tmp = work[k] / data(cidx(k+1)-1); |
| 1744 work[k] = tmp; | |
| 1745 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) | |
| 1746 { | |
| 1747 octave_idx_type iidx = ridx(i); | |
| 1748 work[iidx] = work[iidx] - tmp * data(i); | |
| 1749 } | |
| 5164 | 1750 } |
| 1751 } | |
| 5681 | 1752 double atmp = 0; |
| 1753 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1754 { | |
| 1755 atmp += fabs(work[i]); | |
| 1756 work[i] = 0.; | |
| 1757 } | |
| 1758 if (atmp > ainvnorm) | |
| 1759 ainvnorm = atmp; | |
| 5164 | 1760 } |
| 5681 | 1761 rcond = 1. / ainvnorm / anorm; |
| 1762 } | |
| 1763 } | |
| 5164 | 1764 |
| 1765 triangular_error: | |
| 1766 if (err != 0) | |
| 1767 { | |
| 1768 if (sing_handler) | |
| 5681 | 1769 { |
| 1770 sing_handler (rcond); | |
| 1771 mattype.mark_as_rectangular (); | |
| 1772 } | |
| 5164 | 1773 else |
| 1774 (*current_liboctave_error_handler) | |
| 1775 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 1776 rcond); | |
| 1777 } | |
| 1778 | |
| 1779 volatile double rcond_plus_one = rcond + 1.0; | |
| 1780 | |
| 1781 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 1782 { | |
| 1783 err = -2; | |
| 1784 | |
| 1785 if (sing_handler) | |
| 5681 | 1786 { |
| 1787 sing_handler (rcond); | |
| 1788 mattype.mark_as_rectangular (); | |
| 1789 } | |
| 5164 | 1790 else |
| 1791 (*current_liboctave_error_handler) | |
| 1792 ("matrix singular to machine precision, rcond = %g", | |
| 1793 rcond); | |
| 1794 } | |
| 1795 } | |
| 1796 else | |
| 1797 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1798 } | |
| 1799 | |
| 1800 return retval; | |
| 1801 } | |
| 1802 | |
| 1803 SparseMatrix | |
| 5785 | 1804 SparseMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 1805 octave_idx_type& err, double& rcond, |
| 5681 | 1806 solve_singularity_handler sing_handler, |
| 1807 bool calc_cond) const | |
| 5164 | 1808 { |
| 1809 SparseMatrix retval; | |
| 1810 | |
| 5275 | 1811 octave_idx_type nr = rows (); |
| 1812 octave_idx_type nc = cols (); | |
| 5630 | 1813 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1814 err = 0; |
| 1815 | |
| 6924 | 1816 if (nr != b.rows ()) |
| 5164 | 1817 (*current_liboctave_error_handler) |
| 1818 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1819 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1820 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 1821 else |
| 1822 { | |
| 1823 // Print spparms("spumoni") info if requested | |
| 1824 int typ = mattype.type (); | |
| 1825 mattype.info (); | |
| 1826 | |
| 5785 | 1827 if (typ == MatrixType::Permuted_Upper || |
| 1828 typ == MatrixType::Upper) | |
| 5164 | 1829 { |
| 1830 double anorm = 0.; | |
| 1831 double ainvnorm = 0.; | |
| 5681 | 1832 rcond = 1.; |
| 1833 | |
| 1834 if (calc_cond) | |
| 1835 { | |
| 1836 // Calculate the 1-norm of matrix for rcond calculation | |
| 1837 for (octave_idx_type j = 0; j < nc; j++) | |
| 1838 { | |
| 1839 double atmp = 0.; | |
| 1840 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1841 atmp += fabs(data(i)); | |
| 1842 if (atmp > anorm) | |
| 1843 anorm = atmp; | |
| 1844 } | |
| 5164 | 1845 } |
| 1846 | |
| 5275 | 1847 octave_idx_type b_nc = b.cols (); |
| 5681 | 1848 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1849 retval = SparseMatrix (nc, b_nc, b_nz); |
| 5164 | 1850 retval.xcidx(0) = 0; |
| 5275 | 1851 octave_idx_type ii = 0; |
| 1852 octave_idx_type x_nz = b_nz; | |
| 5164 | 1853 |
| 5785 | 1854 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1855 { |
| 5322 | 1856 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 1857 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 1858 | |
| 1859 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 1860 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 1861 rperm[perm[i]] = i; |
| 5164 | 1862 |
| 5275 | 1863 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1864 { |
| 5630 | 1865 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1866 work[i] = 0.; |
| 5275 | 1867 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1868 work[b.ridx(i)] = b.data(i); |
| 1869 | |
| 5630 | 1870 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 1871 { |
| 5322 | 1872 octave_idx_type kidx = perm[k]; |
| 1873 | |
| 1874 if (work[k] != 0.) | |
| 5164 | 1875 { |
| 5681 | 1876 if (ridx(cidx(kidx+1)-1) != k || |
| 1877 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1878 { |
| 1879 err = -2; | |
| 1880 goto triangular_error; | |
| 1881 } | |
| 1882 | |
| 5322 | 1883 double tmp = work[k] / data(cidx(kidx+1)-1); |
| 1884 work[k] = tmp; | |
| 1885 for (octave_idx_type i = cidx(kidx); | |
| 1886 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1887 { |
| 5322 | 1888 octave_idx_type iidx = ridx(i); |
| 1889 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1890 } |
| 1891 } | |
| 1892 } | |
| 1893 | |
| 1894 // Count non-zeros in work vector and adjust space in | |
| 1895 // retval if needed | |
| 5275 | 1896 octave_idx_type new_nnz = 0; |
| 5630 | 1897 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 1898 if (work[i] != 0.) |
| 1899 new_nnz++; | |
| 1900 | |
| 1901 if (ii + new_nnz > x_nz) | |
| 1902 { | |
| 1903 // Resize the sparse matrix | |
| 5275 | 1904 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 1905 retval.change_capacity (sz); |
| 1906 x_nz = sz; | |
| 1907 } | |
| 1908 | |
| 5630 | 1909 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 1910 if (work[rperm[i]] != 0.) |
| 5164 | 1911 { |
| 1912 retval.xridx(ii) = i; | |
| 5322 | 1913 retval.xdata(ii++) = work[rperm[i]]; |
| 5164 | 1914 } |
| 1915 retval.xcidx(j+1) = ii; | |
| 1916 } | |
| 1917 | |
| 1918 retval.maybe_compress (); | |
| 1919 | |
| 5681 | 1920 if (calc_cond) |
| 1921 { | |
| 1922 // Calculation of 1-norm of inv(*this) | |
| 1923 for (octave_idx_type i = 0; i < nm; i++) | |
| 1924 work[i] = 0.; | |
| 1925 | |
| 1926 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1927 { |
| 5681 | 1928 work[j] = 1.; |
| 1929 | |
| 1930 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1931 { |
| 5681 | 1932 octave_idx_type iidx = perm[k]; |
| 1933 | |
| 1934 if (work[k] != 0.) | |
| 5164 | 1935 { |
| 5681 | 1936 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 1937 work[k] = tmp; | |
| 1938 for (octave_idx_type i = cidx(iidx); | |
| 1939 i < cidx(iidx+1)-1; i++) | |
| 1940 { | |
| 1941 octave_idx_type idx2 = ridx(i); | |
| 1942 work[idx2] = work[idx2] - tmp * data(i); | |
| 1943 } | |
| 5164 | 1944 } |
| 1945 } | |
| 5681 | 1946 double atmp = 0; |
| 1947 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1948 { | |
| 1949 atmp += fabs(work[i]); | |
| 1950 work[i] = 0.; | |
| 1951 } | |
| 1952 if (atmp > ainvnorm) | |
| 1953 ainvnorm = atmp; | |
| 5164 | 1954 } |
| 5681 | 1955 rcond = 1. / ainvnorm / anorm; |
| 5164 | 1956 } |
| 1957 } | |
| 1958 else | |
| 1959 { | |
| 5630 | 1960 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5164 | 1961 |
| 5275 | 1962 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1963 { |
| 5630 | 1964 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1965 work[i] = 0.; |
| 5275 | 1966 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1967 work[b.ridx(i)] = b.data(i); |
| 1968 | |
| 5630 | 1969 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 1970 { |
| 1971 if (work[k] != 0.) | |
| 1972 { | |
| 5681 | 1973 if (ridx(cidx(k+1)-1) != k || |
| 1974 data(cidx(k+1)-1) == 0.) | |
| 5164 | 1975 { |
| 1976 err = -2; | |
| 1977 goto triangular_error; | |
| 1978 } | |
| 1979 | |
| 1980 double tmp = work[k] / data(cidx(k+1)-1); | |
| 1981 work[k] = tmp; | |
| 5275 | 1982 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 1983 { |
| 5275 | 1984 octave_idx_type iidx = ridx(i); |
| 5164 | 1985 work[iidx] = work[iidx] - tmp * data(i); |
| 1986 } | |
| 1987 } | |
| 1988 } | |
| 1989 | |
| 1990 // Count non-zeros in work vector and adjust space in | |
| 1991 // retval if needed | |
| 5275 | 1992 octave_idx_type new_nnz = 0; |
| 5630 | 1993 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 1994 if (work[i] != 0.) |
| 1995 new_nnz++; | |
| 1996 | |
| 1997 if (ii + new_nnz > x_nz) | |
| 1998 { | |
| 1999 // Resize the sparse matrix | |
| 5275 | 2000 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2001 retval.change_capacity (sz); |
| 2002 x_nz = sz; | |
| 2003 } | |
| 2004 | |
| 5630 | 2005 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2006 if (work[i] != 0.) |
| 2007 { | |
| 2008 retval.xridx(ii) = i; | |
| 2009 retval.xdata(ii++) = work[i]; | |
| 2010 } | |
| 2011 retval.xcidx(j+1) = ii; | |
| 2012 } | |
| 2013 | |
| 2014 retval.maybe_compress (); | |
| 2015 | |
| 5681 | 2016 if (calc_cond) |
| 2017 { | |
| 2018 // Calculation of 1-norm of inv(*this) | |
| 2019 for (octave_idx_type i = 0; i < nm; i++) | |
| 2020 work[i] = 0.; | |
| 2021 | |
| 2022 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2023 { |
| 5681 | 2024 work[j] = 1.; |
| 2025 | |
| 2026 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2027 { |
| 5681 | 2028 if (work[k] != 0.) |
| 5164 | 2029 { |
| 5681 | 2030 double tmp = work[k] / data(cidx(k+1)-1); |
| 2031 work[k] = tmp; | |
| 2032 for (octave_idx_type i = cidx(k); | |
| 2033 i < cidx(k+1)-1; i++) | |
| 2034 { | |
| 2035 octave_idx_type iidx = ridx(i); | |
| 2036 work[iidx] = work[iidx] - tmp * data(i); | |
| 2037 } | |
| 5164 | 2038 } |
| 2039 } | |
| 5681 | 2040 double atmp = 0; |
| 2041 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2042 { | |
| 2043 atmp += fabs(work[i]); | |
| 2044 work[i] = 0.; | |
| 2045 } | |
| 2046 if (atmp > ainvnorm) | |
| 2047 ainvnorm = atmp; | |
| 5164 | 2048 } |
| 5681 | 2049 rcond = 1. / ainvnorm / anorm; |
| 2050 } | |
| 2051 } | |
| 5164 | 2052 |
| 2053 triangular_error: | |
| 2054 if (err != 0) | |
| 2055 { | |
| 2056 if (sing_handler) | |
| 5681 | 2057 { |
| 2058 sing_handler (rcond); | |
| 2059 mattype.mark_as_rectangular (); | |
| 2060 } | |
| 5164 | 2061 else |
| 2062 (*current_liboctave_error_handler) | |
| 2063 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2064 rcond); | |
| 2065 } | |
| 2066 | |
| 2067 volatile double rcond_plus_one = rcond + 1.0; | |
| 2068 | |
| 2069 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2070 { | |
| 2071 err = -2; | |
| 2072 | |
| 2073 if (sing_handler) | |
| 5681 | 2074 { |
| 2075 sing_handler (rcond); | |
| 2076 mattype.mark_as_rectangular (); | |
| 2077 } | |
| 5164 | 2078 else |
| 2079 (*current_liboctave_error_handler) | |
| 2080 ("matrix singular to machine precision, rcond = %g", | |
| 2081 rcond); | |
| 2082 } | |
| 2083 } | |
| 2084 else | |
| 2085 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2086 } | |
| 2087 return retval; | |
| 2088 } | |
| 2089 | |
| 2090 ComplexMatrix | |
| 5785 | 2091 SparseMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 2092 octave_idx_type& err, double& rcond, |
| 5681 | 2093 solve_singularity_handler sing_handler, |
| 2094 bool calc_cond) const | |
| 5164 | 2095 { |
| 2096 ComplexMatrix retval; | |
| 2097 | |
| 5275 | 2098 octave_idx_type nr = rows (); |
| 2099 octave_idx_type nc = cols (); | |
| 5630 | 2100 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2101 err = 0; |
| 2102 | |
| 6924 | 2103 if (nr != b.rows ()) |
| 5164 | 2104 (*current_liboctave_error_handler) |
| 2105 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2106 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2107 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 2108 else |
| 2109 { | |
| 2110 // Print spparms("spumoni") info if requested | |
| 2111 int typ = mattype.type (); | |
| 2112 mattype.info (); | |
| 2113 | |
| 5785 | 2114 if (typ == MatrixType::Permuted_Upper || |
| 2115 typ == MatrixType::Upper) | |
| 5164 | 2116 { |
| 2117 double anorm = 0.; | |
| 2118 double ainvnorm = 0.; | |
| 5275 | 2119 octave_idx_type b_nc = b.cols (); |
| 5681 | 2120 rcond = 1.; |
| 2121 | |
| 2122 if (calc_cond) | |
| 2123 { | |
| 2124 // Calculate the 1-norm of matrix for rcond calculation | |
| 2125 for (octave_idx_type j = 0; j < nc; j++) | |
| 2126 { | |
| 2127 double atmp = 0.; | |
| 2128 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2129 atmp += fabs(data(i)); | |
| 2130 if (atmp > anorm) | |
| 2131 anorm = atmp; | |
| 2132 } | |
| 5164 | 2133 } |
| 2134 | |
| 5785 | 2135 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2136 { |
| 5630 | 2137 retval.resize (nc, b_nc); |
| 5322 | 2138 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2139 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 2140 |
| 5275 | 2141 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2142 { |
| 5275 | 2143 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 2144 cwork[i] = b(i,j); |
| 5630 | 2145 for (octave_idx_type i = nr; i < nc; i++) |
| 2146 cwork[i] = 0.; | |
| 2147 | |
| 2148 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2149 { |
| 5322 | 2150 octave_idx_type kidx = perm[k]; |
| 2151 | |
| 2152 if (cwork[k] != 0.) | |
| 5164 | 2153 { |
| 5681 | 2154 if (ridx(cidx(kidx+1)-1) != k || |
| 2155 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2156 { |
| 2157 err = -2; | |
| 2158 goto triangular_error; | |
| 2159 } | |
| 2160 | |
| 5322 | 2161 Complex tmp = cwork[k] / data(cidx(kidx+1)-1); |
| 2162 cwork[k] = tmp; | |
| 2163 for (octave_idx_type i = cidx(kidx); | |
| 2164 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2165 { |
| 5322 | 2166 octave_idx_type iidx = ridx(i); |
| 2167 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 2168 } |
| 2169 } | |
| 2170 } | |
| 2171 | |
| 5630 | 2172 for (octave_idx_type i = 0; i < nc; i++) |
| 2173 retval.xelem (perm[i], j) = cwork[i]; | |
| 5164 | 2174 } |
| 2175 | |
| 5681 | 2176 if (calc_cond) |
| 2177 { | |
| 2178 // Calculation of 1-norm of inv(*this) | |
| 2179 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2180 for (octave_idx_type i = 0; i < nm; i++) | |
| 2181 work[i] = 0.; | |
| 2182 | |
| 2183 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2184 { |
| 5681 | 2185 work[j] = 1.; |
| 2186 | |
| 2187 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2188 { |
| 5681 | 2189 octave_idx_type iidx = perm[k]; |
| 2190 | |
| 2191 if (work[k] != 0.) | |
| 5164 | 2192 { |
| 5681 | 2193 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2194 work[k] = tmp; | |
| 2195 for (octave_idx_type i = cidx(iidx); | |
| 2196 i < cidx(iidx+1)-1; i++) | |
| 2197 { | |
| 2198 octave_idx_type idx2 = ridx(i); | |
| 2199 work[idx2] = work[idx2] - tmp * data(i); | |
| 2200 } | |
| 5164 | 2201 } |
| 2202 } | |
| 5681 | 2203 double atmp = 0; |
| 2204 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2205 { | |
| 2206 atmp += fabs(work[i]); | |
| 2207 work[i] = 0.; | |
| 2208 } | |
| 2209 if (atmp > ainvnorm) | |
| 2210 ainvnorm = atmp; | |
| 5164 | 2211 } |
| 5681 | 2212 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2213 } |
| 2214 } | |
| 2215 else | |
| 2216 { | |
| 5630 | 2217 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 2218 retval.resize (nc, b_nc); | |
| 5164 | 2219 |
| 5275 | 2220 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2221 { |
| 5630 | 2222 for (octave_idx_type i = 0; i < nr; i++) |
| 2223 cwork[i] = b(i,j); | |
| 2224 for (octave_idx_type i = nr; i < nc; i++) | |
| 2225 cwork[i] = 0.; | |
| 2226 | |
| 2227 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2228 { |
| 5630 | 2229 if (cwork[k] != 0.) |
| 5164 | 2230 { |
| 5681 | 2231 if (ridx(cidx(k+1)-1) != k || |
| 2232 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2233 { |
| 2234 err = -2; | |
| 2235 goto triangular_error; | |
| 2236 } | |
| 2237 | |
| 5630 | 2238 Complex tmp = cwork[k] / data(cidx(k+1)-1); |
| 2239 cwork[k] = tmp; | |
| 5275 | 2240 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2241 { |
| 5275 | 2242 octave_idx_type iidx = ridx(i); |
| 5630 | 2243 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 2244 } |
| 2245 } | |
| 2246 } | |
| 5630 | 2247 |
| 2248 for (octave_idx_type i = 0; i < nc; i++) | |
| 2249 retval.xelem (i, j) = cwork[i]; | |
| 5164 | 2250 } |
| 2251 | |
| 5681 | 2252 if (calc_cond) |
| 2253 { | |
| 2254 // Calculation of 1-norm of inv(*this) | |
| 2255 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2256 for (octave_idx_type i = 0; i < nm; i++) | |
| 2257 work[i] = 0.; | |
| 2258 | |
| 2259 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2260 { |
| 5681 | 2261 work[j] = 1.; |
| 2262 | |
| 2263 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2264 { |
| 5681 | 2265 if (work[k] != 0.) |
| 5164 | 2266 { |
| 5681 | 2267 double tmp = work[k] / data(cidx(k+1)-1); |
| 2268 work[k] = tmp; | |
| 2269 for (octave_idx_type i = cidx(k); | |
| 2270 i < cidx(k+1)-1; i++) | |
| 2271 { | |
| 2272 octave_idx_type iidx = ridx(i); | |
| 2273 work[iidx] = work[iidx] - tmp * data(i); | |
| 2274 } | |
| 5164 | 2275 } |
| 2276 } | |
| 5681 | 2277 double atmp = 0; |
| 2278 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2279 { | |
| 2280 atmp += fabs(work[i]); | |
| 2281 work[i] = 0.; | |
| 2282 } | |
| 2283 if (atmp > ainvnorm) | |
| 2284 ainvnorm = atmp; | |
| 5164 | 2285 } |
| 5681 | 2286 rcond = 1. / ainvnorm / anorm; |
| 2287 } | |
| 2288 } | |
| 5164 | 2289 |
| 2290 triangular_error: | |
| 2291 if (err != 0) | |
| 2292 { | |
| 2293 if (sing_handler) | |
| 5681 | 2294 { |
| 2295 sing_handler (rcond); | |
| 2296 mattype.mark_as_rectangular (); | |
| 2297 } | |
| 5164 | 2298 else |
| 2299 (*current_liboctave_error_handler) | |
| 2300 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2301 rcond); | |
| 2302 } | |
| 2303 | |
| 2304 volatile double rcond_plus_one = rcond + 1.0; | |
| 2305 | |
| 2306 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2307 { | |
| 2308 err = -2; | |
| 2309 | |
| 2310 if (sing_handler) | |
| 5681 | 2311 { |
| 2312 sing_handler (rcond); | |
| 2313 mattype.mark_as_rectangular (); | |
| 2314 } | |
| 5164 | 2315 else |
| 2316 (*current_liboctave_error_handler) | |
| 2317 ("matrix singular to machine precision, rcond = %g", | |
| 2318 rcond); | |
| 2319 } | |
| 2320 } | |
| 2321 else | |
| 2322 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2323 } | |
| 2324 | |
| 2325 return retval; | |
| 2326 } | |
| 2327 | |
| 2328 SparseComplexMatrix | |
| 5785 | 2329 SparseMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 2330 octave_idx_type& err, double& rcond, |
| 5681 | 2331 solve_singularity_handler sing_handler, |
| 2332 bool calc_cond) const | |
| 5164 | 2333 { |
| 2334 SparseComplexMatrix retval; | |
| 2335 | |
| 5275 | 2336 octave_idx_type nr = rows (); |
| 2337 octave_idx_type nc = cols (); | |
| 5630 | 2338 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2339 err = 0; |
| 2340 | |
| 6924 | 2341 if (nr != b.rows ()) |
| 5164 | 2342 (*current_liboctave_error_handler) |
| 2343 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2344 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2345 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 2346 else |
| 2347 { | |
| 2348 // Print spparms("spumoni") info if requested | |
| 2349 int typ = mattype.type (); | |
| 2350 mattype.info (); | |
| 2351 | |
| 5785 | 2352 if (typ == MatrixType::Permuted_Upper || |
| 2353 typ == MatrixType::Upper) | |
| 5164 | 2354 { |
| 2355 double anorm = 0.; | |
| 2356 double ainvnorm = 0.; | |
| 5681 | 2357 rcond = 1.; |
| 2358 | |
| 2359 if (calc_cond) | |
| 2360 { | |
| 2361 // Calculate the 1-norm of matrix for rcond calculation | |
| 2362 for (octave_idx_type j = 0; j < nc; j++) | |
| 2363 { | |
| 2364 double atmp = 0.; | |
| 2365 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2366 atmp += fabs(data(i)); | |
| 2367 if (atmp > anorm) | |
| 2368 anorm = atmp; | |
| 2369 } | |
| 5164 | 2370 } |
| 2371 | |
| 5275 | 2372 octave_idx_type b_nc = b.cols (); |
| 5681 | 2373 octave_idx_type b_nz = b.nnz (); |
| 5630 | 2374 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 2375 retval.xcidx(0) = 0; |
| 5275 | 2376 octave_idx_type ii = 0; |
| 2377 octave_idx_type x_nz = b_nz; | |
| 5164 | 2378 |
| 5785 | 2379 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2380 { |
| 5322 | 2381 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2382 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 2383 | |
| 2384 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 2385 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 2386 rperm[perm[i]] = i; |
| 5164 | 2387 |
| 5275 | 2388 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2389 { |
| 5630 | 2390 for (octave_idx_type i = 0; i < nm; i++) |
| 5322 | 2391 cwork[i] = 0.; |
| 5275 | 2392 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 2393 cwork[b.ridx(i)] = b.data(i); |
| 5164 | 2394 |
| 5630 | 2395 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 2396 { |
| 5322 | 2397 octave_idx_type kidx = perm[k]; |
| 2398 | |
| 2399 if (cwork[k] != 0.) | |
| 5164 | 2400 { |
| 5681 | 2401 if (ridx(cidx(kidx+1)-1) != k || |
| 2402 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2403 { |
| 2404 err = -2; | |
| 2405 goto triangular_error; | |
| 2406 } | |
| 2407 | |
| 5322 | 2408 Complex tmp = cwork[k] / data(cidx(kidx+1)-1); |
| 2409 cwork[k] = tmp; | |
| 2410 for (octave_idx_type i = cidx(kidx); | |
| 2411 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2412 { |
| 5322 | 2413 octave_idx_type iidx = ridx(i); |
| 2414 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 2415 } |
| 2416 } | |
| 2417 } | |
| 2418 | |
| 2419 // Count non-zeros in work vector and adjust space in | |
| 2420 // retval if needed | |
| 5275 | 2421 octave_idx_type new_nnz = 0; |
| 5630 | 2422 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2423 if (cwork[i] != 0.) |
| 5164 | 2424 new_nnz++; |
| 2425 | |
| 2426 if (ii + new_nnz > x_nz) | |
| 2427 { | |
| 2428 // Resize the sparse matrix | |
| 5275 | 2429 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2430 retval.change_capacity (sz); |
| 2431 x_nz = sz; | |
| 2432 } | |
| 2433 | |
| 5630 | 2434 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2435 if (cwork[rperm[i]] != 0.) |
| 5164 | 2436 { |
| 2437 retval.xridx(ii) = i; | |
| 5322 | 2438 retval.xdata(ii++) = cwork[rperm[i]]; |
| 5164 | 2439 } |
| 2440 retval.xcidx(j+1) = ii; | |
| 2441 } | |
| 2442 | |
| 2443 retval.maybe_compress (); | |
| 2444 | |
| 5681 | 2445 if (calc_cond) |
| 2446 { | |
| 2447 // Calculation of 1-norm of inv(*this) | |
| 2448 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2449 for (octave_idx_type i = 0; i < nm; i++) | |
| 2450 work[i] = 0.; | |
| 2451 | |
| 2452 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2453 { |
| 5681 | 2454 work[j] = 1.; |
| 2455 | |
| 2456 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2457 { |
| 5681 | 2458 octave_idx_type iidx = perm[k]; |
| 2459 | |
| 2460 if (work[k] != 0.) | |
| 5164 | 2461 { |
| 5681 | 2462 double tmp = work[k] / data(cidx(iidx+1)-1); |
| 2463 work[k] = tmp; | |
| 2464 for (octave_idx_type i = cidx(iidx); | |
| 2465 i < cidx(iidx+1)-1; i++) | |
| 2466 { | |
| 2467 octave_idx_type idx2 = ridx(i); | |
| 2468 work[idx2] = work[idx2] - tmp * data(i); | |
| 2469 } | |
| 5164 | 2470 } |
| 2471 } | |
| 5681 | 2472 double atmp = 0; |
| 2473 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2474 { | |
| 2475 atmp += fabs(work[i]); | |
| 2476 work[i] = 0.; | |
| 2477 } | |
| 2478 if (atmp > ainvnorm) | |
| 2479 ainvnorm = atmp; | |
| 5164 | 2480 } |
| 5681 | 2481 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2482 } |
| 2483 } | |
| 2484 else | |
| 2485 { | |
| 5630 | 2486 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 2487 |
| 5275 | 2488 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2489 { |
| 5630 | 2490 for (octave_idx_type i = 0; i < nm; i++) |
| 2491 cwork[i] = 0.; | |
| 5275 | 2492 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5630 | 2493 cwork[b.ridx(i)] = b.data(i); |
| 2494 | |
| 2495 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2496 { |
| 5630 | 2497 if (cwork[k] != 0.) |
| 5164 | 2498 { |
| 5681 | 2499 if (ridx(cidx(k+1)-1) != k || |
| 2500 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2501 { |
| 2502 err = -2; | |
| 2503 goto triangular_error; | |
| 2504 } | |
| 2505 | |
| 5630 | 2506 Complex tmp = cwork[k] / data(cidx(k+1)-1); |
| 2507 cwork[k] = tmp; | |
| 5275 | 2508 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2509 { |
| 5275 | 2510 octave_idx_type iidx = ridx(i); |
| 5630 | 2511 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 2512 } |
| 2513 } | |
| 2514 } | |
| 2515 | |
| 2516 // Count non-zeros in work vector and adjust space in | |
| 2517 // retval if needed | |
| 5275 | 2518 octave_idx_type new_nnz = 0; |
| 5630 | 2519 for (octave_idx_type i = 0; i < nc; i++) |
| 2520 if (cwork[i] != 0.) | |
| 5164 | 2521 new_nnz++; |
| 2522 | |
| 2523 if (ii + new_nnz > x_nz) | |
| 2524 { | |
| 2525 // Resize the sparse matrix | |
| 5275 | 2526 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2527 retval.change_capacity (sz); |
| 2528 x_nz = sz; | |
| 2529 } | |
| 2530 | |
| 5630 | 2531 for (octave_idx_type i = 0; i < nc; i++) |
| 2532 if (cwork[i] != 0.) | |
| 5164 | 2533 { |
| 2534 retval.xridx(ii) = i; | |
| 5630 | 2535 retval.xdata(ii++) = cwork[i]; |
| 5164 | 2536 } |
| 2537 retval.xcidx(j+1) = ii; | |
| 2538 } | |
| 2539 | |
| 2540 retval.maybe_compress (); | |
| 2541 | |
| 5681 | 2542 if (calc_cond) |
| 2543 { | |
| 2544 // Calculation of 1-norm of inv(*this) | |
| 2545 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 2546 for (octave_idx_type i = 0; i < nm; i++) | |
| 2547 work[i] = 0.; | |
| 2548 | |
| 2549 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2550 { |
| 5681 | 2551 work[j] = 1.; |
| 2552 | |
| 2553 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2554 { |
| 5681 | 2555 if (work[k] != 0.) |
| 5164 | 2556 { |
| 5681 | 2557 double tmp = work[k] / data(cidx(k+1)-1); |
| 2558 work[k] = tmp; | |
| 2559 for (octave_idx_type i = cidx(k); | |
| 2560 i < cidx(k+1)-1; i++) | |
| 2561 { | |
| 2562 octave_idx_type iidx = ridx(i); | |
| 2563 work[iidx] = work[iidx] - tmp * data(i); | |
| 2564 } | |
| 5164 | 2565 } |
| 2566 } | |
| 5681 | 2567 double atmp = 0; |
| 2568 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2569 { | |
| 2570 atmp += fabs(work[i]); | |
| 2571 work[i] = 0.; | |
| 2572 } | |
| 2573 if (atmp > ainvnorm) | |
| 2574 ainvnorm = atmp; | |
| 5164 | 2575 } |
| 5681 | 2576 rcond = 1. / ainvnorm / anorm; |
| 2577 } | |
| 2578 } | |
| 5164 | 2579 |
| 2580 triangular_error: | |
| 2581 if (err != 0) | |
| 2582 { | |
| 2583 if (sing_handler) | |
| 5681 | 2584 { |
| 2585 sing_handler (rcond); | |
| 2586 mattype.mark_as_rectangular (); | |
| 2587 } | |
| 5164 | 2588 else |
| 2589 (*current_liboctave_error_handler) | |
| 2590 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2591 rcond); | |
| 2592 } | |
| 2593 | |
| 2594 volatile double rcond_plus_one = rcond + 1.0; | |
| 2595 | |
| 2596 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2597 { | |
| 2598 err = -2; | |
| 2599 | |
| 2600 if (sing_handler) | |
| 5681 | 2601 { |
| 2602 sing_handler (rcond); | |
| 2603 mattype.mark_as_rectangular (); | |
| 2604 } | |
| 5164 | 2605 else |
| 2606 (*current_liboctave_error_handler) | |
| 2607 ("matrix singular to machine precision, rcond = %g", | |
| 2608 rcond); | |
| 2609 } | |
| 2610 } | |
| 2611 else | |
| 2612 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2613 } | |
| 2614 | |
| 2615 return retval; | |
| 2616 } | |
| 2617 | |
| 2618 Matrix | |
| 5785 | 2619 SparseMatrix::ltsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 2620 octave_idx_type& err, double& rcond, |
| 5681 | 2621 solve_singularity_handler sing_handler, |
| 2622 bool calc_cond) const | |
| 5164 | 2623 { |
| 2624 Matrix retval; | |
| 2625 | |
| 5275 | 2626 octave_idx_type nr = rows (); |
| 2627 octave_idx_type nc = cols (); | |
| 5630 | 2628 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2629 err = 0; |
| 2630 | |
| 6924 | 2631 if (nr != b.rows ()) |
| 5164 | 2632 (*current_liboctave_error_handler) |
| 2633 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2634 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2635 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 2636 else |
| 2637 { | |
| 2638 // Print spparms("spumoni") info if requested | |
| 2639 int typ = mattype.type (); | |
| 2640 mattype.info (); | |
| 2641 | |
| 5785 | 2642 if (typ == MatrixType::Permuted_Lower || |
| 2643 typ == MatrixType::Lower) | |
| 5164 | 2644 { |
| 2645 double anorm = 0.; | |
| 2646 double ainvnorm = 0.; | |
| 5630 | 2647 octave_idx_type b_nc = b.cols (); |
| 5681 | 2648 rcond = 1.; |
| 2649 | |
| 2650 if (calc_cond) | |
| 2651 { | |
| 2652 // Calculate the 1-norm of matrix for rcond calculation | |
| 2653 for (octave_idx_type j = 0; j < nc; j++) | |
| 2654 { | |
| 2655 double atmp = 0.; | |
| 2656 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2657 atmp += fabs(data(i)); | |
| 2658 if (atmp > anorm) | |
| 2659 anorm = atmp; | |
| 2660 } | |
| 5164 | 2661 } |
| 2662 | |
| 5785 | 2663 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 2664 { |
| 5630 | 2665 retval.resize (nc, b_nc); |
| 2666 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 5322 | 2667 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 2668 |
| 5630 | 2669 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2670 { |
| 5630 | 2671 if (nc > nr) |
| 2672 for (octave_idx_type i = 0; i < nm; i++) | |
| 2673 work[i] = 0.; | |
| 5275 | 2674 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 2675 work[perm[i]] = b(i,j); |
| 5164 | 2676 |
| 5630 | 2677 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 2678 { |
| 5322 | 2679 if (work[k] != 0.) |
| 5164 | 2680 { |
| 5322 | 2681 octave_idx_type minr = nr; |
| 2682 octave_idx_type mini = 0; | |
| 2683 | |
| 2684 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 2685 if (perm[ridx(i)] < minr) | |
| 2686 { | |
| 2687 minr = perm[ridx(i)]; | |
| 2688 mini = i; | |
| 2689 } | |
| 2690 | |
| 5681 | 2691 if (minr != k || data(mini) == 0) |
| 5164 | 2692 { |
| 2693 err = -2; | |
| 2694 goto triangular_error; | |
| 2695 } | |
| 2696 | |
| 5322 | 2697 double tmp = work[k] / data(mini); |
| 2698 work[k] = tmp; | |
| 2699 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 2700 { |
| 5322 | 2701 if (i == mini) |
| 2702 continue; | |
| 2703 | |
| 2704 octave_idx_type iidx = perm[ridx(i)]; | |
| 2705 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2706 } |
| 2707 } | |
| 2708 } | |
| 2709 | |
| 5630 | 2710 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2711 retval (i, j) = work[i]; |
| 5164 | 2712 } |
| 2713 | |
| 5681 | 2714 if (calc_cond) |
| 2715 { | |
| 2716 // Calculation of 1-norm of inv(*this) | |
| 2717 for (octave_idx_type i = 0; i < nm; i++) | |
| 2718 work[i] = 0.; | |
| 2719 | |
| 2720 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2721 { |
| 5681 | 2722 work[j] = 1.; |
| 2723 | |
| 2724 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2725 { |
| 5681 | 2726 if (work[k] != 0.) |
| 5164 | 2727 { |
| 5681 | 2728 octave_idx_type minr = nr; |
| 2729 octave_idx_type mini = 0; | |
| 2730 | |
| 2731 for (octave_idx_type i = cidx(k); | |
| 2732 i < cidx(k+1); i++) | |
| 2733 if (perm[ridx(i)] < minr) | |
| 2734 { | |
| 2735 minr = perm[ridx(i)]; | |
| 2736 mini = i; | |
| 2737 } | |
| 2738 | |
| 2739 double tmp = work[k] / data(mini); | |
| 2740 work[k] = tmp; | |
| 2741 for (octave_idx_type i = cidx(k); | |
| 2742 i < cidx(k+1); i++) | |
| 2743 { | |
| 2744 if (i == mini) | |
| 2745 continue; | |
| 2746 | |
| 2747 octave_idx_type iidx = perm[ridx(i)]; | |
| 2748 work[iidx] = work[iidx] - tmp * data(i); | |
| 2749 } | |
| 5164 | 2750 } |
| 2751 } | |
| 5681 | 2752 |
| 2753 double atmp = 0; | |
| 2754 for (octave_idx_type i = j; i < nc; i++) | |
| 2755 { | |
| 2756 atmp += fabs(work[i]); | |
| 2757 work[i] = 0.; | |
| 2758 } | |
| 2759 if (atmp > ainvnorm) | |
| 2760 ainvnorm = atmp; | |
| 5164 | 2761 } |
| 5681 | 2762 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2763 } |
| 2764 } | |
| 2765 else | |
| 2766 { | |
| 5630 | 2767 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 2768 retval.resize (nc, b_nc, 0.); | |
| 2769 | |
| 2770 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 2771 { |
| 5630 | 2772 for (octave_idx_type i = 0; i < nr; i++) |
| 2773 work[i] = b(i,j); | |
| 2774 for (octave_idx_type i = nr; i < nc; i++) | |
| 2775 work[i] = 0.; | |
| 2776 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2777 { |
| 5630 | 2778 if (work[k] != 0.) |
| 5164 | 2779 { |
| 5681 | 2780 if (ridx(cidx(k)) != k || |
| 2781 data(cidx(k)) == 0.) | |
| 5164 | 2782 { |
| 2783 err = -2; | |
| 2784 goto triangular_error; | |
| 2785 } | |
| 2786 | |
| 5630 | 2787 double tmp = work[k] / data(cidx(k)); |
| 2788 work[k] = tmp; | |
| 2789 for (octave_idx_type i = cidx(k)+1; | |
| 2790 i < cidx(k+1); i++) | |
| 5164 | 2791 { |
| 5275 | 2792 octave_idx_type iidx = ridx(i); |
| 5630 | 2793 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 2794 } |
| 2795 } | |
| 2796 } | |
| 5630 | 2797 |
| 2798 for (octave_idx_type i = 0; i < nc; i++) | |
| 2799 retval.xelem (i, j) = work[i]; | |
| 5164 | 2800 } |
| 2801 | |
| 5681 | 2802 if (calc_cond) |
| 2803 { | |
| 2804 // Calculation of 1-norm of inv(*this) | |
| 2805 for (octave_idx_type i = 0; i < nm; i++) | |
| 2806 work[i] = 0.; | |
| 2807 | |
| 2808 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2809 { |
| 5681 | 2810 work[j] = 1.; |
| 2811 | |
| 2812 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 2813 { |
| 5681 | 2814 |
| 2815 if (work[k] != 0.) | |
| 5164 | 2816 { |
| 5681 | 2817 double tmp = work[k] / data(cidx(k)); |
| 2818 work[k] = tmp; | |
| 2819 for (octave_idx_type i = cidx(k)+1; | |
| 2820 i < cidx(k+1); i++) | |
| 2821 { | |
| 2822 octave_idx_type iidx = ridx(i); | |
| 2823 work[iidx] = work[iidx] - tmp * data(i); | |
| 2824 } | |
| 5164 | 2825 } |
| 2826 } | |
| 5681 | 2827 double atmp = 0; |
| 2828 for (octave_idx_type i = j; i < nc; i++) | |
| 2829 { | |
| 2830 atmp += fabs(work[i]); | |
| 2831 work[i] = 0.; | |
| 2832 } | |
| 2833 if (atmp > ainvnorm) | |
| 2834 ainvnorm = atmp; | |
| 5164 | 2835 } |
| 5681 | 2836 rcond = 1. / ainvnorm / anorm; |
| 2837 } | |
| 2838 } | |
| 5164 | 2839 |
| 2840 triangular_error: | |
| 2841 if (err != 0) | |
| 2842 { | |
| 2843 if (sing_handler) | |
| 5681 | 2844 { |
| 2845 sing_handler (rcond); | |
| 2846 mattype.mark_as_rectangular (); | |
| 2847 } | |
| 5164 | 2848 else |
| 2849 (*current_liboctave_error_handler) | |
| 2850 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2851 rcond); | |
| 2852 } | |
| 2853 | |
| 2854 volatile double rcond_plus_one = rcond + 1.0; | |
| 2855 | |
| 2856 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2857 { | |
| 2858 err = -2; | |
| 2859 | |
| 2860 if (sing_handler) | |
| 5681 | 2861 { |
| 2862 sing_handler (rcond); | |
| 2863 mattype.mark_as_rectangular (); | |
| 2864 } | |
| 5164 | 2865 else |
| 2866 (*current_liboctave_error_handler) | |
| 2867 ("matrix singular to machine precision, rcond = %g", | |
| 2868 rcond); | |
| 2869 } | |
| 2870 } | |
| 2871 else | |
| 2872 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2873 } | |
| 2874 | |
| 2875 return retval; | |
| 2876 } | |
| 2877 | |
| 2878 SparseMatrix | |
| 5785 | 2879 SparseMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 2880 octave_idx_type& err, double& rcond, |
| 5681 | 2881 solve_singularity_handler sing_handler, |
| 2882 bool calc_cond) const | |
| 5164 | 2883 { |
| 2884 SparseMatrix retval; | |
| 2885 | |
| 5275 | 2886 octave_idx_type nr = rows (); |
| 2887 octave_idx_type nc = cols (); | |
| 5630 | 2888 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2889 err = 0; |
| 2890 | |
| 6924 | 2891 if (nr != b.rows ()) |
| 5164 | 2892 (*current_liboctave_error_handler) |
| 2893 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2894 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2895 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 2896 else |
| 2897 { | |
| 2898 // Print spparms("spumoni") info if requested | |
| 2899 int typ = mattype.type (); | |
| 2900 mattype.info (); | |
| 2901 | |
| 5785 | 2902 if (typ == MatrixType::Permuted_Lower || |
| 2903 typ == MatrixType::Lower) | |
| 5164 | 2904 { |
| 2905 double anorm = 0.; | |
| 2906 double ainvnorm = 0.; | |
| 5681 | 2907 rcond = 1.; |
| 2908 | |
| 2909 if (calc_cond) | |
| 2910 { | |
| 2911 // Calculate the 1-norm of matrix for rcond calculation | |
| 2912 for (octave_idx_type j = 0; j < nc; j++) | |
| 2913 { | |
| 2914 double atmp = 0.; | |
| 2915 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2916 atmp += fabs(data(i)); | |
| 2917 if (atmp > anorm) | |
| 2918 anorm = atmp; | |
| 2919 } | |
| 2920 } | |
| 2921 | |
| 5275 | 2922 octave_idx_type b_nc = b.cols (); |
| 5681 | 2923 octave_idx_type b_nz = b.nnz (); |
| 2924 retval = SparseMatrix (nc, b_nc, b_nz); | |
| 5164 | 2925 retval.xcidx(0) = 0; |
| 5275 | 2926 octave_idx_type ii = 0; |
| 2927 octave_idx_type x_nz = b_nz; | |
| 5164 | 2928 |
| 5785 | 2929 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 2930 { |
| 5681 | 2931 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5322 | 2932 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 2933 |
| 5275 | 2934 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2935 { |
| 5630 | 2936 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 2937 work[i] = 0.; |
| 5275 | 2938 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 2939 work[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 2940 |
| 5630 | 2941 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 2942 { |
| 5322 | 2943 if (work[k] != 0.) |
| 5164 | 2944 { |
| 5322 | 2945 octave_idx_type minr = nr; |
| 2946 octave_idx_type mini = 0; | |
| 2947 | |
| 2948 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 2949 if (perm[ridx(i)] < minr) | |
| 2950 { | |
| 2951 minr = perm[ridx(i)]; | |
| 2952 mini = i; | |
| 2953 } | |
| 2954 | |
| 5681 | 2955 if (minr != k || data(mini) == 0) |
| 5164 | 2956 { |
| 2957 err = -2; | |
| 2958 goto triangular_error; | |
| 2959 } | |
| 2960 | |
| 5322 | 2961 double tmp = work[k] / data(mini); |
| 2962 work[k] = tmp; | |
| 2963 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 2964 { |
| 5322 | 2965 if (i == mini) |
| 2966 continue; | |
| 2967 | |
| 2968 octave_idx_type iidx = perm[ridx(i)]; | |
| 2969 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2970 } |
| 2971 } | |
| 2972 } | |
| 2973 | |
| 2974 // Count non-zeros in work vector and adjust space in | |
| 2975 // retval if needed | |
| 5275 | 2976 octave_idx_type new_nnz = 0; |
| 5630 | 2977 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2978 if (work[i] != 0.) |
| 2979 new_nnz++; | |
| 2980 | |
| 2981 if (ii + new_nnz > x_nz) | |
| 2982 { | |
| 2983 // Resize the sparse matrix | |
| 5275 | 2984 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2985 retval.change_capacity (sz); |
| 2986 x_nz = sz; | |
| 2987 } | |
| 2988 | |
| 5630 | 2989 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2990 if (work[i] != 0.) |
| 5164 | 2991 { |
| 2992 retval.xridx(ii) = i; | |
| 5322 | 2993 retval.xdata(ii++) = work[i]; |
| 5164 | 2994 } |
| 2995 retval.xcidx(j+1) = ii; | |
| 2996 } | |
| 2997 | |
| 2998 retval.maybe_compress (); | |
| 2999 | |
| 5681 | 3000 if (calc_cond) |
| 3001 { | |
| 3002 // Calculation of 1-norm of inv(*this) | |
| 3003 for (octave_idx_type i = 0; i < nm; i++) | |
| 3004 work[i] = 0.; | |
| 3005 | |
| 3006 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3007 { |
| 5681 | 3008 work[j] = 1.; |
| 3009 | |
| 3010 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3011 { |
| 5681 | 3012 if (work[k] != 0.) |
| 5164 | 3013 { |
| 5681 | 3014 octave_idx_type minr = nr; |
| 3015 octave_idx_type mini = 0; | |
| 3016 | |
| 3017 for (octave_idx_type i = cidx(k); | |
| 3018 i < cidx(k+1); i++) | |
| 3019 if (perm[ridx(i)] < minr) | |
| 3020 { | |
| 3021 minr = perm[ridx(i)]; | |
| 3022 mini = i; | |
| 3023 } | |
| 3024 | |
| 3025 double tmp = work[k] / data(mini); | |
| 3026 work[k] = tmp; | |
| 3027 for (octave_idx_type i = cidx(k); | |
| 3028 i < cidx(k+1); i++) | |
| 3029 { | |
| 3030 if (i == mini) | |
| 3031 continue; | |
| 3032 | |
| 3033 octave_idx_type iidx = perm[ridx(i)]; | |
| 3034 work[iidx] = work[iidx] - tmp * data(i); | |
| 3035 } | |
| 5164 | 3036 } |
| 3037 } | |
| 5681 | 3038 |
| 3039 double atmp = 0; | |
| 3040 for (octave_idx_type i = j; i < nr; i++) | |
| 3041 { | |
| 3042 atmp += fabs(work[i]); | |
| 3043 work[i] = 0.; | |
| 3044 } | |
| 3045 if (atmp > ainvnorm) | |
| 3046 ainvnorm = atmp; | |
| 5164 | 3047 } |
| 5681 | 3048 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3049 } |
| 3050 } | |
| 3051 else | |
| 3052 { | |
| 5681 | 3053 OCTAVE_LOCAL_BUFFER (double, work, nm); |
| 5164 | 3054 |
| 5275 | 3055 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3056 { |
| 5630 | 3057 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 3058 work[i] = 0.; |
| 5275 | 3059 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 3060 work[b.ridx(i)] = b.data(i); |
| 3061 | |
| 5630 | 3062 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3063 { |
| 3064 if (work[k] != 0.) | |
| 3065 { | |
| 5681 | 3066 if (ridx(cidx(k)) != k || |
| 3067 data(cidx(k)) == 0.) | |
| 5164 | 3068 { |
| 3069 err = -2; | |
| 3070 goto triangular_error; | |
| 3071 } | |
| 3072 | |
| 3073 double tmp = work[k] / data(cidx(k)); | |
| 3074 work[k] = tmp; | |
| 5275 | 3075 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3076 { |
| 5275 | 3077 octave_idx_type iidx = ridx(i); |
| 5164 | 3078 work[iidx] = work[iidx] - tmp * data(i); |
| 3079 } | |
| 3080 } | |
| 3081 } | |
| 3082 | |
| 3083 // Count non-zeros in work vector and adjust space in | |
| 3084 // retval if needed | |
| 5275 | 3085 octave_idx_type new_nnz = 0; |
| 5630 | 3086 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3087 if (work[i] != 0.) |
| 3088 new_nnz++; | |
| 3089 | |
| 3090 if (ii + new_nnz > x_nz) | |
| 3091 { | |
| 3092 // Resize the sparse matrix | |
| 5275 | 3093 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3094 retval.change_capacity (sz); |
| 3095 x_nz = sz; | |
| 3096 } | |
| 3097 | |
| 5630 | 3098 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3099 if (work[i] != 0.) |
| 3100 { | |
| 3101 retval.xridx(ii) = i; | |
| 3102 retval.xdata(ii++) = work[i]; | |
| 3103 } | |
| 3104 retval.xcidx(j+1) = ii; | |
| 3105 } | |
| 3106 | |
| 3107 retval.maybe_compress (); | |
| 3108 | |
| 5681 | 3109 if (calc_cond) |
| 3110 { | |
| 3111 // Calculation of 1-norm of inv(*this) | |
| 3112 for (octave_idx_type i = 0; i < nm; i++) | |
| 3113 work[i] = 0.; | |
| 3114 | |
| 3115 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3116 { |
| 5681 | 3117 work[j] = 1.; |
| 3118 | |
| 3119 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3120 { |
| 5681 | 3121 |
| 3122 if (work[k] != 0.) | |
| 5164 | 3123 { |
| 5681 | 3124 double tmp = work[k] / data(cidx(k)); |
| 3125 work[k] = tmp; | |
| 3126 for (octave_idx_type i = cidx(k)+1; | |
| 3127 i < cidx(k+1); i++) | |
| 3128 { | |
| 3129 octave_idx_type iidx = ridx(i); | |
| 3130 work[iidx] = work[iidx] - tmp * data(i); | |
| 3131 } | |
| 5164 | 3132 } |
| 3133 } | |
| 5681 | 3134 double atmp = 0; |
| 3135 for (octave_idx_type i = j; i < nc; i++) | |
| 3136 { | |
| 3137 atmp += fabs(work[i]); | |
| 3138 work[i] = 0.; | |
| 3139 } | |
| 3140 if (atmp > ainvnorm) | |
| 3141 ainvnorm = atmp; | |
| 5164 | 3142 } |
| 5681 | 3143 rcond = 1. / ainvnorm / anorm; |
| 3144 } | |
| 3145 } | |
| 5164 | 3146 |
| 3147 triangular_error: | |
| 3148 if (err != 0) | |
| 3149 { | |
| 3150 if (sing_handler) | |
| 5681 | 3151 { |
| 3152 sing_handler (rcond); | |
| 3153 mattype.mark_as_rectangular (); | |
| 3154 } | |
| 5164 | 3155 else |
| 3156 (*current_liboctave_error_handler) | |
| 3157 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3158 rcond); | |
| 3159 } | |
| 3160 | |
| 3161 volatile double rcond_plus_one = rcond + 1.0; | |
| 3162 | |
| 3163 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3164 { | |
| 3165 err = -2; | |
| 3166 | |
| 3167 if (sing_handler) | |
| 5681 | 3168 { |
| 3169 sing_handler (rcond); | |
| 3170 mattype.mark_as_rectangular (); | |
| 3171 } | |
| 5164 | 3172 else |
| 3173 (*current_liboctave_error_handler) | |
| 3174 ("matrix singular to machine precision, rcond = %g", | |
| 3175 rcond); | |
| 3176 } | |
| 3177 } | |
| 3178 else | |
| 3179 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3180 } | |
| 3181 | |
| 3182 return retval; | |
| 3183 } | |
| 3184 | |
| 3185 ComplexMatrix | |
| 5785 | 3186 SparseMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 3187 octave_idx_type& err, double& rcond, |
| 5681 | 3188 solve_singularity_handler sing_handler, |
| 3189 bool calc_cond) const | |
| 5164 | 3190 { |
| 3191 ComplexMatrix retval; | |
| 3192 | |
| 5275 | 3193 octave_idx_type nr = rows (); |
| 3194 octave_idx_type nc = cols (); | |
| 5630 | 3195 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3196 err = 0; |
| 3197 | |
| 6924 | 3198 if (nr != b.rows ()) |
| 5164 | 3199 (*current_liboctave_error_handler) |
| 3200 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3201 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3202 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 3203 else |
| 3204 { | |
| 3205 // Print spparms("spumoni") info if requested | |
| 3206 int typ = mattype.type (); | |
| 3207 mattype.info (); | |
| 3208 | |
| 5785 | 3209 if (typ == MatrixType::Permuted_Lower || |
| 3210 typ == MatrixType::Lower) | |
| 5164 | 3211 { |
| 3212 double anorm = 0.; | |
| 3213 double ainvnorm = 0.; | |
| 5275 | 3214 octave_idx_type b_nc = b.cols (); |
| 5681 | 3215 rcond = 1.; |
| 3216 | |
| 3217 if (calc_cond) | |
| 3218 { | |
| 3219 // Calculate the 1-norm of matrix for rcond calculation | |
| 3220 for (octave_idx_type j = 0; j < nc; j++) | |
| 3221 { | |
| 3222 double atmp = 0.; | |
| 3223 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3224 atmp += fabs(data(i)); | |
| 3225 if (atmp > anorm) | |
| 3226 anorm = atmp; | |
| 3227 } | |
| 5164 | 3228 } |
| 3229 | |
| 5785 | 3230 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3231 { |
| 5630 | 3232 retval.resize (nc, b_nc); |
| 5681 | 3233 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5322 | 3234 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3235 |
| 5275 | 3236 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3237 { |
| 5630 | 3238 for (octave_idx_type i = 0; i < nm; i++) |
| 3239 cwork[i] = 0.; | |
| 5275 | 3240 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 3241 cwork[perm[i]] = b(i,j); |
| 5164 | 3242 |
| 5630 | 3243 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3244 { |
| 5322 | 3245 if (cwork[k] != 0.) |
| 5164 | 3246 { |
| 5322 | 3247 octave_idx_type minr = nr; |
| 3248 octave_idx_type mini = 0; | |
| 3249 | |
| 3250 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3251 if (perm[ridx(i)] < minr) | |
| 3252 { | |
| 3253 minr = perm[ridx(i)]; | |
| 3254 mini = i; | |
| 3255 } | |
| 3256 | |
| 5681 | 3257 if (minr != k || data(mini) == 0) |
| 5164 | 3258 { |
| 3259 err = -2; | |
| 3260 goto triangular_error; | |
| 3261 } | |
| 3262 | |
| 5322 | 3263 Complex tmp = cwork[k] / data(mini); |
| 3264 cwork[k] = tmp; | |
| 3265 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3266 { |
| 5322 | 3267 if (i == mini) |
| 3268 continue; | |
| 3269 | |
| 3270 octave_idx_type iidx = perm[ridx(i)]; | |
| 3271 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 3272 } |
| 3273 } | |
| 3274 } | |
| 3275 | |
| 5630 | 3276 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3277 retval (i, j) = cwork[i]; |
| 5164 | 3278 } |
| 3279 | |
| 5681 | 3280 if (calc_cond) |
| 3281 { | |
| 3282 // Calculation of 1-norm of inv(*this) | |
| 3283 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3284 for (octave_idx_type i = 0; i < nm; i++) | |
| 3285 work[i] = 0.; | |
| 3286 | |
| 3287 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3288 { |
| 5681 | 3289 work[j] = 1.; |
| 3290 | |
| 3291 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3292 { |
| 5681 | 3293 if (work[k] != 0.) |
| 5164 | 3294 { |
| 5681 | 3295 octave_idx_type minr = nr; |
| 3296 octave_idx_type mini = 0; | |
| 3297 | |
| 3298 for (octave_idx_type i = cidx(k); | |
| 3299 i < cidx(k+1); i++) | |
| 3300 if (perm[ridx(i)] < minr) | |
| 3301 { | |
| 3302 minr = perm[ridx(i)]; | |
| 3303 mini = i; | |
| 3304 } | |
| 3305 | |
| 3306 double tmp = work[k] / data(mini); | |
| 3307 work[k] = tmp; | |
| 3308 for (octave_idx_type i = cidx(k); | |
| 3309 i < cidx(k+1); i++) | |
| 3310 { | |
| 3311 if (i == mini) | |
| 3312 continue; | |
| 3313 | |
| 3314 octave_idx_type iidx = perm[ridx(i)]; | |
| 3315 work[iidx] = work[iidx] - tmp * data(i); | |
| 3316 } | |
| 5164 | 3317 } |
| 3318 } | |
| 5681 | 3319 |
| 3320 double atmp = 0; | |
| 3321 for (octave_idx_type i = j; i < nc; i++) | |
| 3322 { | |
| 3323 atmp += fabs(work[i]); | |
| 3324 work[i] = 0.; | |
| 3325 } | |
| 3326 if (atmp > ainvnorm) | |
| 3327 ainvnorm = atmp; | |
| 5164 | 3328 } |
| 5681 | 3329 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3330 } |
| 3331 } | |
| 3332 else | |
| 3333 { | |
| 5630 | 3334 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 3335 retval.resize (nc, b_nc, 0.); | |
| 5164 | 3336 |
| 5275 | 3337 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3338 { |
| 5630 | 3339 for (octave_idx_type i = 0; i < nr; i++) |
| 3340 cwork[i] = b(i,j); | |
| 3341 for (octave_idx_type i = nr; i < nc; i++) | |
| 3342 cwork[i] = 0.; | |
| 3343 | |
| 3344 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3345 { |
| 5630 | 3346 if (cwork[k] != 0.) |
| 5164 | 3347 { |
| 5681 | 3348 if (ridx(cidx(k)) != k || |
| 3349 data(cidx(k)) == 0.) | |
| 5164 | 3350 { |
| 3351 err = -2; | |
| 3352 goto triangular_error; | |
| 3353 } | |
| 3354 | |
| 5630 | 3355 Complex tmp = cwork[k] / data(cidx(k)); |
| 3356 cwork[k] = tmp; | |
| 5275 | 3357 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3358 { |
| 5275 | 3359 octave_idx_type iidx = ridx(i); |
| 5630 | 3360 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 3361 } |
| 3362 } | |
| 3363 } | |
| 5630 | 3364 |
| 3365 for (octave_idx_type i = 0; i < nc; i++) | |
| 3366 retval.xelem (i, j) = cwork[i]; | |
| 5164 | 3367 } |
| 3368 | |
| 5681 | 3369 if (calc_cond) |
| 3370 { | |
| 3371 // Calculation of 1-norm of inv(*this) | |
| 3372 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3373 for (octave_idx_type i = 0; i < nm; i++) | |
| 3374 work[i] = 0.; | |
| 3375 | |
| 3376 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3377 { |
| 5681 | 3378 work[j] = 1.; |
| 3379 | |
| 3380 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3381 { |
| 5681 | 3382 |
| 3383 if (work[k] != 0.) | |
| 5164 | 3384 { |
| 5681 | 3385 double tmp = work[k] / data(cidx(k)); |
| 3386 work[k] = tmp; | |
| 3387 for (octave_idx_type i = cidx(k)+1; | |
| 3388 i < cidx(k+1); i++) | |
| 3389 { | |
| 3390 octave_idx_type iidx = ridx(i); | |
| 3391 work[iidx] = work[iidx] - tmp * data(i); | |
| 3392 } | |
| 5164 | 3393 } |
| 3394 } | |
| 5681 | 3395 double atmp = 0; |
| 3396 for (octave_idx_type i = j; i < nc; i++) | |
| 3397 { | |
| 3398 atmp += fabs(work[i]); | |
| 3399 work[i] = 0.; | |
| 3400 } | |
| 3401 if (atmp > ainvnorm) | |
| 3402 ainvnorm = atmp; | |
| 5164 | 3403 } |
| 5681 | 3404 rcond = 1. / ainvnorm / anorm; |
| 3405 } | |
| 3406 } | |
| 5164 | 3407 |
| 3408 triangular_error: | |
| 3409 if (err != 0) | |
| 3410 { | |
| 3411 if (sing_handler) | |
| 5681 | 3412 { |
| 3413 sing_handler (rcond); | |
| 3414 mattype.mark_as_rectangular (); | |
| 3415 } | |
| 5164 | 3416 else |
| 3417 (*current_liboctave_error_handler) | |
| 3418 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3419 rcond); | |
| 3420 } | |
| 3421 | |
| 3422 volatile double rcond_plus_one = rcond + 1.0; | |
| 3423 | |
| 3424 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3425 { | |
| 3426 err = -2; | |
| 3427 | |
| 3428 if (sing_handler) | |
| 5681 | 3429 { |
| 3430 sing_handler (rcond); | |
| 3431 mattype.mark_as_rectangular (); | |
| 3432 } | |
| 5164 | 3433 else |
| 3434 (*current_liboctave_error_handler) | |
| 3435 ("matrix singular to machine precision, rcond = %g", | |
| 3436 rcond); | |
| 3437 } | |
| 3438 } | |
| 3439 else | |
| 3440 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3441 } | |
| 3442 | |
| 3443 return retval; | |
| 3444 } | |
| 3445 | |
| 3446 SparseComplexMatrix | |
| 5785 | 3447 SparseMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 3448 octave_idx_type& err, double& rcond, |
| 5681 | 3449 solve_singularity_handler sing_handler, |
| 3450 bool calc_cond) const | |
| 5164 | 3451 { |
| 3452 SparseComplexMatrix retval; | |
| 3453 | |
| 5275 | 3454 octave_idx_type nr = rows (); |
| 3455 octave_idx_type nc = cols (); | |
| 5630 | 3456 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3457 err = 0; |
| 3458 | |
| 6924 | 3459 if (nr != b.rows ()) |
| 5164 | 3460 (*current_liboctave_error_handler) |
| 3461 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3462 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3463 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 3464 else |
| 3465 { | |
| 3466 // Print spparms("spumoni") info if requested | |
| 3467 int typ = mattype.type (); | |
| 3468 mattype.info (); | |
| 3469 | |
| 5785 | 3470 if (typ == MatrixType::Permuted_Lower || |
| 3471 typ == MatrixType::Lower) | |
| 5164 | 3472 { |
| 3473 double anorm = 0.; | |
| 3474 double ainvnorm = 0.; | |
| 5681 | 3475 rcond = 1.; |
| 3476 | |
| 3477 if (calc_cond) | |
| 3478 { | |
| 3479 // Calculate the 1-norm of matrix for rcond calculation | |
| 3480 for (octave_idx_type j = 0; j < nc; j++) | |
| 3481 { | |
| 3482 double atmp = 0.; | |
| 3483 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3484 atmp += fabs(data(i)); | |
| 3485 if (atmp > anorm) | |
| 3486 anorm = atmp; | |
| 3487 } | |
| 5164 | 3488 } |
| 3489 | |
| 5275 | 3490 octave_idx_type b_nc = b.cols (); |
| 5681 | 3491 octave_idx_type b_nz = b.nnz (); |
| 5630 | 3492 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 3493 retval.xcidx(0) = 0; |
| 5275 | 3494 octave_idx_type ii = 0; |
| 3495 octave_idx_type x_nz = b_nz; | |
| 5164 | 3496 |
| 5785 | 3497 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3498 { |
| 5630 | 3499 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5322 | 3500 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3501 |
| 5275 | 3502 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3503 { |
| 5630 | 3504 for (octave_idx_type i = 0; i < nm; i++) |
| 5322 | 3505 cwork[i] = 0.; |
| 5275 | 3506 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 3507 cwork[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 3508 |
| 5630 | 3509 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3510 { |
| 5322 | 3511 if (cwork[k] != 0.) |
| 5164 | 3512 { |
| 5322 | 3513 octave_idx_type minr = nr; |
| 3514 octave_idx_type mini = 0; | |
| 3515 | |
| 3516 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3517 if (perm[ridx(i)] < minr) | |
| 3518 { | |
| 3519 minr = perm[ridx(i)]; | |
| 3520 mini = i; | |
| 3521 } | |
| 3522 | |
| 5681 | 3523 if (minr != k || data(mini) == 0) |
| 5164 | 3524 { |
| 3525 err = -2; | |
| 3526 goto triangular_error; | |
| 3527 } | |
| 3528 | |
| 5322 | 3529 Complex tmp = cwork[k] / data(mini); |
| 3530 cwork[k] = tmp; | |
| 3531 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3532 { |
| 5322 | 3533 if (i == mini) |
| 3534 continue; | |
| 3535 | |
| 3536 octave_idx_type iidx = perm[ridx(i)]; | |
| 3537 cwork[iidx] = cwork[iidx] - tmp * data(i); | |
| 5164 | 3538 } |
| 3539 } | |
| 3540 } | |
| 3541 | |
| 3542 // Count non-zeros in work vector and adjust space in | |
| 3543 // retval if needed | |
| 5275 | 3544 octave_idx_type new_nnz = 0; |
| 5630 | 3545 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3546 if (cwork[i] != 0.) |
| 5164 | 3547 new_nnz++; |
| 3548 | |
| 3549 if (ii + new_nnz > x_nz) | |
| 3550 { | |
| 3551 // Resize the sparse matrix | |
| 5275 | 3552 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3553 retval.change_capacity (sz); |
| 3554 x_nz = sz; | |
| 3555 } | |
| 3556 | |
| 5630 | 3557 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3558 if (cwork[i] != 0.) |
| 5164 | 3559 { |
| 3560 retval.xridx(ii) = i; | |
| 5322 | 3561 retval.xdata(ii++) = cwork[i]; |
| 5164 | 3562 } |
| 3563 retval.xcidx(j+1) = ii; | |
| 3564 } | |
| 3565 | |
| 3566 retval.maybe_compress (); | |
| 3567 | |
| 5681 | 3568 if (calc_cond) |
| 3569 { | |
| 3570 // Calculation of 1-norm of inv(*this) | |
| 3571 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3572 for (octave_idx_type i = 0; i < nm; i++) | |
| 3573 work[i] = 0.; | |
| 3574 | |
| 3575 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3576 { |
| 5681 | 3577 work[j] = 1.; |
| 3578 | |
| 3579 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3580 { |
| 5681 | 3581 if (work[k] != 0.) |
| 5164 | 3582 { |
| 5681 | 3583 octave_idx_type minr = nr; |
| 3584 octave_idx_type mini = 0; | |
| 3585 | |
| 3586 for (octave_idx_type i = cidx(k); | |
| 3587 i < cidx(k+1); i++) | |
| 3588 if (perm[ridx(i)] < minr) | |
| 3589 { | |
| 3590 minr = perm[ridx(i)]; | |
| 3591 mini = i; | |
| 3592 } | |
| 3593 | |
| 3594 double tmp = work[k] / data(mini); | |
| 3595 work[k] = tmp; | |
| 3596 for (octave_idx_type i = cidx(k); | |
| 3597 i < cidx(k+1); i++) | |
| 3598 { | |
| 3599 if (i == mini) | |
| 3600 continue; | |
| 3601 | |
| 3602 octave_idx_type iidx = perm[ridx(i)]; | |
| 3603 work[iidx] = work[iidx] - tmp * data(i); | |
| 3604 } | |
| 5164 | 3605 } |
| 3606 } | |
| 5681 | 3607 |
| 3608 double atmp = 0; | |
| 3609 for (octave_idx_type i = j; i < nc; i++) | |
| 3610 { | |
| 3611 atmp += fabs(work[i]); | |
| 3612 work[i] = 0.; | |
| 3613 } | |
| 3614 if (atmp > ainvnorm) | |
| 3615 ainvnorm = atmp; | |
| 5164 | 3616 } |
| 5681 | 3617 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3618 } |
| 3619 } | |
| 3620 else | |
| 3621 { | |
| 5630 | 3622 OCTAVE_LOCAL_BUFFER (Complex, cwork, nm); |
| 5164 | 3623 |
| 5275 | 3624 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3625 { |
| 5630 | 3626 for (octave_idx_type i = 0; i < nm; i++) |
| 3627 cwork[i] = 0.; | |
| 5275 | 3628 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5630 | 3629 cwork[b.ridx(i)] = b.data(i); |
| 3630 | |
| 3631 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3632 { |
| 5630 | 3633 if (cwork[k] != 0.) |
| 5164 | 3634 { |
| 5681 | 3635 if (ridx(cidx(k)) != k || |
| 3636 data(cidx(k)) == 0.) | |
| 5164 | 3637 { |
| 3638 err = -2; | |
| 3639 goto triangular_error; | |
| 3640 } | |
| 3641 | |
| 5630 | 3642 Complex tmp = cwork[k] / data(cidx(k)); |
| 3643 cwork[k] = tmp; | |
| 5275 | 3644 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3645 { |
| 5275 | 3646 octave_idx_type iidx = ridx(i); |
| 5630 | 3647 cwork[iidx] = cwork[iidx] - tmp * data(i); |
| 5164 | 3648 } |
| 3649 } | |
| 3650 } | |
| 3651 | |
| 3652 // Count non-zeros in work vector and adjust space in | |
| 3653 // retval if needed | |
| 5275 | 3654 octave_idx_type new_nnz = 0; |
| 5630 | 3655 for (octave_idx_type i = 0; i < nc; i++) |
| 3656 if (cwork[i] != 0.) | |
| 5164 | 3657 new_nnz++; |
| 3658 | |
| 3659 if (ii + new_nnz > x_nz) | |
| 3660 { | |
| 3661 // Resize the sparse matrix | |
| 5275 | 3662 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3663 retval.change_capacity (sz); |
| 3664 x_nz = sz; | |
| 3665 } | |
| 3666 | |
| 5630 | 3667 for (octave_idx_type i = 0; i < nc; i++) |
| 3668 if (cwork[i] != 0.) | |
| 5164 | 3669 { |
| 3670 retval.xridx(ii) = i; | |
| 5630 | 3671 retval.xdata(ii++) = cwork[i]; |
| 5164 | 3672 } |
| 3673 retval.xcidx(j+1) = ii; | |
| 3674 } | |
| 3675 | |
| 3676 retval.maybe_compress (); | |
| 3677 | |
| 5681 | 3678 if (calc_cond) |
| 3679 { | |
| 3680 // Calculation of 1-norm of inv(*this) | |
| 3681 OCTAVE_LOCAL_BUFFER (double, work, nm); | |
| 3682 for (octave_idx_type i = 0; i < nm; i++) | |
| 3683 work[i] = 0.; | |
| 3684 | |
| 3685 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3686 { |
| 5681 | 3687 work[j] = 1.; |
| 3688 | |
| 3689 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3690 { |
| 5681 | 3691 |
| 3692 if (work[k] != 0.) | |
| 5164 | 3693 { |
| 5681 | 3694 double tmp = work[k] / data(cidx(k)); |
| 3695 work[k] = tmp; | |
| 3696 for (octave_idx_type i = cidx(k)+1; | |
| 3697 i < cidx(k+1); i++) | |
| 3698 { | |
| 3699 octave_idx_type iidx = ridx(i); | |
| 3700 work[iidx] = work[iidx] - tmp * data(i); | |
| 3701 } | |
| 5164 | 3702 } |
| 3703 } | |
| 5681 | 3704 double atmp = 0; |
| 3705 for (octave_idx_type i = j; i < nc; i++) | |
| 3706 { | |
| 3707 atmp += fabs(work[i]); | |
| 3708 work[i] = 0.; | |
| 3709 } | |
| 3710 if (atmp > ainvnorm) | |
| 3711 ainvnorm = atmp; | |
| 5164 | 3712 } |
| 5681 | 3713 rcond = 1. / ainvnorm / anorm; |
| 3714 } | |
| 3715 } | |
| 5164 | 3716 |
| 3717 triangular_error: | |
| 3718 if (err != 0) | |
| 3719 { | |
| 3720 if (sing_handler) | |
| 5681 | 3721 { |
| 3722 sing_handler (rcond); | |
| 3723 mattype.mark_as_rectangular (); | |
| 3724 } | |
| 5164 | 3725 else |
| 3726 (*current_liboctave_error_handler) | |
| 3727 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3728 rcond); | |
| 3729 } | |
| 3730 | |
| 3731 volatile double rcond_plus_one = rcond + 1.0; | |
| 3732 | |
| 3733 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3734 { | |
| 3735 err = -2; | |
| 3736 | |
| 3737 if (sing_handler) | |
| 5681 | 3738 { |
| 3739 sing_handler (rcond); | |
| 3740 mattype.mark_as_rectangular (); | |
| 3741 } | |
| 5164 | 3742 else |
| 3743 (*current_liboctave_error_handler) | |
| 3744 ("matrix singular to machine precision, rcond = %g", | |
| 3745 rcond); | |
| 3746 } | |
| 3747 } | |
| 3748 else | |
| 3749 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3750 } | |
| 3751 | |
| 3752 return retval; | |
| 3753 } | |
| 3754 | |
| 3755 Matrix | |
| 5785 | 3756 SparseMatrix::trisolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 3757 octave_idx_type& err, double& rcond, |
| 3758 solve_singularity_handler sing_handler, | |
| 3759 bool calc_cond) const | |
| 5164 | 3760 { |
| 3761 Matrix retval; | |
| 3762 | |
| 5275 | 3763 octave_idx_type nr = rows (); |
| 3764 octave_idx_type nc = cols (); | |
| 5164 | 3765 err = 0; |
| 3766 | |
| 6924 | 3767 if (nr != nc || nr != b.rows ()) |
| 5164 | 3768 (*current_liboctave_error_handler) |
| 3769 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3770 else if (nr == 0 || b.cols () == 0) |
| 3771 retval = Matrix (nc, b.cols (), 0.0); | |
| 5681 | 3772 else if (calc_cond) |
| 3773 (*current_liboctave_error_handler) | |
| 3774 ("calculation of condition number not implemented"); | |
| 5164 | 3775 else |
| 3776 { | |
| 3777 // Print spparms("spumoni") info if requested | |
| 3778 volatile int typ = mattype.type (); | |
| 3779 mattype.info (); | |
| 3780 | |
| 5785 | 3781 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3782 { |
| 3783 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 3784 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 3785 | |
| 3786 if (mattype.is_dense ()) | |
| 3787 { | |
| 5275 | 3788 octave_idx_type ii = 0; |
| 3789 | |
| 3790 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3791 { |
| 3792 D[j] = data(ii++); | |
| 3793 DL[j] = data(ii); | |
| 3794 ii += 2; | |
| 3795 } | |
| 3796 D[nc-1] = data(ii); | |
| 3797 } | |
| 3798 else | |
| 3799 { | |
| 3800 D[0] = 0.; | |
| 5275 | 3801 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3802 { |
| 3803 D[i+1] = 0.; | |
| 3804 DL[i] = 0.; | |
| 3805 } | |
| 3806 | |
| 5275 | 3807 for (octave_idx_type j = 0; j < nc; j++) |
| 3808 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3809 { |
| 3810 if (ridx(i) == j) | |
| 3811 D[j] = data(i); | |
| 3812 else if (ridx(i) == j + 1) | |
| 3813 DL[j] = data(i); | |
| 3814 } | |
| 3815 } | |
| 3816 | |
| 5275 | 3817 octave_idx_type b_nc = b.cols(); |
| 5164 | 3818 retval = b; |
| 3819 double *result = retval.fortran_vec (); | |
| 3820 | |
| 3821 F77_XFCN (dptsv, DPTSV, (nr, b_nc, D, DL, result, | |
| 3822 b.rows(), err)); | |
| 3823 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3824 if (err != 0) |
| 5164 | 3825 { |
| 3826 err = 0; | |
| 3827 mattype.mark_as_unsymmetric (); | |
| 5785 | 3828 typ = MatrixType::Tridiagonal; |
| 5164 | 3829 } |
| 3830 else | |
| 3831 rcond = 1.; | |
| 3832 } | |
| 3833 | |
| 5785 | 3834 if (typ == MatrixType::Tridiagonal) |
| 5164 | 3835 { |
| 3836 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 3837 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 3838 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 3839 | |
| 3840 if (mattype.is_dense ()) | |
| 3841 { | |
| 5275 | 3842 octave_idx_type ii = 0; |
| 3843 | |
| 3844 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3845 { |
| 3846 D[j] = data(ii++); | |
| 3847 DL[j] = data(ii++); | |
| 3848 DU[j] = data(ii++); | |
| 3849 } | |
| 3850 D[nc-1] = data(ii); | |
| 3851 } | |
| 3852 else | |
| 3853 { | |
| 3854 D[0] = 0.; | |
| 5275 | 3855 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3856 { |
| 3857 D[i+1] = 0.; | |
| 3858 DL[i] = 0.; | |
| 3859 DU[i] = 0.; | |
| 3860 } | |
| 3861 | |
| 5275 | 3862 for (octave_idx_type j = 0; j < nc; j++) |
| 3863 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3864 { |
| 3865 if (ridx(i) == j) | |
| 3866 D[j] = data(i); | |
| 3867 else if (ridx(i) == j + 1) | |
| 3868 DL[j] = data(i); | |
| 3869 else if (ridx(i) == j - 1) | |
| 5322 | 3870 DU[j-1] = data(i); |
| 5164 | 3871 } |
| 3872 } | |
| 3873 | |
| 5275 | 3874 octave_idx_type b_nc = b.cols(); |
| 5164 | 3875 retval = b; |
| 3876 double *result = retval.fortran_vec (); | |
| 3877 | |
| 3878 F77_XFCN (dgtsv, DGTSV, (nr, b_nc, DL, D, DU, result, | |
| 3879 b.rows(), err)); | |
| 3880 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3881 if (err != 0) |
| 5164 | 3882 { |
| 3883 rcond = 0.; | |
| 3884 err = -2; | |
| 3885 | |
| 3886 if (sing_handler) | |
| 5681 | 3887 { |
| 3888 sing_handler (rcond); | |
| 3889 mattype.mark_as_rectangular (); | |
| 3890 } | |
| 5164 | 3891 else |
| 3892 (*current_liboctave_error_handler) | |
| 3893 ("matrix singular to machine precision"); | |
| 3894 | |
| 3895 } | |
| 3896 else | |
| 3897 rcond = 1.; | |
| 3898 } | |
| 5785 | 3899 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3900 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 3901 } | |
| 3902 | |
| 3903 return retval; | |
| 3904 } | |
| 3905 | |
| 3906 SparseMatrix | |
| 5785 | 3907 SparseMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 3908 octave_idx_type& err, double& rcond, |
| 3909 solve_singularity_handler sing_handler, | |
| 3910 bool calc_cond) const | |
| 5164 | 3911 { |
| 3912 SparseMatrix retval; | |
| 3913 | |
| 5275 | 3914 octave_idx_type nr = rows (); |
| 3915 octave_idx_type nc = cols (); | |
| 5164 | 3916 err = 0; |
| 3917 | |
| 6924 | 3918 if (nr != nc || nr != b.rows ()) |
| 5164 | 3919 (*current_liboctave_error_handler) |
| 3920 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3921 else if (nr == 0 || b.cols () == 0) |
| 3922 retval = SparseMatrix (nc, b.cols ()); | |
| 5681 | 3923 else if (calc_cond) |
| 3924 (*current_liboctave_error_handler) | |
| 3925 ("calculation of condition number not implemented"); | |
| 5164 | 3926 else |
| 3927 { | |
| 3928 // Print spparms("spumoni") info if requested | |
| 3929 int typ = mattype.type (); | |
| 3930 mattype.info (); | |
| 3931 | |
| 3932 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 3933 if (typ == MatrixType::Tridiagonal || |
| 3934 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 3935 { |
| 3936 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); | |
| 3937 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 3938 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 3939 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 5275 | 3940 Array<octave_idx_type> ipvt (nr); |
| 3941 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 3942 |
| 3943 if (mattype.is_dense ()) | |
| 3944 { | |
| 5275 | 3945 octave_idx_type ii = 0; |
| 3946 | |
| 3947 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3948 { |
| 3949 D[j] = data(ii++); | |
| 3950 DL[j] = data(ii++); | |
| 3951 DU[j] = data(ii++); | |
| 3952 } | |
| 3953 D[nc-1] = data(ii); | |
| 3954 } | |
| 3955 else | |
| 3956 { | |
| 3957 D[0] = 0.; | |
| 5275 | 3958 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3959 { |
| 3960 D[i+1] = 0.; | |
| 3961 DL[i] = 0.; | |
| 3962 DU[i] = 0.; | |
| 3963 } | |
| 3964 | |
| 5275 | 3965 for (octave_idx_type j = 0; j < nc; j++) |
| 3966 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3967 { |
| 3968 if (ridx(i) == j) | |
| 3969 D[j] = data(i); | |
| 3970 else if (ridx(i) == j + 1) | |
| 3971 DL[j] = data(i); | |
| 3972 else if (ridx(i) == j - 1) | |
| 5322 | 3973 DU[j-1] = data(i); |
| 5164 | 3974 } |
| 3975 } | |
| 3976 | |
| 3977 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 3978 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3979 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3980 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3981 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3982 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3983 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3984 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3985 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3986 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3987 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3988 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3989 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3990 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3991 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3992 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3993 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3994 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3995 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3996 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3997 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3998 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
|
3999 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4000 retval = SparseMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4001 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4002 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4003 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4004 OCTAVE_LOCAL_BUFFER (double, work, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4005 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4006 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
|
4007 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4008 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
|
4009 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4010 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
|
4011 work[b.ridx(i)] = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4012 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4013 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4014 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4015 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4016 work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4017 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4018 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4019 // 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
|
4020 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4021 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4022 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
|
4023 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4024 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4025 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4026 if (ii + new_nnz > x_nz) |
| 5164 | 4027 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4028 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4029 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
|
4030 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4031 x_nz = sz; |
| 5164 | 4032 } |
| 4033 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4034 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
|
4035 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4036 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4037 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4038 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4039 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4040 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4041 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4042 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4043 retval.maybe_compress (); |
| 5164 | 4044 } |
| 4045 } | |
| 5785 | 4046 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4047 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4048 } | |
| 4049 | |
| 4050 return retval; | |
| 4051 } | |
| 4052 | |
| 4053 ComplexMatrix | |
| 5785 | 4054 SparseMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 4055 octave_idx_type& err, double& rcond, |
| 4056 solve_singularity_handler sing_handler, | |
| 4057 bool calc_cond) const | |
| 5164 | 4058 { |
| 4059 ComplexMatrix retval; | |
| 4060 | |
| 5275 | 4061 octave_idx_type nr = rows (); |
| 4062 octave_idx_type nc = cols (); | |
| 5164 | 4063 err = 0; |
| 4064 | |
| 6924 | 4065 if (nr != nc || nr != b.rows ()) |
| 5164 | 4066 (*current_liboctave_error_handler) |
| 4067 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4068 else if (nr == 0 || b.cols () == 0) |
| 4069 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5681 | 4070 else if (calc_cond) |
| 4071 (*current_liboctave_error_handler) | |
| 4072 ("calculation of condition number not implemented"); | |
| 5164 | 4073 else |
| 4074 { | |
| 4075 // Print spparms("spumoni") info if requested | |
| 4076 volatile int typ = mattype.type (); | |
| 4077 mattype.info (); | |
| 4078 | |
| 5785 | 4079 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4080 { |
| 5322 | 4081 OCTAVE_LOCAL_BUFFER (double, D, nr); |
| 5164 | 4082 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); |
| 4083 | |
| 4084 if (mattype.is_dense ()) | |
| 4085 { | |
| 5275 | 4086 octave_idx_type ii = 0; |
| 4087 | |
| 4088 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4089 { |
| 4090 D[j] = data(ii++); | |
| 4091 DL[j] = data(ii); | |
| 4092 ii += 2; | |
| 4093 } | |
| 4094 D[nc-1] = data(ii); | |
| 4095 } | |
| 4096 else | |
| 4097 { | |
| 4098 D[0] = 0.; | |
| 5275 | 4099 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4100 { |
| 4101 D[i+1] = 0.; | |
| 4102 DL[i] = 0.; | |
| 4103 } | |
| 4104 | |
| 5275 | 4105 for (octave_idx_type j = 0; j < nc; j++) |
| 4106 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4107 { |
| 4108 if (ridx(i) == j) | |
| 4109 D[j] = data(i); | |
| 4110 else if (ridx(i) == j + 1) | |
| 4111 DL[j] = data(i); | |
| 4112 } | |
| 4113 } | |
| 4114 | |
| 5275 | 4115 octave_idx_type b_nr = b.rows (); |
| 4116 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4117 rcond = 1.; |
| 4118 | |
| 4119 retval = b; | |
| 4120 Complex *result = retval.fortran_vec (); | |
| 4121 | |
| 4122 F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, | |
| 4123 b_nr, err)); | |
| 4124 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4125 if (err != 0) |
| 5164 | 4126 { |
| 4127 err = 0; | |
| 4128 mattype.mark_as_unsymmetric (); | |
| 5785 | 4129 typ = MatrixType::Tridiagonal; |
| 5164 | 4130 } |
| 4131 } | |
| 4132 | |
| 5785 | 4133 if (typ == MatrixType::Tridiagonal) |
| 5164 | 4134 { |
| 4135 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); | |
| 4136 OCTAVE_LOCAL_BUFFER (Complex, D, nr); | |
| 4137 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); | |
| 4138 | |
| 4139 if (mattype.is_dense ()) | |
| 4140 { | |
| 5275 | 4141 octave_idx_type ii = 0; |
| 4142 | |
| 4143 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4144 { |
| 4145 D[j] = data(ii++); | |
| 4146 DL[j] = data(ii++); | |
| 4147 DU[j] = data(ii++); | |
| 4148 } | |
| 4149 D[nc-1] = data(ii); | |
| 4150 } | |
| 4151 else | |
| 4152 { | |
| 4153 D[0] = 0.; | |
| 5275 | 4154 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4155 { |
| 4156 D[i+1] = 0.; | |
| 4157 DL[i] = 0.; | |
| 4158 DU[i] = 0.; | |
| 4159 } | |
| 4160 | |
| 5275 | 4161 for (octave_idx_type j = 0; j < nc; j++) |
| 4162 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4163 { |
| 4164 if (ridx(i) == j) | |
| 4165 D[j] = data(i); | |
| 4166 else if (ridx(i) == j + 1) | |
| 4167 DL[j] = data(i); | |
| 4168 else if (ridx(i) == j - 1) | |
| 5322 | 4169 DU[j-1] = data(i); |
| 5164 | 4170 } |
| 4171 } | |
| 4172 | |
| 5275 | 4173 octave_idx_type b_nr = b.rows(); |
| 4174 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4175 rcond = 1.; |
| 4176 | |
| 4177 retval = b; | |
| 4178 Complex *result = retval.fortran_vec (); | |
| 4179 | |
| 4180 F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, | |
| 4181 b_nr, err)); | |
| 4182 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4183 if (err != 0) |
| 5164 | 4184 { |
| 4185 rcond = 0.; | |
| 4186 err = -2; | |
| 4187 | |
| 4188 if (sing_handler) | |
| 5681 | 4189 { |
| 4190 sing_handler (rcond); | |
| 4191 mattype.mark_as_rectangular (); | |
| 4192 } | |
| 5164 | 4193 else |
| 4194 (*current_liboctave_error_handler) | |
| 4195 ("matrix singular to machine precision"); | |
| 4196 } | |
| 4197 } | |
| 5785 | 4198 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4199 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4200 } | |
| 4201 | |
| 4202 return retval; | |
| 4203 } | |
| 4204 | |
| 4205 SparseComplexMatrix | |
| 5785 | 4206 SparseMatrix::trisolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5681 | 4207 octave_idx_type& err, double& rcond, |
| 4208 solve_singularity_handler sing_handler, | |
| 4209 bool calc_cond) const | |
| 5164 | 4210 { |
| 4211 SparseComplexMatrix retval; | |
| 4212 | |
| 5275 | 4213 octave_idx_type nr = rows (); |
| 4214 octave_idx_type nc = cols (); | |
| 5164 | 4215 err = 0; |
| 4216 | |
| 6924 | 4217 if (nr != nc || nr != b.rows ()) |
| 5164 | 4218 (*current_liboctave_error_handler) |
| 4219 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4220 else if (nr == 0 || b.cols () == 0) |
| 4221 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5681 | 4222 else if (calc_cond) |
| 4223 (*current_liboctave_error_handler) | |
| 4224 ("calculation of condition number not implemented"); | |
| 5164 | 4225 else |
| 4226 { | |
| 4227 // Print spparms("spumoni") info if requested | |
| 4228 int typ = mattype.type (); | |
| 4229 mattype.info (); | |
| 4230 | |
| 4231 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 4232 if (typ == MatrixType::Tridiagonal || |
| 4233 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 4234 { |
| 4235 OCTAVE_LOCAL_BUFFER (double, DU2, nr - 2); | |
| 4236 OCTAVE_LOCAL_BUFFER (double, DU, nr - 1); | |
| 4237 OCTAVE_LOCAL_BUFFER (double, D, nr); | |
| 4238 OCTAVE_LOCAL_BUFFER (double, DL, nr - 1); | |
| 5275 | 4239 Array<octave_idx_type> ipvt (nr); |
| 4240 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4241 |
| 4242 if (mattype.is_dense ()) | |
| 4243 { | |
| 5275 | 4244 octave_idx_type ii = 0; |
| 4245 | |
| 4246 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4247 { |
| 4248 D[j] = data(ii++); | |
| 4249 DL[j] = data(ii++); | |
| 4250 DU[j] = data(ii++); | |
| 4251 } | |
| 4252 D[nc-1] = data(ii); | |
| 4253 } | |
| 4254 else | |
| 4255 { | |
| 4256 D[0] = 0.; | |
| 5275 | 4257 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4258 { |
| 4259 D[i+1] = 0.; | |
| 4260 DL[i] = 0.; | |
| 4261 DU[i] = 0.; | |
| 4262 } | |
| 4263 | |
| 5275 | 4264 for (octave_idx_type j = 0; j < nc; j++) |
| 4265 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4266 { |
| 4267 if (ridx(i) == j) | |
| 4268 D[j] = data(i); | |
| 4269 else if (ridx(i) == j + 1) | |
| 4270 DL[j] = data(i); | |
| 4271 else if (ridx(i) == j - 1) | |
| 5322 | 4272 DU[j-1] = data(i); |
| 5164 | 4273 } |
| 4274 } | |
| 4275 | |
| 4276 F77_XFCN (dgttrf, DGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 4277 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4278 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4279 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4280 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4281 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4282 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4283 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4284 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4285 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4286 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4287 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4288 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4289 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4290 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4291 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4292 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4293 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4294 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4295 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4296 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4297 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4298 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4299 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4300 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4301 // 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
|
4302 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4303 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
|
4304 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4305 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
|
4306 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4307 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4308 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
|
4309 { |
|
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 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5681 | 4312 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4313 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4314 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4315 Bz[i] = std::imag (c); |
| 5681 | 4316 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4317 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4318 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4319 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4320 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4321 Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4322 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4323 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4324 if (err != 0) |
| 5164 | 4325 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4326 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4327 ("SparseMatrix::solve solve failed"); |
|
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 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4330 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4331 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4332 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4333 F77_XFCN (dgttrs, DGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4334 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4335 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4336 Bz, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4337 F77_CHAR_ARG_LEN (1))); |
|
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 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4340 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4341 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4342 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4343 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4344 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4345 break; |
| 5164 | 4346 } |
| 4347 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4348 // 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
|
4349 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4350 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4351 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
|
4352 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4353 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4354 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4355 if (ii + new_nnz > x_nz) |
|
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 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4358 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
|
4359 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4360 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4361 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4362 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4363 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
|
4364 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4365 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4366 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4367 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4368 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4369 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4370 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4371 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4372 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4373 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4374 retval.maybe_compress (); |
| 5164 | 4375 } |
| 4376 } | |
| 5785 | 4377 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4378 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4379 } | |
| 4380 | |
| 4381 return retval; | |
| 4382 } | |
| 4383 | |
| 4384 Matrix | |
| 5785 | 4385 SparseMatrix::bsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 4386 octave_idx_type& err, double& rcond, |
| 4387 solve_singularity_handler sing_handler, | |
| 4388 bool calc_cond) const | |
| 5164 | 4389 { |
| 4390 Matrix retval; | |
| 4391 | |
| 5275 | 4392 octave_idx_type nr = rows (); |
| 4393 octave_idx_type nc = cols (); | |
| 5164 | 4394 err = 0; |
| 4395 | |
| 6924 | 4396 if (nr != nc || nr != b.rows ()) |
| 5164 | 4397 (*current_liboctave_error_handler) |
| 4398 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4399 else if (nr == 0 || b.cols () == 0) |
| 4400 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 4401 else |
| 4402 { | |
| 4403 // Print spparms("spumoni") info if requested | |
| 4404 volatile int typ = mattype.type (); | |
| 4405 mattype.info (); | |
| 4406 | |
| 5785 | 4407 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4408 { |
| 5275 | 4409 octave_idx_type n_lower = mattype.nlower (); |
| 4410 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4411 Matrix m_band (ldm, nc); |
| 4412 double *tmp_data = m_band.fortran_vec (); | |
| 4413 | |
| 4414 if (! mattype.is_dense ()) | |
| 4415 { | |
| 5275 | 4416 octave_idx_type ii = 0; |
| 4417 | |
| 4418 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4419 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4420 tmp_data[ii++] = 0.; |
| 4421 } | |
| 4422 | |
| 5275 | 4423 for (octave_idx_type j = 0; j < nc; j++) |
| 4424 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4425 { |
| 5275 | 4426 octave_idx_type ri = ridx (i); |
| 5164 | 4427 if (ri >= j) |
| 4428 m_band(ri - j, j) = data(i); | |
| 4429 } | |
| 4430 | |
| 4431 // Calculate the norm of the matrix, for later use. | |
| 5681 | 4432 double anorm; |
| 4433 if (calc_cond) | |
| 4434 anorm = m_band.abs().sum().row(0).max(); | |
| 5164 | 4435 |
| 4436 char job = 'L'; | |
| 4437 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4438 nr, n_lower, tmp_data, ldm, err | |
| 4439 F77_CHAR_ARG_LEN (1))); | |
| 4440 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4441 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4442 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4443 // 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
|
4444 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4445 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4446 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4447 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4448 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4449 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4450 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4451 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4452 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4453 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4454 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4455 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4456 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4457 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4458 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4459 F77_XFCN (dpbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4460 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4461 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4462 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4463 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4464 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4465 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4466 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4467 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4468 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
|
4469 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4470 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4471 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4472 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4473 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4474 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4475 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4476 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4477 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4478 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4479 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4480 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4481 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4482 rcond); |
| 5681 | 4483 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4484 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4485 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4486 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4487 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4488 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4489 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4490 retval = b; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4491 double *result = retval.fortran_vec (); |
|
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 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4494 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4495 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4496 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4497 nr, n_lower, b_nc, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4498 ldm, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4499 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4500 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4501 if (err != 0) |
| 5681 | 4502 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4503 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4504 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4505 err = -1; |
| 5164 | 4506 } |
| 4507 } | |
| 4508 } | |
| 4509 } | |
| 4510 | |
| 5785 | 4511 if (typ == MatrixType::Banded) |
| 5164 | 4512 { |
| 4513 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 4514 octave_idx_type n_upper = mattype.nupper (); |
| 4515 octave_idx_type n_lower = mattype.nlower (); | |
| 4516 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4517 |
| 4518 Matrix m_band (ldm, nc); | |
| 4519 double *tmp_data = m_band.fortran_vec (); | |
| 4520 | |
| 4521 if (! mattype.is_dense ()) | |
| 4522 { | |
| 5275 | 4523 octave_idx_type ii = 0; |
| 4524 | |
| 4525 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4526 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4527 tmp_data[ii++] = 0.; |
| 4528 } | |
| 4529 | |
| 5275 | 4530 for (octave_idx_type j = 0; j < nc; j++) |
| 4531 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4532 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4533 | |
| 5681 | 4534 // Calculate the norm of the matrix, for later use. |
| 4535 double anorm; | |
| 4536 if (calc_cond) | |
| 4537 { | |
| 4538 for (octave_idx_type j = 0; j < nr; j++) | |
| 4539 { | |
| 4540 double atmp = 0.; | |
| 4541 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4542 atmp += fabs(data(i)); | |
| 4543 if (atmp > anorm) | |
| 4544 anorm = atmp; | |
| 4545 } | |
| 4546 } | |
| 4547 | |
| 5275 | 4548 Array<octave_idx_type> ipvt (nr); |
| 4549 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4550 |
| 4551 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 4552 ldm, pipvt, err)); | |
| 4553 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4554 // 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
|
4555 // change output. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4556 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4557 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4558 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4559 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4560 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4561 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4562 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4563 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4564 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4565 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4566 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4567 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4568 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4569 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4570 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4571 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4572 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4573 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4574 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4575 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4576 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4577 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4578 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4579 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4580 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4581 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4582 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4583 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
|
4584 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4585 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4586 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4587 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4588 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4589 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4590 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
|
4591 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4592 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4593 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4594 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4595 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4596 if (sing_handler) |
|
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 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4599 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4602 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4603 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4604 rcond); |
| 5681 | 4605 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4606 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4607 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4608 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4609 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4610 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4611 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4612 retval = b; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4613 double *result = retval.fortran_vec (); |
|
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 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4616 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4617 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4618 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4619 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4620 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
|
4621 ldm, pipvt, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4622 F77_CHAR_ARG_LEN (1))); |
| 5164 | 4623 } |
| 4624 } | |
| 4625 } | |
| 5785 | 4626 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 4627 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4628 } | |
| 4629 | |
| 4630 return retval; | |
| 4631 } | |
| 4632 | |
| 4633 SparseMatrix | |
| 5785 | 4634 SparseMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 4635 octave_idx_type& err, double& rcond, |
| 4636 solve_singularity_handler sing_handler, | |
| 4637 bool calc_cond) const | |
| 5164 | 4638 { |
| 4639 SparseMatrix retval; | |
| 4640 | |
| 5275 | 4641 octave_idx_type nr = rows (); |
| 4642 octave_idx_type nc = cols (); | |
| 5164 | 4643 err = 0; |
| 4644 | |
| 6924 | 4645 if (nr != nc || nr != b.rows ()) |
| 5164 | 4646 (*current_liboctave_error_handler) |
| 4647 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4648 else if (nr == 0 || b.cols () == 0) |
| 4649 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 4650 else |
| 4651 { | |
| 4652 // Print spparms("spumoni") info if requested | |
| 4653 volatile int typ = mattype.type (); | |
| 4654 mattype.info (); | |
| 4655 | |
| 5785 | 4656 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4657 { |
| 6242 | 4658 octave_idx_type n_lower = mattype.nlower (); |
| 4659 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4660 |
| 4661 Matrix m_band (ldm, nc); | |
| 4662 double *tmp_data = m_band.fortran_vec (); | |
| 4663 | |
| 4664 if (! mattype.is_dense ()) | |
| 4665 { | |
| 5275 | 4666 octave_idx_type ii = 0; |
| 4667 | |
| 4668 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4669 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4670 tmp_data[ii++] = 0.; |
| 4671 } | |
| 4672 | |
| 5275 | 4673 for (octave_idx_type j = 0; j < nc; j++) |
| 4674 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4675 { |
| 5275 | 4676 octave_idx_type ri = ridx (i); |
| 5164 | 4677 if (ri >= j) |
| 4678 m_band(ri - j, j) = data(i); | |
| 4679 } | |
| 4680 | |
| 5681 | 4681 // Calculate the norm of the matrix, for later use. |
| 4682 double anorm; | |
| 4683 if (calc_cond) | |
| 4684 anorm = m_band.abs().sum().row(0).max(); | |
| 4685 | |
| 5164 | 4686 char job = 'L'; |
| 4687 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4688 nr, n_lower, tmp_data, ldm, err | |
| 4689 F77_CHAR_ARG_LEN (1))); | |
| 4690 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4691 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4692 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4693 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4694 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4695 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4696 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4697 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4698 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4699 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4700 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4701 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4702 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4703 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4704 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4705 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4706 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4707 F77_XFCN (dpbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4708 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4709 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4710 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4711 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4712 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4713 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4714 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4715 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4716 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
|
4717 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4718 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4719 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4720 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4721 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4722 if (sing_handler) |
| 5681 | 4723 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4724 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4725 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4726 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4727 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4728 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4729 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4730 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4731 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4732 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4733 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4734 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4735 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4736 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4737 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4738 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4739 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4740 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4741 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4742 // 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
|
4743 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4744 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
|
4745 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4746 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
|
4747 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4748 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4749 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
|
4750 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4751 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
|
4752 Bx[i] = b.elem (i, j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4753 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4754 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4755 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4756 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4757 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4758 F77_CHAR_ARG_LEN (1))); |
|
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 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4761 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4762 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4763 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4764 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4765 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4766 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4767 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4768 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
|
4769 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4770 double tmp = Bx[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4771 if (tmp != 0.0) |
| 5681 | 4772 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4773 if (ii == x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4774 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4775 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4776 octave_idx_type sz = x_nz * |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4777 (b_nc - j) / b_nc; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4778 sz = (sz > 10 ? sz : 10) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4779 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4780 x_nz = sz; |
|
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 retval.xdata(ii) = tmp; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4783 retval.xridx(ii++) = i; |
| 5681 | 4784 } |
| 5164 | 4785 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4786 retval.xcidx(j+1) = ii; |
| 5164 | 4787 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4788 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4789 retval.maybe_compress (); |
| 5164 | 4790 } |
| 4791 } | |
| 4792 } | |
| 4793 | |
| 5785 | 4794 if (typ == MatrixType::Banded) |
| 5164 | 4795 { |
| 4796 // Create the storage for the banded form of the sparse matrix | |
| 5275 | 4797 octave_idx_type n_upper = mattype.nupper (); |
| 4798 octave_idx_type n_lower = mattype.nlower (); | |
| 4799 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4800 |
| 4801 Matrix m_band (ldm, nc); | |
| 4802 double *tmp_data = m_band.fortran_vec (); | |
| 4803 | |
| 4804 if (! mattype.is_dense ()) | |
| 4805 { | |
| 5275 | 4806 octave_idx_type ii = 0; |
| 4807 | |
| 4808 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4809 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4810 tmp_data[ii++] = 0.; |
| 4811 } | |
| 4812 | |
| 5275 | 4813 for (octave_idx_type j = 0; j < nc; j++) |
| 4814 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4815 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4816 | |
| 5681 | 4817 // Calculate the norm of the matrix, for later use. |
| 4818 double anorm; | |
| 4819 if (calc_cond) | |
| 4820 { | |
| 4821 for (octave_idx_type j = 0; j < nr; j++) | |
| 4822 { | |
| 4823 double atmp = 0.; | |
| 4824 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4825 atmp += fabs(data(i)); | |
| 4826 if (atmp > anorm) | |
| 4827 anorm = atmp; | |
| 4828 } | |
| 4829 } | |
| 4830 | |
| 5275 | 4831 Array<octave_idx_type> ipvt (nr); |
| 4832 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4833 |
| 4834 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 4835 ldm, pipvt, err)); | |
| 4836 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4837 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4838 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4839 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4840 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4841 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4842 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4843 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4844 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4845 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4846 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4847 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4848 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4849 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4850 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4851 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4852 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4853 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4854 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4855 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4856 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4857 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4858 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4859 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4860 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4861 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4862 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4863 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4864 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
|
4865 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4866 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4867 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4868 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4869 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4870 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4871 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
|
4872 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4873 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4874 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4875 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4876 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4877 if (sing_handler) |
|
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 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4880 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4883 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4884 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4885 rcond); |
| 5681 | 4886 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4887 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4888 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4889 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4890 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4891 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4892 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4893 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4894 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
|
4895 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4896 retval = SparseMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4897 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4898 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4899 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4900 OCTAVE_LOCAL_BUFFER (double, work, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4901 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4902 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 4903 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4904 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
|
4905 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4906 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
|
4907 i < b.cidx(j+1); i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4908 work[b.ridx(i)] = b.data(i); |
|
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 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4911 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4912 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
|
4913 ldm, pipvt, work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4914 F77_CHAR_ARG_LEN (1))); |
|
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 // 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
|
4917 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4918 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4919 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
|
4920 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4921 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4922 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4923 if (ii + new_nnz > x_nz) |
| 5164 | 4924 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4925 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4926 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
|
4927 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4928 x_nz = sz; |
| 5164 | 4929 } |
| 4930 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4931 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
|
4932 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4933 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4934 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4935 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4936 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4937 retval.xcidx(j+1) = ii; |
| 5164 | 4938 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4939 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4940 retval.maybe_compress (); |
| 5164 | 4941 } |
| 4942 } | |
| 4943 } | |
| 5785 | 4944 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 4945 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4946 } | |
| 4947 | |
| 4948 return retval; | |
| 4949 } | |
| 4950 | |
| 4951 ComplexMatrix | |
| 5785 | 4952 SparseMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 4953 octave_idx_type& err, double& rcond, |
| 4954 solve_singularity_handler sing_handler, | |
| 4955 bool calc_cond) const | |
| 5164 | 4956 { |
| 4957 ComplexMatrix retval; | |
| 4958 | |
| 5275 | 4959 octave_idx_type nr = rows (); |
| 4960 octave_idx_type nc = cols (); | |
| 5164 | 4961 err = 0; |
| 4962 | |
| 6924 | 4963 if (nr != nc || nr != b.rows ()) |
| 5164 | 4964 (*current_liboctave_error_handler) |
| 4965 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4966 else if (nr == 0 || b.cols () == 0) |
| 4967 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 4968 else |
| 4969 { | |
| 4970 // Print spparms("spumoni") info if requested | |
| 4971 volatile int typ = mattype.type (); | |
| 4972 mattype.info (); | |
| 4973 | |
| 5785 | 4974 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4975 { |
| 5275 | 4976 octave_idx_type n_lower = mattype.nlower (); |
| 4977 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4978 |
| 4979 Matrix m_band (ldm, nc); | |
| 4980 double *tmp_data = m_band.fortran_vec (); | |
| 4981 | |
| 4982 if (! mattype.is_dense ()) | |
| 4983 { | |
| 5275 | 4984 octave_idx_type ii = 0; |
| 4985 | |
| 4986 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4987 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4988 tmp_data[ii++] = 0.; |
| 4989 } | |
| 4990 | |
| 5275 | 4991 for (octave_idx_type j = 0; j < nc; j++) |
| 4992 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4993 { |
| 5275 | 4994 octave_idx_type ri = ridx (i); |
| 5164 | 4995 if (ri >= j) |
| 4996 m_band(ri - j, j) = data(i); | |
| 4997 } | |
| 4998 | |
| 5681 | 4999 // Calculate the norm of the matrix, for later use. |
| 5000 double anorm; | |
| 5001 if (calc_cond) | |
| 5002 anorm = m_band.abs().sum().row(0).max(); | |
| 5003 | |
| 5164 | 5004 char job = 'L'; |
| 5005 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 5006 nr, n_lower, tmp_data, ldm, err | |
| 5007 F77_CHAR_ARG_LEN (1))); | |
| 5008 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5009 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5010 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5011 // 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
|
5012 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5013 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5014 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5015 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5016 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5017 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5018 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5019 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5020 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5021 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5022 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5023 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5024 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5025 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5026 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5027 F77_XFCN (dpbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5028 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5029 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5030 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5031 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5032 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5033 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5034 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5035 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5036 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
|
5037 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5038 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5039 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5040 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5041 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5042 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5043 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5044 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5045 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5046 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5047 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5048 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5049 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5050 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5051 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5052 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5053 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5054 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5055 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5056 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5057 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5058 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5059 octave_idx_type b_nc = b.cols (); |
|
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 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5062 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
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 retval.resize (b_nr, b_nc); |
|
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 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
|
5067 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5068 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 5069 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5070 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5071 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5072 Bz[i] = std::imag (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5073 } |
|
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 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5076 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5077 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5078 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5079 F77_CHAR_ARG_LEN (1))); |
|
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 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5082 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5083 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5084 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5085 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5086 break; |
| 5164 | 5087 } |
|
7482
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 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5090 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5091 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5092 ldm, Bz, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5093 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5094 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5095 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5096 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5097 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5098 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5099 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5100 break; |
|
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 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
|
5104 retval (i, j) = Complex (Bx[i], Bz[i]); |
| 5164 | 5105 } |
| 5106 } | |
| 5107 } | |
| 5108 } | |
| 5109 | |
| 5785 | 5110 if (typ == MatrixType::Banded) |
| 5164 | 5111 { |
| 5112 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 5113 octave_idx_type n_upper = mattype.nupper (); |
| 5114 octave_idx_type n_lower = mattype.nlower (); | |
| 5115 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 5116 |
| 5117 Matrix m_band (ldm, nc); | |
| 5118 double *tmp_data = m_band.fortran_vec (); | |
| 5119 | |
| 5120 if (! mattype.is_dense ()) | |
| 5121 { | |
| 5275 | 5122 octave_idx_type ii = 0; |
| 5123 | |
| 5124 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5125 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5126 tmp_data[ii++] = 0.; |
| 5127 } | |
| 5128 | |
| 5275 | 5129 for (octave_idx_type j = 0; j < nc; j++) |
| 5130 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5131 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5132 | |
| 5681 | 5133 // Calculate the norm of the matrix, for later use. |
| 5134 double anorm; | |
| 5135 if (calc_cond) | |
| 5136 { | |
| 5137 for (octave_idx_type j = 0; j < nr; j++) | |
| 5138 { | |
| 5139 double atmp = 0.; | |
| 5140 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5141 atmp += fabs(data(i)); | |
| 5142 if (atmp > anorm) | |
| 5143 anorm = atmp; | |
| 5144 } | |
| 5145 } | |
| 5146 | |
| 5275 | 5147 Array<octave_idx_type> ipvt (nr); |
| 5148 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5149 |
| 5150 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5151 ldm, pipvt, err)); | |
| 5152 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5153 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5154 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5155 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5156 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5157 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5158 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5159 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5160 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5161 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5162 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5163 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5164 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5165 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5166 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5167 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5168 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5169 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5170 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5171 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5172 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5173 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5174 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5175 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5176 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5177 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5178 F77_XFCN (dpbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5179 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5180 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5181 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5182 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5183 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5184 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5185 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5186 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5187 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
|
5188 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5189 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 5190 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5191 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5192 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5193 if (sing_handler) |
|
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 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5196 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5199 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5200 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5201 rcond); |
| 5681 | 5202 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5203 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5204 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5205 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5206 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5207 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5208 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5209 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5210 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5211 retval.resize (nr,b_nc); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5212 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5213 OCTAVE_LOCAL_BUFFER (double, Bz, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5214 OCTAVE_LOCAL_BUFFER (double, Bx, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5215 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5216 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 5217 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5218 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 5219 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5220 Complex c = b (i, j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5221 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5222 Bz[i] = std::imag (c); |
| 5164 | 5223 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5224 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5225 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5226 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5227 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
|
5228 ldm, pipvt, Bx, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5229 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5230 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5231 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5232 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5233 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
|
5234 ldm, pipvt, Bz, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5235 F77_CHAR_ARG_LEN (1))); |
|
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 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
|
5238 retval (i, j) = Complex (Bx[i], Bz[i]); |
| 5164 | 5239 } |
| 5240 } | |
| 5241 } | |
| 5242 } | |
| 5785 | 5243 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5244 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5245 } | |
| 5246 | |
| 5247 return retval; | |
| 5248 } | |
| 5249 | |
| 5250 SparseComplexMatrix | |
| 5785 | 5251 SparseMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5681 | 5252 octave_idx_type& err, double& rcond, |
| 5253 solve_singularity_handler sing_handler, | |
| 5254 bool calc_cond) const | |
| 5164 | 5255 { |
| 5256 SparseComplexMatrix retval; | |
| 5257 | |
| 5275 | 5258 octave_idx_type nr = rows (); |
| 5259 octave_idx_type nc = cols (); | |
| 5164 | 5260 err = 0; |
| 5261 | |
| 6924 | 5262 if (nr != nc || nr != b.rows ()) |
| 5164 | 5263 (*current_liboctave_error_handler) |
| 5264 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5265 else if (nr == 0 || b.cols () == 0) |
| 5266 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 5267 else |
| 5268 { | |
| 5269 // Print spparms("spumoni") info if requested | |
| 5270 volatile int typ = mattype.type (); | |
| 5271 mattype.info (); | |
| 5272 | |
| 5785 | 5273 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 5274 { |
| 6242 | 5275 octave_idx_type n_lower = mattype.nlower (); |
| 5276 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 5277 |
| 5278 Matrix m_band (ldm, nc); | |
| 5279 double *tmp_data = m_band.fortran_vec (); | |
| 5280 | |
| 5281 if (! mattype.is_dense ()) | |
| 5282 { | |
| 5275 | 5283 octave_idx_type ii = 0; |
| 5284 | |
| 5285 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5286 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5287 tmp_data[ii++] = 0.; |
| 5288 } | |
| 5289 | |
| 5275 | 5290 for (octave_idx_type j = 0; j < nc; j++) |
| 5291 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5292 { |
| 5275 | 5293 octave_idx_type ri = ridx (i); |
| 5164 | 5294 if (ri >= j) |
| 5295 m_band(ri - j, j) = data(i); | |
| 5296 } | |
| 5297 | |
| 5681 | 5298 // Calculate the norm of the matrix, for later use. |
| 5299 double anorm; | |
| 5300 if (calc_cond) | |
| 5301 anorm = m_band.abs().sum().row(0).max(); | |
| 5302 | |
| 5164 | 5303 char job = 'L'; |
| 5304 F77_XFCN (dpbtrf, DPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 5305 nr, n_lower, tmp_data, ldm, err | |
| 5306 F77_CHAR_ARG_LEN (1))); | |
| 5307 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5308 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5309 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5310 // 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
|
5311 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5312 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5313 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5314 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5315 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5316 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5317 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5318 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5319 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5320 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5321 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5322 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5323 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5324 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5325 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5326 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5327 F77_XFCN (dpbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5328 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5329 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5330 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5331 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5332 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5333 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5334 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5335 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5336 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
|
5337 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5338 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 5339 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5340 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5341 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5342 if (sing_handler) |
| 5164 | 5343 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5344 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5345 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5346 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5347 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5348 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5349 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5350 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5351 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5352 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5353 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5354 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5355 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5356 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5357 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5358 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5359 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5360 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5361 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5362 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5363 // 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
|
5364 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5365 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
|
5366 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5367 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
|
5368 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5369 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5370 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
|
5371 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5372 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5373 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
|
5374 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5375 Complex c = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5376 Bx[i] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5377 Bz[i] = std::imag (c); |
| 5164 | 5378 } |
| 5379 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5380 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5381 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5382 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5383 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5384 F77_CHAR_ARG_LEN (1))); |
|
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 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5387 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5388 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5389 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5390 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5391 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5392 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5393 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5394 F77_XFCN (dpbtrs, DPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5395 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5396 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5397 ldm, Bz, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5398 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5399 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5400 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5401 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5402 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5403 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5404 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5405 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5406 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5407 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5408 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5409 // 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
|
5410 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5411 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5412 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
|
5413 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5414 new_nnz++; |
|
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 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5417 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5418 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5419 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
|
5420 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5421 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5422 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5423 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5424 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
|
5425 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5426 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5427 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5428 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5429 Complex (Bx[i], Bz[i]); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5430 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5431 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5432 retval.xcidx(j+1) = ii; |
| 5164 | 5433 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5434 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5435 retval.maybe_compress (); |
| 5164 | 5436 } |
| 5437 } | |
| 5438 } | |
| 5439 | |
| 5785 | 5440 if (typ == MatrixType::Banded) |
| 5164 | 5441 { |
| 5442 // Create the storage for the banded form of the sparse matrix | |
| 6242 | 5443 octave_idx_type n_upper = mattype.nupper (); |
| 5444 octave_idx_type n_lower = mattype.nlower (); | |
| 5445 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 5446 |
| 5447 Matrix m_band (ldm, nc); | |
| 5448 double *tmp_data = m_band.fortran_vec (); | |
| 5449 | |
| 5450 if (! mattype.is_dense ()) | |
| 5451 { | |
| 5275 | 5452 octave_idx_type ii = 0; |
| 5453 | |
| 5454 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5455 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5456 tmp_data[ii++] = 0.; |
| 5457 } | |
| 5458 | |
| 5275 | 5459 for (octave_idx_type j = 0; j < nc; j++) |
| 5460 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5461 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5462 | |
| 5681 | 5463 // Calculate the norm of the matrix, for later use. |
| 5464 double anorm; | |
| 5465 if (calc_cond) | |
| 5466 { | |
| 5467 for (octave_idx_type j = 0; j < nr; j++) | |
| 5468 { | |
| 5469 double atmp = 0.; | |
| 5470 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5471 atmp += fabs(data(i)); | |
| 5472 if (atmp > anorm) | |
| 5473 anorm = atmp; | |
| 5474 } | |
| 5475 } | |
| 5476 | |
| 5275 | 5477 Array<octave_idx_type> ipvt (nr); |
| 5478 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5479 |
| 5480 F77_XFCN (dgbtrf, DGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5481 ldm, pipvt, err)); | |
| 5482 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5483 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5484 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5485 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5486 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5487 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5488 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5489 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5490 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5491 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5492 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5493 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5494 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5495 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5496 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5497 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5498 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5499 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5500 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5501 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5502 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5503 Array<double> z (3 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5504 double *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5505 Array<octave_idx_type> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5506 octave_idx_type *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5507 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5508 F77_XFCN (dgbcon, DGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5509 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5510 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
|
5511 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5512 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5513 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5514 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5515 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5516 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5517 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
|
5518 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5519 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5520 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5521 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5522 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5523 if (sing_handler) |
|
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 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5526 mattype.mark_as_rectangular (); |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5529 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5530 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5531 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5532 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5533 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5534 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5535 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5536 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5537 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5538 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5539 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5540 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
|
5541 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5542 retval = SparseComplexMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5543 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5544 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5545 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5546 OCTAVE_LOCAL_BUFFER (double, Bx, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5547 OCTAVE_LOCAL_BUFFER (double, Bz, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5548 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5549 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
|
5550 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5551 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
|
5552 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5553 Bx[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5554 Bz[i] = 0.; |
|
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 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
|
5557 i < b.cidx(j+1); i++) |
| 5164 | 5558 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5559 Complex c = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5560 Bx[b.ridx(i)] = std::real (c); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5561 Bz[b.ridx(i)] = std::imag (c); |
| 5164 | 5562 } |
| 5563 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5564 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5565 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5566 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
|
5567 ldm, pipvt, Bx, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5568 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5569 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5570 F77_XFCN (dgbtrs, DGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5571 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5572 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
|
5573 ldm, pipvt, Bz, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5574 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5575 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5576 // 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
|
5577 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5578 octave_idx_type new_nnz = 0; |
|
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 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5581 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5582 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5583 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5584 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5585 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5586 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
|
5587 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5588 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5589 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5590 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5591 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
|
5592 if (Bx[i] != 0. || Bz[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5593 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5594 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5595 retval.xdata(ii++) = |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5596 Complex (Bx[i], Bz[i]); |
|
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 retval.xcidx(j+1) = ii; |
| 5164 | 5599 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5600 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5601 retval.maybe_compress (); |
| 5164 | 5602 } |
| 5603 } | |
| 5604 } | |
| 5785 | 5605 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5606 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5607 } | |
| 5608 | |
| 5609 return retval; | |
| 5610 } | |
| 5611 | |
| 5612 void * | |
| 5681 | 5613 SparseMatrix::factorize (octave_idx_type& err, double &rcond, Matrix &Control, |
| 5614 Matrix &Info, solve_singularity_handler sing_handler, | |
| 5615 bool calc_cond) const | |
| 5164 | 5616 { |
| 5617 // The return values | |
| 5404 | 5618 void *Numeric = 0; |
| 5164 | 5619 err = 0; |
| 5620 | |
| 5203 | 5621 #ifdef HAVE_UMFPACK |
| 5164 | 5622 // Setup the control parameters |
| 5623 Control = Matrix (UMFPACK_CONTROL, 1); | |
| 5624 double *control = Control.fortran_vec (); | |
| 5322 | 5625 UMFPACK_DNAME (defaults) (control); |
| 5164 | 5626 |
| 5893 | 5627 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 5628 if (!xisnan (tmp)) |
| 5629 Control (UMFPACK_PRL) = tmp; | |
| 5893 | 5630 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 5631 if (!xisnan (tmp)) |
| 5632 { | |
| 5633 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 5634 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 5635 } | |
| 5636 | |
| 5637 // Set whether we are allowed to modify Q or not | |
| 5893 | 5638 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 5639 if (!xisnan (tmp)) |
| 5640 Control (UMFPACK_FIXQ) = tmp; | |
| 5641 | |
| 5322 | 5642 UMFPACK_DNAME (report_control) (control); |
| 5164 | 5643 |
| 5275 | 5644 const octave_idx_type *Ap = cidx (); |
| 5645 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5646 const double *Ax = data (); |
| 5275 | 5647 octave_idx_type nr = rows (); |
| 5648 octave_idx_type nc = cols (); | |
| 5164 | 5649 |
| 5322 | 5650 UMFPACK_DNAME (report_matrix) (nr, nc, Ap, Ai, Ax, 1, control); |
| 5164 | 5651 |
| 5652 void *Symbolic; | |
| 5653 Info = Matrix (1, UMFPACK_INFO); | |
| 5654 double *info = Info.fortran_vec (); | |
| 5322 | 5655 int status = UMFPACK_DNAME (qsymbolic) (nr, nc, Ap, Ai, Ax, NULL, |
| 5164 | 5656 &Symbolic, control, info); |
| 5657 | |
| 5658 if (status < 0) | |
| 5659 { | |
| 5660 (*current_liboctave_error_handler) | |
| 5661 ("SparseMatrix::solve symbolic factorization failed"); | |
| 5662 err = -1; | |
| 5663 | |
| 5322 | 5664 UMFPACK_DNAME (report_status) (control, status); |
| 5665 UMFPACK_DNAME (report_info) (control, info); | |
| 5666 | |
| 5667 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 5668 } |
| 5669 else | |
| 5670 { | |
| 5322 | 5671 UMFPACK_DNAME (report_symbolic) (Symbolic, control); |
| 5672 | |
| 5673 status = UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, | |
| 5674 &Numeric, control, info) ; | |
| 5675 UMFPACK_DNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 5676 |
| 5681 | 5677 if (calc_cond) |
| 5678 rcond = Info (UMFPACK_RCOND); | |
| 5679 else | |
| 5680 rcond = 1.; | |
| 5164 | 5681 volatile double rcond_plus_one = rcond + 1.0; |
| 5682 | |
| 5683 if (status == UMFPACK_WARNING_singular_matrix || | |
| 5684 rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5685 { | |
| 5322 | 5686 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 5687 |
| 5688 err = -2; | |
| 5689 | |
| 5690 if (sing_handler) | |
| 5691 sing_handler (rcond); | |
| 5692 else | |
| 5693 (*current_liboctave_error_handler) | |
| 5694 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5695 rcond); | |
| 5696 | |
| 5697 } | |
| 5610 | 5698 else if (status < 0) |
| 5164 | 5699 { |
| 5700 (*current_liboctave_error_handler) | |
| 5701 ("SparseMatrix::solve numeric factorization failed"); | |
| 5702 | |
| 5322 | 5703 UMFPACK_DNAME (report_status) (control, status); |
| 5704 UMFPACK_DNAME (report_info) (control, info); | |
| 5164 | 5705 |
| 5706 err = -1; | |
| 5707 } | |
| 5708 else | |
| 5709 { | |
| 5322 | 5710 UMFPACK_DNAME (report_numeric) (Numeric, control); |
| 5164 | 5711 } |
| 5712 } | |
| 5713 | |
| 5714 if (err != 0) | |
| 5322 | 5715 UMFPACK_DNAME (free_numeric) (&Numeric); |
| 5164 | 5716 |
| 5203 | 5717 #else |
| 5718 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 5719 #endif | |
| 5720 | |
| 5164 | 5721 return Numeric; |
| 5722 } | |
| 5723 | |
| 5724 Matrix | |
| 5785 | 5725 SparseMatrix::fsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 5726 octave_idx_type& err, double& rcond, |
| 5727 solve_singularity_handler sing_handler, | |
| 5728 bool calc_cond) const | |
| 5164 | 5729 { |
| 5730 Matrix retval; | |
| 5731 | |
| 5275 | 5732 octave_idx_type nr = rows (); |
| 5733 octave_idx_type nc = cols (); | |
| 5164 | 5734 err = 0; |
| 5735 | |
| 6924 | 5736 if (nr != nc || nr != b.rows ()) |
| 5164 | 5737 (*current_liboctave_error_handler) |
| 5738 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5739 else if (nr == 0 || b.cols () == 0) |
| 5740 retval = Matrix (nc, b.cols (), 0.0); | |
| 5164 | 5741 else |
| 5742 { | |
| 5743 // Print spparms("spumoni") info if requested | |
| 5506 | 5744 volatile int typ = mattype.type (); |
| 5164 | 5745 mattype.info (); |
| 5746 | |
| 5785 | 5747 if (typ == MatrixType::Hermitian) |
| 5164 | 5748 { |
| 5506 | 5749 #ifdef HAVE_CHOLMOD |
| 5750 cholmod_common Common; | |
| 5751 cholmod_common *cm = &Common; | |
| 5752 | |
| 5753 // Setup initial parameters | |
| 5754 CHOLMOD_NAME(start) (cm); | |
| 5526 | 5755 cm->prefer_zomplex = false; |
| 5506 | 5756 |
| 5893 | 5757 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 5758 if (spu == 0.) |
| 5759 { | |
| 5760 cm->print = -1; | |
| 5761 cm->print_function = NULL; | |
| 5762 } | |
| 5763 else | |
| 5764 { | |
| 5760 | 5765 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 5766 cm->print_function =&SparseCholPrint; |
| 5767 } | |
| 5768 | |
| 5769 cm->error_handler = &SparseCholError; | |
| 5770 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 5771 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 5772 | |
| 5526 | 5773 cm->final_ll = true; |
| 5506 | 5774 |
| 5775 cholmod_sparse Astore; | |
| 5776 cholmod_sparse *A = &Astore; | |
| 5777 double dummy; | |
| 5778 A->nrow = nr; | |
| 5779 A->ncol = nc; | |
| 5780 | |
| 5781 A->p = cidx(); | |
| 5782 A->i = ridx(); | |
| 5604 | 5783 A->nzmax = nnz(); |
| 5526 | 5784 A->packed = true; |
| 5785 A->sorted = true; | |
| 5506 | 5786 A->nz = NULL; |
| 5787 #ifdef IDX_TYPE_LONG | |
| 5788 A->itype = CHOLMOD_LONG; | |
| 5789 #else | |
| 5790 A->itype = CHOLMOD_INT; | |
| 5791 #endif | |
| 5792 A->dtype = CHOLMOD_DOUBLE; | |
| 5793 A->stype = 1; | |
| 5794 A->xtype = CHOLMOD_REAL; | |
| 5795 | |
| 5796 if (nr < 1) | |
| 5797 A->x = &dummy; | |
| 5798 else | |
| 5799 A->x = data(); | |
| 5800 | |
| 5801 cholmod_dense Bstore; | |
| 5802 cholmod_dense *B = &Bstore; | |
| 5803 B->nrow = b.rows(); | |
| 5804 B->ncol = b.cols(); | |
| 5805 B->d = B->nrow; | |
| 5806 B->nzmax = B->nrow * B->ncol; | |
| 5807 B->dtype = CHOLMOD_DOUBLE; | |
| 5808 B->xtype = CHOLMOD_REAL; | |
| 5809 if (nc < 1 || b.cols() < 1) | |
| 5810 B->x = &dummy; | |
| 5811 else | |
| 5812 // We won't alter it, honest :-) | |
| 5813 B->x = const_cast<double *>(b.fortran_vec()); | |
| 5814 | |
| 5815 cholmod_factor *L; | |
| 5816 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5817 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 5818 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 5819 if (calc_cond) |
| 5820 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 5821 else | |
| 5822 rcond = 1.0; | |
| 5823 | |
| 5506 | 5824 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5825 | |
| 5826 if (rcond == 0.0) | |
| 5827 { | |
| 5828 // Either its indefinite or singular. Try UMFPACK | |
| 5829 mattype.mark_as_unsymmetric (); | |
| 5785 | 5830 typ = MatrixType::Full; |
| 5506 | 5831 } |
| 5832 else | |
| 5833 { | |
| 5834 volatile double rcond_plus_one = rcond + 1.0; | |
| 5835 | |
| 5836 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5837 { | |
| 5838 err = -2; | |
| 5839 | |
| 5840 if (sing_handler) | |
| 5681 | 5841 { |
| 5842 sing_handler (rcond); | |
| 5843 mattype.mark_as_rectangular (); | |
| 5844 } | |
| 5506 | 5845 else |
| 5846 (*current_liboctave_error_handler) | |
| 5847 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5848 rcond); | |
| 5849 | |
| 5850 return retval; | |
| 5851 } | |
| 5852 | |
| 5853 cholmod_dense *X; | |
| 5854 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5855 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 5856 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5857 | |
| 5858 retval.resize (b.rows (), b.cols()); | |
| 5859 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 5860 { | |
| 5861 octave_idx_type jr = j * b.rows(); | |
| 5862 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 5863 retval.xelem(i,j) = static_cast<double *>(X->x)[jr + i]; | |
| 5864 } | |
| 5865 | |
| 5866 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5867 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 5868 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 5869 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 5870 static char tmp[] = " "; |
| 5871 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 5872 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5873 } | |
| 5874 #else | |
| 5164 | 5875 (*current_liboctave_warning_handler) |
| 5506 | 5876 ("CHOLMOD not installed"); |
| 5164 | 5877 |
| 5878 mattype.mark_as_unsymmetric (); | |
| 5785 | 5879 typ = MatrixType::Full; |
| 5506 | 5880 #endif |
| 5164 | 5881 } |
| 5882 | |
| 5785 | 5883 if (typ == MatrixType::Full) |
| 5164 | 5884 { |
| 5203 | 5885 #ifdef HAVE_UMFPACK |
| 5164 | 5886 Matrix Control, Info; |
| 5887 void *Numeric = | |
| 5681 | 5888 factorize (err, rcond, Control, Info, sing_handler, calc_cond); |
| 5164 | 5889 |
| 5890 if (err == 0) | |
| 5891 { | |
| 5892 const double *Bx = b.fortran_vec (); | |
| 5893 retval.resize (b.rows (), b.cols()); | |
| 5894 double *result = retval.fortran_vec (); | |
| 5275 | 5895 octave_idx_type b_nr = b.rows (); |
| 5896 octave_idx_type b_nc = b.cols (); | |
| 5164 | 5897 int status = 0; |
| 5898 double *control = Control.fortran_vec (); | |
| 5899 double *info = Info.fortran_vec (); | |
| 5275 | 5900 const octave_idx_type *Ap = cidx (); |
| 5901 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5902 const double *Ax = data (); |
| 5903 | |
| 5275 | 5904 for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) |
| 5164 | 5905 { |
| 5322 | 5906 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 5907 Ai, Ax, &result[iidx], &Bx[iidx], | |
| 5164 | 5908 Numeric, control, info); |
| 5909 if (status < 0) | |
| 5910 { | |
| 5911 (*current_liboctave_error_handler) | |
| 5912 ("SparseMatrix::solve solve failed"); | |
| 5913 | |
| 5322 | 5914 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 5915 |
| 5916 err = -1; | |
| 5917 | |
| 5918 break; | |
| 5919 } | |
| 5920 } | |
| 5921 | |
| 5322 | 5922 UMFPACK_DNAME (report_info) (control, info); |
| 5164 | 5923 |
| 5322 | 5924 UMFPACK_DNAME (free_numeric) (&Numeric); |
| 5164 | 5925 } |
| 5681 | 5926 else |
| 5927 mattype.mark_as_rectangular (); | |
| 5928 | |
| 5203 | 5929 #else |
| 5930 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 5931 #endif | |
| 5164 | 5932 } |
| 5785 | 5933 else if (typ != MatrixType::Hermitian) |
| 5164 | 5934 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5935 } | |
| 5936 | |
| 5937 return retval; | |
| 5938 } | |
| 5939 | |
| 5940 SparseMatrix | |
| 5785 | 5941 SparseMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 5942 octave_idx_type& err, double& rcond, |
| 5943 solve_singularity_handler sing_handler, | |
| 5944 bool calc_cond) const | |
| 5164 | 5945 { |
| 5946 SparseMatrix retval; | |
| 5947 | |
| 5275 | 5948 octave_idx_type nr = rows (); |
| 5949 octave_idx_type nc = cols (); | |
| 5164 | 5950 err = 0; |
| 5951 | |
| 6924 | 5952 if (nr != nc || nr != b.rows ()) |
| 5164 | 5953 (*current_liboctave_error_handler) |
| 5954 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5955 else if (nr == 0 || b.cols () == 0) |
| 5956 retval = SparseMatrix (nc, b.cols ()); | |
| 5164 | 5957 else |
| 5958 { | |
| 5959 // Print spparms("spumoni") info if requested | |
| 5506 | 5960 volatile int typ = mattype.type (); |
| 5164 | 5961 mattype.info (); |
| 5962 | |
| 5785 | 5963 if (typ == MatrixType::Hermitian) |
| 5164 | 5964 { |
| 5506 | 5965 #ifdef HAVE_CHOLMOD |
| 5966 cholmod_common Common; | |
| 5967 cholmod_common *cm = &Common; | |
| 5968 | |
| 5969 // Setup initial parameters | |
| 5970 CHOLMOD_NAME(start) (cm); | |
| 5526 | 5971 cm->prefer_zomplex = false; |
| 5506 | 5972 |
| 5893 | 5973 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 5974 if (spu == 0.) |
| 5975 { | |
| 5976 cm->print = -1; | |
| 5977 cm->print_function = NULL; | |
| 5978 } | |
| 5979 else | |
| 5980 { | |
| 5760 | 5981 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 5982 cm->print_function =&SparseCholPrint; |
| 5983 } | |
| 5984 | |
| 5985 cm->error_handler = &SparseCholError; | |
| 5986 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 5987 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 5988 | |
| 5526 | 5989 cm->final_ll = true; |
| 5506 | 5990 |
| 5991 cholmod_sparse Astore; | |
| 5992 cholmod_sparse *A = &Astore; | |
| 5993 double dummy; | |
| 5994 A->nrow = nr; | |
| 5995 A->ncol = nc; | |
| 5996 | |
| 5997 A->p = cidx(); | |
| 5998 A->i = ridx(); | |
| 5604 | 5999 A->nzmax = nnz(); |
| 5526 | 6000 A->packed = true; |
| 6001 A->sorted = true; | |
| 5506 | 6002 A->nz = NULL; |
| 6003 #ifdef IDX_TYPE_LONG | |
| 6004 A->itype = CHOLMOD_LONG; | |
| 6005 #else | |
| 6006 A->itype = CHOLMOD_INT; | |
| 6007 #endif | |
| 6008 A->dtype = CHOLMOD_DOUBLE; | |
| 6009 A->stype = 1; | |
| 6010 A->xtype = CHOLMOD_REAL; | |
| 6011 | |
| 6012 if (nr < 1) | |
| 6013 A->x = &dummy; | |
| 6014 else | |
| 6015 A->x = data(); | |
| 6016 | |
| 6017 cholmod_sparse Bstore; | |
| 6018 cholmod_sparse *B = &Bstore; | |
| 6019 B->nrow = b.rows(); | |
| 6020 B->ncol = b.cols(); | |
| 6021 B->p = b.cidx(); | |
| 6022 B->i = b.ridx(); | |
| 5604 | 6023 B->nzmax = b.nnz(); |
| 5526 | 6024 B->packed = true; |
| 6025 B->sorted = true; | |
| 5506 | 6026 B->nz = NULL; |
| 6027 #ifdef IDX_TYPE_LONG | |
| 6028 B->itype = CHOLMOD_LONG; | |
| 6029 #else | |
| 6030 B->itype = CHOLMOD_INT; | |
| 6031 #endif | |
| 6032 B->dtype = CHOLMOD_DOUBLE; | |
| 6033 B->stype = 0; | |
| 6034 B->xtype = CHOLMOD_REAL; | |
| 6035 | |
| 6036 if (b.rows() < 1 || b.cols() < 1) | |
| 6037 B->x = &dummy; | |
| 6038 else | |
| 6039 B->x = b.data(); | |
| 6040 | |
| 6041 cholmod_factor *L; | |
| 6042 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6043 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6044 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6045 if (calc_cond) |
| 6046 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6047 else | |
| 6048 rcond = 1.; | |
| 5506 | 6049 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6050 | |
| 6051 if (rcond == 0.0) | |
| 6052 { | |
| 6053 // Either its indefinite or singular. Try UMFPACK | |
| 6054 mattype.mark_as_unsymmetric (); | |
| 5785 | 6055 typ = MatrixType::Full; |
| 5506 | 6056 } |
| 6057 else | |
| 6058 { | |
| 6059 volatile double rcond_plus_one = rcond + 1.0; | |
| 6060 | |
| 6061 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6062 { | |
| 6063 err = -2; | |
| 6064 | |
| 6065 if (sing_handler) | |
| 5681 | 6066 { |
| 6067 sing_handler (rcond); | |
| 6068 mattype.mark_as_rectangular (); | |
| 6069 } | |
| 5506 | 6070 else |
| 6071 (*current_liboctave_error_handler) | |
| 6072 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6073 rcond); | |
| 6074 | |
| 6075 return retval; | |
| 6076 } | |
| 6077 | |
| 6078 cholmod_sparse *X; | |
| 6079 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6080 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 6081 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6082 | |
| 6083 retval = SparseMatrix (static_cast<octave_idx_type>(X->nrow), | |
| 6084 static_cast<octave_idx_type>(X->ncol), | |
| 6085 static_cast<octave_idx_type>(X->nzmax)); | |
| 6086 for (octave_idx_type j = 0; | |
| 6087 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 6088 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 6089 for (octave_idx_type j = 0; | |
| 6090 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 6091 { | |
| 6092 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 6093 retval.xdata(j) = static_cast<double *>(X->x)[j]; | |
| 6094 } | |
| 6095 | |
| 6096 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6097 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 6098 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6099 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6100 static char tmp[] = " "; |
| 6101 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6102 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6103 } | |
| 6104 #else | |
| 5164 | 6105 (*current_liboctave_warning_handler) |
| 5506 | 6106 ("CHOLMOD not installed"); |
| 5164 | 6107 |
| 6108 mattype.mark_as_unsymmetric (); | |
| 5785 | 6109 typ = MatrixType::Full; |
| 5506 | 6110 #endif |
| 5164 | 6111 } |
| 6112 | |
| 5785 | 6113 if (typ == MatrixType::Full) |
| 5164 | 6114 { |
| 5203 | 6115 #ifdef HAVE_UMFPACK |
| 5164 | 6116 Matrix Control, Info; |
| 6117 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6118 sing_handler, calc_cond); |
| 5164 | 6119 |
| 6120 if (err == 0) | |
| 6121 { | |
| 5275 | 6122 octave_idx_type b_nr = b.rows (); |
| 6123 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6124 int status = 0; |
| 6125 double *control = Control.fortran_vec (); | |
| 6126 double *info = Info.fortran_vec (); | |
| 5275 | 6127 const octave_idx_type *Ap = cidx (); |
| 6128 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6129 const double *Ax = data (); |
| 6130 | |
| 6131 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6132 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6133 | |
| 6134 // Take a first guess that the number of non-zero terms | |
| 6135 // will be as many as in b | |
| 5681 | 6136 octave_idx_type x_nz = b.nnz (); |
| 5275 | 6137 octave_idx_type ii = 0; |
| 5164 | 6138 retval = SparseMatrix (b_nr, b_nc, x_nz); |
| 6139 | |
| 6140 retval.xcidx(0) = 0; | |
| 5275 | 6141 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6142 { |
| 6143 | |
| 5275 | 6144 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6145 Bx[i] = b.elem (i, j); |
| 6146 | |
| 5322 | 6147 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6148 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6149 info); |
| 6150 if (status < 0) | |
| 6151 { | |
| 6152 (*current_liboctave_error_handler) | |
| 6153 ("SparseMatrix::solve solve failed"); | |
| 6154 | |
| 5322 | 6155 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6156 |
| 6157 err = -1; | |
| 6158 | |
| 6159 break; | |
| 6160 } | |
| 6161 | |
| 5275 | 6162 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6163 { |
| 6164 double tmp = Xx[i]; | |
| 6165 if (tmp != 0.0) | |
| 6166 { | |
| 6167 if (ii == x_nz) | |
| 6168 { | |
| 6169 // Resize the sparse matrix | |
| 5275 | 6170 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6171 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6172 retval.change_capacity (sz); | |
| 6173 x_nz = sz; | |
| 6174 } | |
| 6175 retval.xdata(ii) = tmp; | |
| 6176 retval.xridx(ii++) = i; | |
| 6177 } | |
| 6178 } | |
| 6179 retval.xcidx(j+1) = ii; | |
| 6180 } | |
| 6181 | |
| 6182 retval.maybe_compress (); | |
| 6183 | |
| 5322 | 6184 UMFPACK_DNAME (report_info) (control, info); |
| 6185 | |
| 6186 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6187 } |
| 5681 | 6188 else |
| 6189 mattype.mark_as_rectangular (); | |
| 6190 | |
| 5203 | 6191 #else |
| 6192 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6193 #endif | |
| 5164 | 6194 } |
| 5785 | 6195 else if (typ != MatrixType::Hermitian) |
| 5164 | 6196 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6197 } | |
| 6198 | |
| 6199 return retval; | |
| 6200 } | |
| 6201 | |
| 6202 ComplexMatrix | |
| 5785 | 6203 SparseMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5681 | 6204 octave_idx_type& err, double& rcond, |
| 6205 solve_singularity_handler sing_handler, | |
| 6206 bool calc_cond) const | |
| 5164 | 6207 { |
| 6208 ComplexMatrix retval; | |
| 6209 | |
| 5275 | 6210 octave_idx_type nr = rows (); |
| 6211 octave_idx_type nc = cols (); | |
| 5164 | 6212 err = 0; |
| 6213 | |
| 6924 | 6214 if (nr != nc || nr != b.rows ()) |
| 5164 | 6215 (*current_liboctave_error_handler) |
| 6216 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6217 else if (nr == 0 || b.cols () == 0) |
| 6218 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 6219 else |
| 6220 { | |
| 6221 // Print spparms("spumoni") info if requested | |
| 5506 | 6222 volatile int typ = mattype.type (); |
| 5164 | 6223 mattype.info (); |
| 6224 | |
| 5785 | 6225 if (typ == MatrixType::Hermitian) |
| 5164 | 6226 { |
| 5506 | 6227 #ifdef HAVE_CHOLMOD |
| 6228 cholmod_common Common; | |
| 6229 cholmod_common *cm = &Common; | |
| 6230 | |
| 6231 // Setup initial parameters | |
| 6232 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6233 cm->prefer_zomplex = false; |
| 5506 | 6234 |
| 5893 | 6235 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6236 if (spu == 0.) |
| 6237 { | |
| 6238 cm->print = -1; | |
| 6239 cm->print_function = NULL; | |
| 6240 } | |
| 6241 else | |
| 6242 { | |
| 5760 | 6243 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6244 cm->print_function =&SparseCholPrint; |
| 6245 } | |
| 6246 | |
| 6247 cm->error_handler = &SparseCholError; | |
| 6248 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6249 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6250 | |
| 5526 | 6251 cm->final_ll = true; |
| 5506 | 6252 |
| 6253 cholmod_sparse Astore; | |
| 6254 cholmod_sparse *A = &Astore; | |
| 6255 double dummy; | |
| 6256 A->nrow = nr; | |
| 6257 A->ncol = nc; | |
| 6258 | |
| 6259 A->p = cidx(); | |
| 6260 A->i = ridx(); | |
| 5604 | 6261 A->nzmax = nnz(); |
| 5526 | 6262 A->packed = true; |
| 6263 A->sorted = true; | |
| 5506 | 6264 A->nz = NULL; |
| 6265 #ifdef IDX_TYPE_LONG | |
| 6266 A->itype = CHOLMOD_LONG; | |
| 6267 #else | |
| 6268 A->itype = CHOLMOD_INT; | |
| 6269 #endif | |
| 6270 A->dtype = CHOLMOD_DOUBLE; | |
| 6271 A->stype = 1; | |
| 6272 A->xtype = CHOLMOD_REAL; | |
| 6273 | |
| 6274 if (nr < 1) | |
| 6275 A->x = &dummy; | |
| 6276 else | |
| 6277 A->x = data(); | |
| 6278 | |
| 6279 cholmod_dense Bstore; | |
| 6280 cholmod_dense *B = &Bstore; | |
| 6281 B->nrow = b.rows(); | |
| 6282 B->ncol = b.cols(); | |
| 6283 B->d = B->nrow; | |
| 6284 B->nzmax = B->nrow * B->ncol; | |
| 6285 B->dtype = CHOLMOD_DOUBLE; | |
| 6286 B->xtype = CHOLMOD_COMPLEX; | |
| 6287 if (nc < 1 || b.cols() < 1) | |
| 6288 B->x = &dummy; | |
| 6289 else | |
| 6290 // We won't alter it, honest :-) | |
| 6291 B->x = const_cast<Complex *>(b.fortran_vec()); | |
| 6292 | |
| 6293 cholmod_factor *L; | |
| 6294 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6295 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6296 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6297 if (calc_cond) |
| 6298 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6299 else | |
| 6300 rcond = 1.0; | |
| 5506 | 6301 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6302 | |
| 6303 if (rcond == 0.0) | |
| 6304 { | |
| 6305 // Either its indefinite or singular. Try UMFPACK | |
| 6306 mattype.mark_as_unsymmetric (); | |
| 5785 | 6307 typ = MatrixType::Full; |
| 5506 | 6308 } |
| 6309 else | |
| 6310 { | |
| 6311 volatile double rcond_plus_one = rcond + 1.0; | |
| 6312 | |
| 6313 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6314 { | |
| 6315 err = -2; | |
| 6316 | |
| 6317 if (sing_handler) | |
| 5681 | 6318 { |
| 6319 sing_handler (rcond); | |
| 6320 mattype.mark_as_rectangular (); | |
| 6321 } | |
| 5506 | 6322 else |
| 6323 (*current_liboctave_error_handler) | |
| 6324 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6325 rcond); | |
| 6326 | |
| 6327 return retval; | |
| 6328 } | |
| 6329 | |
| 6330 cholmod_dense *X; | |
| 6331 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6332 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 6333 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6334 | |
| 6335 retval.resize (b.rows (), b.cols()); | |
| 6336 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 6337 { | |
| 6338 octave_idx_type jr = j * b.rows(); | |
| 6339 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 6340 retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; | |
| 6341 } | |
| 6342 | |
| 6343 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6344 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 6345 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6346 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6347 static char tmp[] = " "; |
| 6348 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6349 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6350 } | |
| 6351 #else | |
| 5164 | 6352 (*current_liboctave_warning_handler) |
| 5506 | 6353 ("CHOLMOD not installed"); |
| 5164 | 6354 |
| 6355 mattype.mark_as_unsymmetric (); | |
| 5785 | 6356 typ = MatrixType::Full; |
| 5506 | 6357 #endif |
| 5164 | 6358 } |
| 6359 | |
| 5785 | 6360 if (typ == MatrixType::Full) |
| 5164 | 6361 { |
| 5203 | 6362 #ifdef HAVE_UMFPACK |
| 5164 | 6363 Matrix Control, Info; |
| 6364 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6365 sing_handler, calc_cond); |
| 5164 | 6366 |
| 6367 if (err == 0) | |
| 6368 { | |
| 5275 | 6369 octave_idx_type b_nr = b.rows (); |
| 6370 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6371 int status = 0; |
| 6372 double *control = Control.fortran_vec (); | |
| 6373 double *info = Info.fortran_vec (); | |
| 5275 | 6374 const octave_idx_type *Ap = cidx (); |
| 6375 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6376 const double *Ax = data (); |
| 6377 | |
| 6378 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6379 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 6380 | |
| 6381 retval.resize (b_nr, b_nc); | |
| 6382 | |
| 6383 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6384 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); | |
| 6385 | |
| 5275 | 6386 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6387 { |
| 5275 | 6388 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6389 { |
| 6390 Complex c = b (i,j); | |
| 5261 | 6391 Bx[i] = std::real (c); |
| 6392 Bz[i] = std::imag (c); | |
| 5164 | 6393 } |
| 6394 | |
| 5322 | 6395 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6396 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6397 info); |
| 5322 | 6398 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, |
| 6399 Ap, Ai, Ax, Xz, Bz, Numeric, | |
| 5164 | 6400 control, info) ; |
| 6401 | |
| 6402 if (status < 0 || status2 < 0) | |
| 6403 { | |
| 6404 (*current_liboctave_error_handler) | |
| 6405 ("SparseMatrix::solve solve failed"); | |
| 6406 | |
| 5322 | 6407 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6408 |
| 6409 err = -1; | |
| 6410 | |
| 6411 break; | |
| 6412 } | |
| 6413 | |
| 5275 | 6414 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6415 retval (i, j) = Complex (Xx[i], Xz[i]); |
| 6416 } | |
| 6417 | |
| 5322 | 6418 UMFPACK_DNAME (report_info) (control, info); |
| 6419 | |
| 6420 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6421 } |
| 5681 | 6422 else |
| 6423 mattype.mark_as_rectangular (); | |
| 6424 | |
| 5203 | 6425 #else |
| 6426 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6427 #endif | |
| 5164 | 6428 } |
| 5785 | 6429 else if (typ != MatrixType::Hermitian) |
| 5164 | 6430 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6431 } | |
| 6432 | |
| 6433 return retval; | |
| 6434 } | |
| 6435 | |
| 6436 SparseComplexMatrix | |
| 5785 | 6437 SparseMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6438 octave_idx_type& err, double& rcond, |
| 5681 | 6439 solve_singularity_handler sing_handler, |
| 6440 bool calc_cond) const | |
| 5164 | 6441 { |
| 6442 SparseComplexMatrix retval; | |
| 6443 | |
| 5275 | 6444 octave_idx_type nr = rows (); |
| 6445 octave_idx_type nc = cols (); | |
| 5164 | 6446 err = 0; |
| 6447 | |
| 6924 | 6448 if (nr != nc || nr != b.rows ()) |
| 5164 | 6449 (*current_liboctave_error_handler) |
| 6450 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6451 else if (nr == 0 || b.cols () == 0) |
| 6452 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 6453 else |
| 6454 { | |
| 6455 // Print spparms("spumoni") info if requested | |
| 5506 | 6456 volatile int typ = mattype.type (); |
| 5164 | 6457 mattype.info (); |
| 6458 | |
| 5785 | 6459 if (typ == MatrixType::Hermitian) |
| 5164 | 6460 { |
| 5506 | 6461 #ifdef HAVE_CHOLMOD |
| 6462 cholmod_common Common; | |
| 6463 cholmod_common *cm = &Common; | |
| 6464 | |
| 6465 // Setup initial parameters | |
| 6466 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6467 cm->prefer_zomplex = false; |
| 5506 | 6468 |
| 5893 | 6469 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6470 if (spu == 0.) |
| 6471 { | |
| 6472 cm->print = -1; | |
| 6473 cm->print_function = NULL; | |
| 6474 } | |
| 6475 else | |
| 6476 { | |
| 5760 | 6477 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6478 cm->print_function =&SparseCholPrint; |
| 6479 } | |
| 6480 | |
| 6481 cm->error_handler = &SparseCholError; | |
| 6482 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6483 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6484 | |
| 5526 | 6485 cm->final_ll = true; |
| 5506 | 6486 |
| 6487 cholmod_sparse Astore; | |
| 6488 cholmod_sparse *A = &Astore; | |
| 6489 double dummy; | |
| 6490 A->nrow = nr; | |
| 6491 A->ncol = nc; | |
| 6492 | |
| 6493 A->p = cidx(); | |
| 6494 A->i = ridx(); | |
| 5604 | 6495 A->nzmax = nnz(); |
| 5526 | 6496 A->packed = true; |
| 6497 A->sorted = true; | |
| 5506 | 6498 A->nz = NULL; |
| 6499 #ifdef IDX_TYPE_LONG | |
| 6500 A->itype = CHOLMOD_LONG; | |
| 6501 #else | |
| 6502 A->itype = CHOLMOD_INT; | |
| 6503 #endif | |
| 6504 A->dtype = CHOLMOD_DOUBLE; | |
| 6505 A->stype = 1; | |
| 6506 A->xtype = CHOLMOD_REAL; | |
| 6507 | |
| 6508 if (nr < 1) | |
| 6509 A->x = &dummy; | |
| 6510 else | |
| 6511 A->x = data(); | |
| 6512 | |
| 6513 cholmod_sparse Bstore; | |
| 6514 cholmod_sparse *B = &Bstore; | |
| 6515 B->nrow = b.rows(); | |
| 6516 B->ncol = b.cols(); | |
| 6517 B->p = b.cidx(); | |
| 6518 B->i = b.ridx(); | |
| 5604 | 6519 B->nzmax = b.nnz(); |
| 5526 | 6520 B->packed = true; |
| 6521 B->sorted = true; | |
| 5506 | 6522 B->nz = NULL; |
| 6523 #ifdef IDX_TYPE_LONG | |
| 6524 B->itype = CHOLMOD_LONG; | |
| 6525 #else | |
| 6526 B->itype = CHOLMOD_INT; | |
| 6527 #endif | |
| 6528 B->dtype = CHOLMOD_DOUBLE; | |
| 6529 B->stype = 0; | |
| 6530 B->xtype = CHOLMOD_COMPLEX; | |
| 6531 | |
| 6532 if (b.rows() < 1 || b.cols() < 1) | |
| 6533 B->x = &dummy; | |
| 6534 else | |
| 6535 B->x = b.data(); | |
| 6536 | |
| 6537 cholmod_factor *L; | |
| 6538 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6539 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6540 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6541 if (calc_cond) |
| 6542 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6543 else | |
| 6544 rcond = 1.0; | |
| 5506 | 6545 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6546 | |
| 6547 if (rcond == 0.0) | |
| 6548 { | |
| 6549 // Either its indefinite or singular. Try UMFPACK | |
| 6550 mattype.mark_as_unsymmetric (); | |
| 5785 | 6551 typ = MatrixType::Full; |
| 5506 | 6552 } |
| 6553 else | |
| 6554 { | |
| 6555 volatile double rcond_plus_one = rcond + 1.0; | |
| 6556 | |
| 6557 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6558 { | |
| 6559 err = -2; | |
| 6560 | |
| 6561 if (sing_handler) | |
| 5681 | 6562 { |
| 6563 sing_handler (rcond); | |
| 6564 mattype.mark_as_rectangular (); | |
| 6565 } | |
| 5506 | 6566 else |
| 6567 (*current_liboctave_error_handler) | |
| 6568 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6569 rcond); | |
| 6570 | |
| 6571 return retval; | |
| 6572 } | |
| 6573 | |
| 6574 cholmod_sparse *X; | |
| 6575 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6576 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 6577 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6578 | |
| 6579 retval = SparseComplexMatrix | |
| 6580 (static_cast<octave_idx_type>(X->nrow), | |
| 6581 static_cast<octave_idx_type>(X->ncol), | |
| 6582 static_cast<octave_idx_type>(X->nzmax)); | |
| 6583 for (octave_idx_type j = 0; | |
| 6584 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 6585 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 6586 for (octave_idx_type j = 0; | |
| 6587 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 6588 { | |
| 6589 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 6590 retval.xdata(j) = static_cast<Complex *>(X->x)[j]; | |
| 6591 } | |
| 6592 | |
| 6593 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6594 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 6595 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6596 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6597 static char tmp[] = " "; |
| 6598 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6599 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6600 } | |
| 6601 #else | |
| 5164 | 6602 (*current_liboctave_warning_handler) |
| 5506 | 6603 ("CHOLMOD not installed"); |
| 5164 | 6604 |
| 6605 mattype.mark_as_unsymmetric (); | |
| 5785 | 6606 typ = MatrixType::Full; |
| 5506 | 6607 #endif |
| 5164 | 6608 } |
| 6609 | |
| 5785 | 6610 if (typ == MatrixType::Full) |
| 5164 | 6611 { |
| 5203 | 6612 #ifdef HAVE_UMFPACK |
| 5164 | 6613 Matrix Control, Info; |
| 6614 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 6615 sing_handler, calc_cond); |
| 5164 | 6616 |
| 6617 if (err == 0) | |
| 6618 { | |
| 5275 | 6619 octave_idx_type b_nr = b.rows (); |
| 6620 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6621 int status = 0; |
| 6622 double *control = Control.fortran_vec (); | |
| 6623 double *info = Info.fortran_vec (); | |
| 5275 | 6624 const octave_idx_type *Ap = cidx (); |
| 6625 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6626 const double *Ax = data (); |
| 6627 | |
| 6628 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); | |
| 6629 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 6630 | |
| 6631 // Take a first guess that the number of non-zero terms | |
| 6632 // will be as many as in b | |
| 5681 | 6633 octave_idx_type x_nz = b.nnz (); |
| 5275 | 6634 octave_idx_type ii = 0; |
| 5164 | 6635 retval = SparseComplexMatrix (b_nr, b_nc, x_nz); |
| 6636 | |
| 6637 OCTAVE_LOCAL_BUFFER (double, Xx, b_nr); | |
| 6638 OCTAVE_LOCAL_BUFFER (double, Xz, b_nr); | |
| 6639 | |
| 6640 retval.xcidx(0) = 0; | |
| 5275 | 6641 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6642 { |
| 5275 | 6643 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6644 { |
| 6645 Complex c = b (i,j); | |
| 5261 | 6646 Bx[i] = std::real (c); |
| 6647 Bz[i] = std::imag (c); | |
| 5164 | 6648 } |
| 6649 | |
| 5322 | 6650 status = UMFPACK_DNAME (solve) (UMFPACK_A, Ap, |
| 6651 Ai, Ax, Xx, Bx, Numeric, control, | |
| 5164 | 6652 info); |
| 5322 | 6653 int status2 = UMFPACK_DNAME (solve) (UMFPACK_A, |
| 6654 Ap, Ai, Ax, Xz, Bz, Numeric, | |
| 5164 | 6655 control, info) ; |
| 6656 | |
| 6657 if (status < 0 || status2 < 0) | |
| 6658 { | |
| 6659 (*current_liboctave_error_handler) | |
| 6660 ("SparseMatrix::solve solve failed"); | |
| 6661 | |
| 5322 | 6662 UMFPACK_DNAME (report_status) (control, status); |
| 5164 | 6663 |
| 6664 err = -1; | |
| 6665 | |
| 6666 break; | |
| 6667 } | |
| 6668 | |
| 5275 | 6669 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6670 { |
| 6671 Complex tmp = Complex (Xx[i], Xz[i]); | |
| 6672 if (tmp != 0.0) | |
| 6673 { | |
| 6674 if (ii == x_nz) | |
| 6675 { | |
| 6676 // Resize the sparse matrix | |
| 5275 | 6677 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6678 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6679 retval.change_capacity (sz); | |
| 6680 x_nz = sz; | |
| 6681 } | |
| 6682 retval.xdata(ii) = tmp; | |
| 6683 retval.xridx(ii++) = i; | |
| 6684 } | |
| 6685 } | |
| 6686 retval.xcidx(j+1) = ii; | |
| 6687 } | |
| 6688 | |
| 6689 retval.maybe_compress (); | |
| 6690 | |
| 5322 | 6691 UMFPACK_DNAME (report_info) (control, info); |
| 6692 | |
| 6693 UMFPACK_DNAME (free_numeric) (&Numeric); | |
| 5164 | 6694 } |
| 5681 | 6695 else |
| 6696 mattype.mark_as_rectangular (); | |
| 5203 | 6697 #else |
| 6698 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6699 #endif | |
| 5164 | 6700 } |
| 5785 | 6701 else if (typ != MatrixType::Hermitian) |
| 5164 | 6702 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6703 } | |
| 6704 | |
| 6705 return retval; | |
| 6706 } | |
| 6707 | |
| 6708 Matrix | |
| 5785 | 6709 SparseMatrix::solve (MatrixType &mattype, const Matrix& b) const |
| 5164 | 6710 { |
| 5275 | 6711 octave_idx_type info; |
| 5164 | 6712 double rcond; |
| 6713 return solve (mattype, b, info, rcond, 0); | |
| 6714 } | |
| 6715 | |
| 6716 Matrix | |
| 5785 | 6717 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, |
| 5697 | 6718 octave_idx_type& info) const |
| 5164 | 6719 { |
| 6720 double rcond; | |
| 6721 return solve (mattype, b, info, rcond, 0); | |
| 6722 } | |
| 6723 | |
| 6724 Matrix | |
| 5785 | 6725 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& info, |
| 5164 | 6726 double& rcond) const |
| 6727 { | |
| 6728 return solve (mattype, b, info, rcond, 0); | |
| 6729 } | |
| 6730 | |
| 6731 Matrix | |
| 5785 | 6732 SparseMatrix::solve (MatrixType &mattype, const Matrix& b, octave_idx_type& err, |
| 5697 | 6733 double& rcond, solve_singularity_handler sing_handler, |
| 6734 bool singular_fallback) const | |
| 5164 | 6735 { |
| 5681 | 6736 Matrix retval; |
| 5322 | 6737 int typ = mattype.type (false); |
| 5164 | 6738 |
| 5785 | 6739 if (typ == MatrixType::Unknown) |
| 5164 | 6740 typ = mattype.type (*this); |
| 6741 | |
| 5681 | 6742 // Only calculate the condition number for CHOLMOD/UMFPACK |
| 5785 | 6743 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6744 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6745 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6746 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6747 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6748 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6749 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6750 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6751 else if (typ == MatrixType::Tridiagonal || |
| 6752 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6753 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6754 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6755 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6756 else if (typ != MatrixType::Rectangular) |
| 5164 | 6757 { |
| 5681 | 6758 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6759 return Matrix (); |
| 6760 } | |
| 5681 | 6761 |
| 6762 // Rectangular or one of the above solvers flags a singular matrix | |
| 5785 | 6763 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) |
| 5681 | 6764 { |
| 6765 rcond = 1.; | |
| 6766 #ifdef USE_QRSOLVE | |
| 6767 retval = qrsolve (*this, b, err); | |
| 6768 #else | |
| 6769 retval = dmsolve<Matrix, SparseMatrix, Matrix> (*this, b, err); | |
| 6770 #endif | |
| 6771 } | |
| 6772 | |
| 6773 return retval; | |
| 5164 | 6774 } |
| 6775 | |
| 6776 SparseMatrix | |
| 5785 | 6777 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b) const |
| 5164 | 6778 { |
| 5275 | 6779 octave_idx_type info; |
| 5164 | 6780 double rcond; |
| 6781 return solve (mattype, b, info, rcond, 0); | |
| 6782 } | |
| 6783 | |
| 6784 SparseMatrix | |
| 5785 | 6785 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6786 octave_idx_type& info) const |
| 5164 | 6787 { |
| 6788 double rcond; | |
| 6789 return solve (mattype, b, info, rcond, 0); | |
| 6790 } | |
| 6791 | |
| 6792 SparseMatrix | |
| 5785 | 6793 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6794 octave_idx_type& info, double& rcond) const |
| 5164 | 6795 { |
| 6796 return solve (mattype, b, info, rcond, 0); | |
| 6797 } | |
| 6798 | |
| 6799 SparseMatrix | |
| 5785 | 6800 SparseMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6801 octave_idx_type& err, double& rcond, |
| 5697 | 6802 solve_singularity_handler sing_handler, |
| 6803 bool singular_fallback) const | |
| 5164 | 6804 { |
| 5681 | 6805 SparseMatrix retval; |
| 5322 | 6806 int typ = mattype.type (false); |
| 5164 | 6807 |
| 5785 | 6808 if (typ == MatrixType::Unknown) |
| 5164 | 6809 typ = mattype.type (*this); |
| 6810 | |
| 5785 | 6811 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6812 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6813 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6814 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6815 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6816 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6817 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6818 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6819 else if (typ == MatrixType::Tridiagonal || |
| 6820 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6821 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6822 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6823 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6824 else if (typ != MatrixType::Rectangular) |
| 5164 | 6825 { |
| 5681 | 6826 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6827 return SparseMatrix (); |
| 6828 } | |
| 5681 | 6829 |
| 5785 | 6830 if (singular_fallback && mattype.type (false) == MatrixType::Rectangular) |
| 5681 | 6831 { |
| 6832 rcond = 1.; | |
| 6833 #ifdef USE_QRSOLVE | |
| 6834 retval = qrsolve (*this, b, err); | |
| 6835 #else | |
| 6836 retval = dmsolve<SparseMatrix, SparseMatrix, | |
| 6837 SparseMatrix> (*this, b, err); | |
| 6838 #endif | |
| 6839 } | |
| 6840 | |
| 6841 return retval; | |
| 5164 | 6842 } |
| 6843 | |
| 6844 ComplexMatrix | |
| 5785 | 6845 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b) const |
| 5164 | 6846 { |
| 5275 | 6847 octave_idx_type info; |
| 5164 | 6848 double rcond; |
| 6849 return solve (mattype, b, info, rcond, 0); | |
| 6850 } | |
| 6851 | |
| 6852 ComplexMatrix | |
| 5785 | 6853 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6854 octave_idx_type& info) const |
| 5164 | 6855 { |
| 6856 double rcond; | |
| 6857 return solve (mattype, b, info, rcond, 0); | |
| 6858 } | |
| 6859 | |
| 6860 ComplexMatrix | |
| 5785 | 6861 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6862 octave_idx_type& info, double& rcond) const |
| 5164 | 6863 { |
| 6864 return solve (mattype, b, info, rcond, 0); | |
| 6865 } | |
| 6866 | |
| 6867 ComplexMatrix | |
| 5785 | 6868 SparseMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6869 octave_idx_type& err, double& rcond, |
| 5697 | 6870 solve_singularity_handler sing_handler, |
| 6871 bool singular_fallback) const | |
| 5164 | 6872 { |
| 5681 | 6873 ComplexMatrix retval; |
| 5322 | 6874 int typ = mattype.type (false); |
| 5164 | 6875 |
| 5785 | 6876 if (typ == MatrixType::Unknown) |
| 5164 | 6877 typ = mattype.type (*this); |
| 6878 | |
| 5785 | 6879 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6880 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6881 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6882 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6883 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6884 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6885 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6886 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6887 else if (typ == MatrixType::Tridiagonal || |
| 6888 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6889 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6890 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6891 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6892 else if (typ != MatrixType::Rectangular) |
| 5164 | 6893 { |
| 5681 | 6894 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6895 return ComplexMatrix (); |
| 6896 } | |
| 5681 | 6897 |
| 5785 | 6898 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6899 { |
| 6900 rcond = 1.; | |
| 6901 #ifdef USE_QRSOLVE | |
| 6902 retval = qrsolve (*this, b, err); | |
| 6903 #else | |
| 6904 retval = dmsolve<ComplexMatrix, SparseMatrix, | |
| 6905 ComplexMatrix> (*this, b, err); | |
| 6906 #endif | |
| 6907 } | |
| 6908 | |
| 6909 return retval; | |
| 5164 | 6910 } |
| 6911 | |
| 6912 SparseComplexMatrix | |
| 5785 | 6913 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b) const |
| 5164 | 6914 { |
| 5275 | 6915 octave_idx_type info; |
| 5164 | 6916 double rcond; |
| 6917 return solve (mattype, b, info, rcond, 0); | |
| 6918 } | |
| 6919 | |
| 6920 SparseComplexMatrix | |
| 5785 | 6921 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6922 octave_idx_type& info) const |
| 5164 | 6923 { |
| 6924 double rcond; | |
| 6925 return solve (mattype, b, info, rcond, 0); | |
| 6926 } | |
| 6927 | |
| 6928 SparseComplexMatrix | |
| 5785 | 6929 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6930 octave_idx_type& info, double& rcond) const |
| 5164 | 6931 { |
| 6932 return solve (mattype, b, info, rcond, 0); | |
| 6933 } | |
| 6934 | |
| 6935 SparseComplexMatrix | |
| 5785 | 6936 SparseMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6937 octave_idx_type& err, double& rcond, |
| 5697 | 6938 solve_singularity_handler sing_handler, |
| 6939 bool singular_fallback) const | |
| 5164 | 6940 { |
| 5681 | 6941 SparseComplexMatrix retval; |
| 5322 | 6942 int typ = mattype.type (false); |
| 5164 | 6943 |
| 5785 | 6944 if (typ == MatrixType::Unknown) |
| 5164 | 6945 typ = mattype.type (*this); |
| 6946 | |
| 5785 | 6947 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6948 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6949 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6950 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6951 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6952 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6953 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6954 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6955 else if (typ == MatrixType::Tridiagonal || |
| 6956 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6957 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6958 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6959 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6960 else if (typ != MatrixType::Rectangular) |
| 5164 | 6961 { |
| 5681 | 6962 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6963 return SparseComplexMatrix (); |
| 6964 } | |
| 5681 | 6965 |
| 5785 | 6966 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6967 { |
| 6968 rcond = 1.; | |
| 6969 #ifdef USE_QRSOLVE | |
| 6970 retval = qrsolve (*this, b, err); | |
| 6971 #else | |
| 6972 retval = dmsolve<SparseComplexMatrix, SparseMatrix, | |
| 6973 SparseComplexMatrix> (*this, b, err); | |
| 6974 #endif | |
| 6975 } | |
| 6976 | |
| 6977 return retval; | |
| 5164 | 6978 } |
| 6979 | |
| 6980 ColumnVector | |
| 5785 | 6981 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b) const |
| 5164 | 6982 { |
| 5275 | 6983 octave_idx_type info; double rcond; |
| 5164 | 6984 return solve (mattype, b, info, rcond); |
| 6985 } | |
| 6986 | |
| 6987 ColumnVector | |
| 5785 | 6988 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info) const |
| 5164 | 6989 { |
| 6990 double rcond; | |
| 6991 return solve (mattype, b, info, rcond); | |
| 6992 } | |
| 6993 | |
| 6994 ColumnVector | |
| 5785 | 6995 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond) const |
| 5164 | 6996 { |
| 6997 return solve (mattype, b, info, rcond, 0); | |
| 6998 } | |
| 6999 | |
| 7000 ColumnVector | |
| 5785 | 7001 SparseMatrix::solve (MatrixType &mattype, const ColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7002 solve_singularity_handler sing_handler) const |
| 7003 { | |
| 7004 Matrix tmp (b); | |
| 5275 | 7005 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7006 } |
| 7007 | |
| 7008 ComplexColumnVector | |
| 5785 | 7009 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b) const |
| 5164 | 7010 { |
| 5275 | 7011 octave_idx_type info; |
| 5164 | 7012 double rcond; |
| 7013 return solve (mattype, b, info, rcond, 0); | |
| 7014 } | |
| 7015 | |
| 7016 ComplexColumnVector | |
| 5785 | 7017 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info) const |
| 5164 | 7018 { |
| 7019 double rcond; | |
| 7020 return solve (mattype, b, info, rcond, 0); | |
| 7021 } | |
| 7022 | |
| 7023 ComplexColumnVector | |
| 5785 | 7024 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7025 double& rcond) const |
| 7026 { | |
| 7027 return solve (mattype, b, info, rcond, 0); | |
| 7028 } | |
| 7029 | |
| 7030 ComplexColumnVector | |
| 5785 | 7031 SparseMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7032 solve_singularity_handler sing_handler) const |
| 7033 { | |
| 7034 ComplexMatrix tmp (b); | |
| 5275 | 7035 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7036 } |
| 7037 | |
| 7038 Matrix | |
| 7039 SparseMatrix::solve (const Matrix& b) const | |
| 7040 { | |
| 5275 | 7041 octave_idx_type info; |
| 5164 | 7042 double rcond; |
| 7043 return solve (b, info, rcond, 0); | |
| 7044 } | |
| 7045 | |
| 7046 Matrix | |
| 5275 | 7047 SparseMatrix::solve (const Matrix& b, octave_idx_type& info) const |
| 5164 | 7048 { |
| 7049 double rcond; | |
| 7050 return solve (b, info, rcond, 0); | |
| 7051 } | |
| 7052 | |
| 7053 Matrix | |
| 5275 | 7054 SparseMatrix::solve (const Matrix& b, octave_idx_type& info, |
| 5164 | 7055 double& rcond) const |
| 7056 { | |
| 7057 return solve (b, info, rcond, 0); | |
| 7058 } | |
| 7059 | |
| 7060 Matrix | |
| 5275 | 7061 SparseMatrix::solve (const Matrix& b, octave_idx_type& err, |
| 5164 | 7062 double& rcond, |
| 7063 solve_singularity_handler sing_handler) const | |
| 7064 { | |
| 5785 | 7065 MatrixType mattype (*this); |
| 5164 | 7066 return solve (mattype, b, err, rcond, sing_handler); |
| 7067 } | |
| 7068 | |
| 7069 SparseMatrix | |
| 7070 SparseMatrix::solve (const SparseMatrix& b) const | |
| 7071 { | |
| 5275 | 7072 octave_idx_type info; |
| 5164 | 7073 double rcond; |
| 7074 return solve (b, info, rcond, 0); | |
| 7075 } | |
| 7076 | |
| 7077 SparseMatrix | |
| 7078 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7079 octave_idx_type& info) const |
| 5164 | 7080 { |
| 7081 double rcond; | |
| 7082 return solve (b, info, rcond, 0); | |
| 7083 } | |
| 7084 | |
| 7085 SparseMatrix | |
| 7086 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7087 octave_idx_type& info, double& rcond) const |
| 5164 | 7088 { |
| 7089 return solve (b, info, rcond, 0); | |
| 7090 } | |
| 7091 | |
| 7092 SparseMatrix | |
| 7093 SparseMatrix::solve (const SparseMatrix& b, | |
| 5275 | 7094 octave_idx_type& err, double& rcond, |
| 5164 | 7095 solve_singularity_handler sing_handler) const |
| 7096 { | |
| 5785 | 7097 MatrixType mattype (*this); |
| 5164 | 7098 return solve (mattype, b, err, rcond, sing_handler); |
| 7099 } | |
| 7100 | |
| 7101 ComplexMatrix | |
| 7102 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7103 octave_idx_type& info) const |
| 5164 | 7104 { |
| 7105 double rcond; | |
| 7106 return solve (b, info, rcond, 0); | |
| 7107 } | |
| 7108 | |
| 7109 ComplexMatrix | |
| 7110 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7111 octave_idx_type& info, double& rcond) const |
| 5164 | 7112 { |
| 7113 return solve (b, info, rcond, 0); | |
| 7114 } | |
| 7115 | |
| 7116 ComplexMatrix | |
| 7117 SparseMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7118 octave_idx_type& err, double& rcond, |
| 5164 | 7119 solve_singularity_handler sing_handler) const |
| 7120 { | |
| 5785 | 7121 MatrixType mattype (*this); |
| 5164 | 7122 return solve (mattype, b, err, rcond, sing_handler); |
| 7123 } | |
| 7124 | |
| 7125 SparseComplexMatrix | |
| 7126 SparseMatrix::solve (const SparseComplexMatrix& b) const | |
| 7127 { | |
| 5275 | 7128 octave_idx_type info; |
| 5164 | 7129 double rcond; |
| 7130 return solve (b, info, rcond, 0); | |
| 7131 } | |
| 7132 | |
| 7133 SparseComplexMatrix | |
| 7134 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7135 octave_idx_type& info) const |
| 5164 | 7136 { |
| 7137 double rcond; | |
| 7138 return solve (b, info, rcond, 0); | |
| 7139 } | |
| 7140 | |
| 7141 SparseComplexMatrix | |
| 7142 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7143 octave_idx_type& info, double& rcond) const |
| 5164 | 7144 { |
| 7145 return solve (b, info, rcond, 0); | |
| 7146 } | |
| 7147 | |
| 7148 SparseComplexMatrix | |
| 7149 SparseMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7150 octave_idx_type& err, double& rcond, |
| 5164 | 7151 solve_singularity_handler sing_handler) const |
| 7152 { | |
| 5785 | 7153 MatrixType mattype (*this); |
| 5164 | 7154 return solve (mattype, b, err, rcond, sing_handler); |
| 7155 } | |
| 7156 | |
| 7157 ColumnVector | |
| 7158 SparseMatrix::solve (const ColumnVector& b) const | |
| 7159 { | |
| 5275 | 7160 octave_idx_type info; double rcond; |
| 5164 | 7161 return solve (b, info, rcond); |
| 7162 } | |
| 7163 | |
| 7164 ColumnVector | |
| 5275 | 7165 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info) const |
| 5164 | 7166 { |
| 7167 double rcond; | |
| 7168 return solve (b, info, rcond); | |
| 7169 } | |
| 7170 | |
| 7171 ColumnVector | |
| 5275 | 7172 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond) const |
| 5164 | 7173 { |
| 7174 return solve (b, info, rcond, 0); | |
| 7175 } | |
| 7176 | |
| 7177 ColumnVector | |
| 5275 | 7178 SparseMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7179 solve_singularity_handler sing_handler) const |
| 7180 { | |
| 7181 Matrix tmp (b); | |
| 5275 | 7182 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7183 } |
| 7184 | |
| 7185 ComplexColumnVector | |
| 7186 SparseMatrix::solve (const ComplexColumnVector& b) const | |
| 7187 { | |
| 5275 | 7188 octave_idx_type info; |
| 5164 | 7189 double rcond; |
| 7190 return solve (b, info, rcond, 0); | |
| 7191 } | |
| 7192 | |
| 7193 ComplexColumnVector | |
| 5275 | 7194 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const |
| 5164 | 7195 { |
| 7196 double rcond; | |
| 7197 return solve (b, info, rcond, 0); | |
| 7198 } | |
| 7199 | |
| 7200 ComplexColumnVector | |
| 5275 | 7201 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7202 double& rcond) const |
| 7203 { | |
| 7204 return solve (b, info, rcond, 0); | |
| 7205 } | |
| 7206 | |
| 7207 ComplexColumnVector | |
| 5275 | 7208 SparseMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7209 solve_singularity_handler sing_handler) const |
| 7210 { | |
| 7211 ComplexMatrix tmp (b); | |
| 5275 | 7212 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7213 } |
| 7214 | |
| 7215 // other operations. | |
| 7216 | |
| 7217 bool | |
| 7218 SparseMatrix::any_element_is_negative (bool neg_zero) const | |
| 7219 { | |
| 5681 | 7220 octave_idx_type nel = nnz (); |
| 5164 | 7221 |
| 7222 if (neg_zero) | |
| 7223 { | |
| 5275 | 7224 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7225 if (lo_ieee_signbit (data (i))) |
| 7226 return true; | |
| 7227 } | |
| 7228 else | |
| 7229 { | |
| 5275 | 7230 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7231 if (data (i) < 0) |
| 7232 return true; | |
| 7233 } | |
| 7234 | |
| 7235 return false; | |
| 7236 } | |
| 7237 | |
| 7238 bool | |
| 7239 SparseMatrix::any_element_is_inf_or_nan (void) const | |
| 7240 { | |
| 5681 | 7241 octave_idx_type nel = nnz (); |
| 5275 | 7242 |
| 7243 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7244 { |
| 7245 double val = data (i); | |
| 7246 if (xisinf (val) || xisnan (val)) | |
| 7247 return true; | |
| 7248 } | |
| 7249 | |
| 7250 return false; | |
| 7251 } | |
| 7252 | |
| 7253 bool | |
| 6989 | 7254 SparseMatrix::all_elements_are_zero (void) const |
| 7255 { | |
| 7256 octave_idx_type nel = nnz (); | |
| 7257 | |
| 7258 for (octave_idx_type i = 0; i < nel; i++) | |
| 7259 if (data (i) != 0) | |
| 7260 return false; | |
| 7261 | |
| 7262 return true; | |
| 7263 } | |
| 7264 | |
| 7265 bool | |
| 5164 | 7266 SparseMatrix::all_elements_are_int_or_inf_or_nan (void) const |
| 7267 { | |
| 5681 | 7268 octave_idx_type nel = nnz (); |
| 5275 | 7269 |
| 7270 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7271 { |
| 7272 double val = data (i); | |
| 7273 if (xisnan (val) || D_NINT (val) == val) | |
| 7274 continue; | |
| 7275 else | |
| 7276 return false; | |
| 7277 } | |
| 7278 | |
| 7279 return true; | |
| 7280 } | |
| 7281 | |
| 7282 // Return nonzero if any element of M is not an integer. Also extract | |
| 7283 // the largest and smallest values and return them in MAX_VAL and MIN_VAL. | |
| 7284 | |
| 7285 bool | |
| 7286 SparseMatrix::all_integers (double& max_val, double& min_val) const | |
| 7287 { | |
| 5681 | 7288 octave_idx_type nel = nnz (); |
| 5164 | 7289 |
| 7290 if (nel == 0) | |
| 7291 return false; | |
| 7292 | |
| 7293 max_val = data (0); | |
| 7294 min_val = data (0); | |
| 7295 | |
| 5275 | 7296 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7297 { |
| 7298 double val = data (i); | |
| 7299 | |
| 7300 if (val > max_val) | |
| 7301 max_val = val; | |
| 7302 | |
| 7303 if (val < min_val) | |
| 7304 min_val = val; | |
| 7305 | |
| 7306 if (D_NINT (val) != val) | |
| 7307 return false; | |
| 7308 } | |
| 7309 | |
| 7310 return true; | |
| 7311 } | |
| 7312 | |
| 7313 bool | |
| 7314 SparseMatrix::too_large_for_float (void) const | |
| 7315 { | |
| 5681 | 7316 octave_idx_type nel = nnz (); |
| 5275 | 7317 |
| 7318 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7319 { |
| 7320 double val = data (i); | |
| 7321 | |
| 7322 if (val > FLT_MAX || val < FLT_MIN) | |
| 7323 return true; | |
| 7324 } | |
| 7325 | |
| 7326 return false; | |
| 7327 } | |
| 7328 | |
| 7329 SparseBoolMatrix | |
| 7330 SparseMatrix::operator ! (void) const | |
| 7331 { | |
| 5275 | 7332 octave_idx_type nr = rows (); |
| 7333 octave_idx_type nc = cols (); | |
| 5681 | 7334 octave_idx_type nz1 = nnz (); |
| 5275 | 7335 octave_idx_type nz2 = nr*nc - nz1; |
| 5164 | 7336 |
| 7337 SparseBoolMatrix r (nr, nc, nz2); | |
| 7338 | |
| 5275 | 7339 octave_idx_type ii = 0; |
| 7340 octave_idx_type jj = 0; | |
| 5164 | 7341 r.cidx (0) = 0; |
| 5275 | 7342 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 7343 { |
| 5275 | 7344 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 7345 { |
| 7346 if (jj < cidx(i+1) && ridx(jj) == j) | |
| 7347 jj++; | |
| 7348 else | |
| 7349 { | |
| 7350 r.data(ii) = true; | |
| 7351 r.ridx(ii++) = j; | |
| 7352 } | |
| 7353 } | |
| 7354 r.cidx (i+1) = ii; | |
| 7355 } | |
| 7356 | |
| 7357 return r; | |
| 7358 } | |
| 7359 | |
| 5775 | 7360 // FIXME Do these really belong here? Maybe they should be |
| 5164 | 7361 // in a base class? |
| 7362 | |
| 7363 SparseBoolMatrix | |
| 7364 SparseMatrix::all (int dim) const | |
| 7365 { | |
| 7366 SPARSE_ALL_OP (dim); | |
| 7367 } | |
| 7368 | |
| 7369 SparseBoolMatrix | |
| 7370 SparseMatrix::any (int dim) const | |
| 7371 { | |
| 7372 SPARSE_ANY_OP (dim); | |
| 7373 } | |
| 7374 | |
| 7375 SparseMatrix | |
| 7376 SparseMatrix::cumprod (int dim) const | |
| 7377 { | |
| 7378 SPARSE_CUMPROD (SparseMatrix, double, cumprod); | |
| 7379 } | |
| 7380 | |
| 7381 SparseMatrix | |
| 7382 SparseMatrix::cumsum (int dim) const | |
| 7383 { | |
| 7384 SPARSE_CUMSUM (SparseMatrix, double, cumsum); | |
| 7385 } | |
| 7386 | |
| 7387 SparseMatrix | |
| 7388 SparseMatrix::prod (int dim) const | |
| 7389 { | |
| 7269 | 7390 if ((rows() == 1 && dim == -1) || dim == 1) |
| 7391 return transpose (). prod (0). transpose(); | |
| 7392 else | |
| 7393 { | |
| 7394 SPARSE_REDUCTION_OP (SparseMatrix, double, *=, | |
| 7395 (cidx(j+1) - cidx(j) < nc ? 0.0 : 1.0), 1.0); | |
| 7396 } | |
| 5164 | 7397 } |
| 7398 | |
| 7399 SparseMatrix | |
| 7400 SparseMatrix::sum (int dim) const | |
| 7401 { | |
| 7402 SPARSE_REDUCTION_OP (SparseMatrix, double, +=, 0.0, 0.0); | |
| 7403 } | |
| 7404 | |
| 7405 SparseMatrix | |
| 7406 SparseMatrix::sumsq (int dim) const | |
| 7407 { | |
| 7408 #define ROW_EXPR \ | |
| 7269 | 7409 double d = data (i); \ |
| 7410 tmp[ridx(i)] += d * d | |
| 5164 | 7411 |
| 7412 #define COL_EXPR \ | |
| 7269 | 7413 double d = data (i); \ |
| 5164 | 7414 tmp[j] += d * d |
| 7415 | |
| 7416 SPARSE_BASE_REDUCTION_OP (SparseMatrix, double, ROW_EXPR, COL_EXPR, | |
| 7417 0.0, 0.0); | |
| 7418 | |
| 7419 #undef ROW_EXPR | |
| 7420 #undef COL_EXPR | |
| 7421 } | |
| 7422 | |
| 7423 SparseMatrix | |
| 7424 SparseMatrix::abs (void) const | |
| 7425 { | |
| 5681 | 7426 octave_idx_type nz = nnz (); |
| 5164 | 7427 |
| 7428 SparseMatrix retval (*this); | |
| 7429 | |
| 5275 | 7430 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7431 retval.data(i) = fabs(retval.data(i)); |
| 7432 | |
| 7433 return retval; | |
| 7434 } | |
| 7435 | |
| 7436 SparseMatrix | |
| 5275 | 7437 SparseMatrix::diag (octave_idx_type k) const |
| 5164 | 7438 { |
| 5275 | 7439 octave_idx_type nnr = rows (); |
| 7440 octave_idx_type nnc = cols (); | |
| 5164 | 7441 |
| 7442 if (k > 0) | |
| 7443 nnc -= k; | |
| 7444 else if (k < 0) | |
| 7445 nnr += k; | |
| 7446 | |
| 7447 SparseMatrix d; | |
| 7448 | |
| 7449 if (nnr > 0 && nnc > 0) | |
| 7450 { | |
| 5275 | 7451 octave_idx_type ndiag = (nnr < nnc) ? nnr : nnc; |
| 5164 | 7452 |
| 7453 // Count the number of non-zero elements | |
| 5275 | 7454 octave_idx_type nel = 0; |
| 5164 | 7455 if (k > 0) |
| 7456 { | |
| 5275 | 7457 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7458 if (elem (i, i+k) != 0.) |
| 7459 nel++; | |
| 7460 } | |
| 7461 else if ( k < 0) | |
| 7462 { | |
| 5275 | 7463 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7464 if (elem (i-k, i) != 0.) |
| 7465 nel++; | |
| 7466 } | |
| 7467 else | |
| 7468 { | |
| 5275 | 7469 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7470 if (elem (i, i) != 0.) |
| 7471 nel++; | |
| 7472 } | |
| 7473 | |
| 7474 d = SparseMatrix (ndiag, 1, nel); | |
| 7475 d.xcidx (0) = 0; | |
| 7476 d.xcidx (1) = nel; | |
| 7477 | |
| 5275 | 7478 octave_idx_type ii = 0; |
| 5164 | 7479 if (k > 0) |
| 7480 { | |
| 5275 | 7481 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7482 { |
| 7483 double tmp = elem (i, i+k); | |
| 7484 if (tmp != 0.) | |
| 7485 { | |
| 7486 d.xdata (ii) = tmp; | |
| 7487 d.xridx (ii++) = i; | |
| 7488 } | |
| 7489 } | |
| 7490 } | |
| 7491 else if ( k < 0) | |
| 7492 { | |
| 5275 | 7493 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7494 { |
| 7495 double tmp = elem (i-k, i); | |
| 7496 if (tmp != 0.) | |
| 7497 { | |
| 7498 d.xdata (ii) = tmp; | |
| 7499 d.xridx (ii++) = i; | |
| 7500 } | |
| 7501 } | |
| 7502 } | |
| 7503 else | |
| 7504 { | |
| 5275 | 7505 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7506 { |
| 7507 double tmp = elem (i, i); | |
| 7508 if (tmp != 0.) | |
| 7509 { | |
| 7510 d.xdata (ii) = tmp; | |
| 7511 d.xridx (ii++) = i; | |
| 7512 } | |
| 7513 } | |
| 7514 } | |
| 7515 } | |
| 7516 else | |
| 7517 (*current_liboctave_error_handler) | |
| 7518 ("diag: requested diagonal out of range"); | |
| 7519 | |
| 7520 return d; | |
| 7521 } | |
| 7522 | |
| 7523 Matrix | |
| 7524 SparseMatrix::matrix_value (void) const | |
| 7525 { | |
| 5275 | 7526 octave_idx_type nr = rows (); |
| 7527 octave_idx_type nc = cols (); | |
| 5164 | 7528 |
| 7529 Matrix retval (nr, nc, 0.0); | |
| 5275 | 7530 for (octave_idx_type j = 0; j < nc; j++) |
| 7531 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 7532 retval.elem (ridx(i), j) = data (i); |
| 7533 | |
| 7534 return retval; | |
| 7535 } | |
| 7536 | |
|
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7537 SparseMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7538 SparseMatrix::map (dmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7539 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7540 SparseMatrix result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7541 double f_zero = fcn (0.); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7542 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7543 if (f_zero != 0.) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7544 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7545 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7546 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7547 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7548 result = SparseMatrix (nr, nc, f_zero); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7549 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7550 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7551 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7552 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7553 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7554 /* Use data instead of elem for better performance. */ |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7555 result.data (ridx (i) + j * nr) = fcn (data(i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7556 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7557 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7558 result.maybe_compress (true); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7559 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7560 else |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7561 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7562 octave_idx_type nz = nnz (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7563 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7564 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7565 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7566 result = SparseMatrix (nr, nc, nz); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7567 octave_idx_type ii = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7568 result.cidx (ii) = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7569 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7570 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7571 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7572 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7573 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7574 double val = fcn (data (i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7575 if (val != 0.0) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7576 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7577 result.data (ii) = val; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7578 result.ridx (ii++) = ridx (i); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7579 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7580 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7581 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7582 result.cidx (j+1) = ii; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7583 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7584 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7585 result.maybe_compress (false); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7586 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7587 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7588 return result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7589 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7590 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7591 SparseComplexMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7592 SparseMatrix::map (cmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7593 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7594 SparseComplexMatrix result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7595 Complex f_zero = fcn (0.); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7596 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7597 if (f_zero != 0.) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7598 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7599 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7600 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7601 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7602 result = SparseComplexMatrix (nr, nc, f_zero); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7603 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7604 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7605 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7606 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7607 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7608 /* Use data instead of elem for better performance. */ |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7609 result.data (ridx (i) + j * nr) = fcn (Complex (data(i), 0.0)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7610 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7611 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7612 result.maybe_compress (true); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7613 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7614 else |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7615 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7616 octave_idx_type nz = nnz (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7617 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7618 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7619 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7620 result = SparseComplexMatrix (nr, nc, nz); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7621 Complex zero = Complex (0.0, 0.0); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7622 octave_idx_type ii = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7623 result.cidx (ii) = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7624 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7625 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7626 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7627 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7628 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7629 Complex val = fcn (Complex (data (i), 0.0)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7630 if (val != zero) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7631 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7632 result.data (ii) = val; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7633 result.ridx (ii++) = ridx (i); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7634 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7635 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7636 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7637 result.cidx (j+1) = ii; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7638 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7639 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7640 result.maybe_compress (false); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7641 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7642 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7643 return result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7644 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7645 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7646 SparseBoolMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7647 SparseMatrix::map (bmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7648 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7649 SparseBoolMatrix result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7650 bool f_zero = fcn (0.); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7651 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7652 if (f_zero) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7653 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7654 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7655 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7656 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7657 result = SparseBoolMatrix (nr, nc, f_zero); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7658 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7659 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7660 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7661 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7662 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7663 /* Use data instead of elem for better performance. */ |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7664 result.data (ridx (i) + j * nr) = fcn (data(i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7665 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7666 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7667 result.maybe_compress (true); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7668 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7669 else |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7670 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7671 octave_idx_type nz = nnz (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7672 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7673 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7674 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7675 result = SparseBoolMatrix (nr, nc, nz); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7676 octave_idx_type ii = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7677 result.cidx (ii) = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7678 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7679 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7680 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7681 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7682 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7683 bool val = fcn (data (i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7684 if (val) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7685 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7686 result.data (ii) = val; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7687 result.ridx (ii++) = ridx (i); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7688 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7689 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7690 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7691 result.cidx (j+1) = ii; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7692 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7693 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7694 result.maybe_compress (false); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7695 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7696 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7697 return result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7698 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7699 |
| 5164 | 7700 std::ostream& |
| 7701 operator << (std::ostream& os, const SparseMatrix& a) | |
| 7702 { | |
| 5275 | 7703 octave_idx_type nc = a.cols (); |
| 5164 | 7704 |
| 7705 // add one to the printed indices to go from | |
| 7706 // zero-based to one-based arrays | |
| 5275 | 7707 for (octave_idx_type j = 0; j < nc; j++) { |
| 5164 | 7708 OCTAVE_QUIT; |
| 5275 | 7709 for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) { |
| 5164 | 7710 os << a.ridx(i) + 1 << " " << j + 1 << " "; |
| 7711 octave_write_double (os, a.data(i)); | |
| 7712 os << "\n"; | |
| 7713 } | |
| 7714 } | |
| 7715 | |
| 7716 return os; | |
| 7717 } | |
| 7718 | |
| 7719 std::istream& | |
| 7720 operator >> (std::istream& is, SparseMatrix& a) | |
| 7721 { | |
| 5275 | 7722 octave_idx_type nr = a.rows (); |
| 7723 octave_idx_type nc = a.cols (); | |
| 5604 | 7724 octave_idx_type nz = a.nzmax (); |
| 5164 | 7725 |
| 7726 if (nr < 1 || nc < 1) | |
| 7727 is.clear (std::ios::badbit); | |
| 7728 else | |
| 7729 { | |
| 5275 | 7730 octave_idx_type itmp, jtmp, jold = 0; |
| 5164 | 7731 double tmp; |
| 5275 | 7732 octave_idx_type ii = 0; |
| 5164 | 7733 |
| 7734 a.cidx (0) = 0; | |
| 5275 | 7735 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7736 { |
| 7737 is >> itmp; | |
| 7738 itmp--; | |
| 7739 is >> jtmp; | |
| 7740 jtmp--; | |
| 7741 tmp = octave_read_double (is); | |
| 7742 | |
| 7743 if (is) | |
| 7744 { | |
| 7745 if (jold != jtmp) | |
| 7746 { | |
| 5275 | 7747 for (octave_idx_type j = jold; j < jtmp; j++) |
| 5164 | 7748 a.cidx(j+1) = ii; |
| 7749 | |
| 7750 jold = jtmp; | |
| 7751 } | |
| 7752 a.data (ii) = tmp; | |
| 7753 a.ridx (ii++) = itmp; | |
| 7754 } | |
| 7755 else | |
| 7756 goto done; | |
| 7757 } | |
| 7758 | |
| 5275 | 7759 for (octave_idx_type j = jold; j < nc; j++) |
| 5164 | 7760 a.cidx(j+1) = ii; |
| 7761 } | |
| 7762 | |
| 7763 done: | |
| 7764 | |
| 7765 return is; | |
| 7766 } | |
| 7767 | |
| 7768 SparseMatrix | |
| 7769 SparseMatrix::squeeze (void) const | |
| 7770 { | |
| 7771 return MSparse<double>::squeeze (); | |
| 7772 } | |
| 7773 | |
| 7774 SparseMatrix | |
| 7775 SparseMatrix::index (idx_vector& i, int resize_ok) const | |
| 7776 { | |
| 7777 return MSparse<double>::index (i, resize_ok); | |
| 7778 } | |
| 7779 | |
| 7780 SparseMatrix | |
| 7781 SparseMatrix::index (idx_vector& i, idx_vector& j, int resize_ok) const | |
| 7782 { | |
| 7783 return MSparse<double>::index (i, j, resize_ok); | |
| 7784 } | |
| 7785 | |
| 7786 SparseMatrix | |
| 7787 SparseMatrix::index (Array<idx_vector>& ra_idx, int resize_ok) const | |
| 7788 { | |
| 7789 return MSparse<double>::index (ra_idx, resize_ok); | |
| 7790 } | |
| 7791 | |
| 7792 SparseMatrix | |
| 7793 SparseMatrix::reshape (const dim_vector& new_dims) const | |
| 7794 { | |
| 7795 return MSparse<double>::reshape (new_dims); | |
| 7796 } | |
| 7797 | |
| 7798 SparseMatrix | |
| 5275 | 7799 SparseMatrix::permute (const Array<octave_idx_type>& vec, bool inv) const |
| 5164 | 7800 { |
| 7801 return MSparse<double>::permute (vec, inv); | |
| 7802 } | |
| 7803 | |
| 7804 SparseMatrix | |
| 5275 | 7805 SparseMatrix::ipermute (const Array<octave_idx_type>& vec) const |
| 5164 | 7806 { |
| 7807 return MSparse<double>::ipermute (vec); | |
| 7808 } | |
| 7809 | |
| 7810 // matrix by matrix -> matrix operations | |
| 7811 | |
| 7812 SparseMatrix | |
| 7813 operator * (const SparseMatrix& m, const SparseMatrix& a) | |
| 7814 { | |
| 5681 | 7815 SPARSE_SPARSE_MUL (SparseMatrix, double, double); |
| 5164 | 7816 } |
| 7817 | |
| 5429 | 7818 Matrix |
| 7819 operator * (const Matrix& m, const SparseMatrix& a) | |
| 7820 { | |
| 5681 | 7821 FULL_SPARSE_MUL (Matrix, double, 0.); |
| 5429 | 7822 } |
| 7823 | |
| 7824 Matrix | |
| 7825 operator * (const SparseMatrix& m, const Matrix& a) | |
| 7826 { | |
| 5681 | 7827 SPARSE_FULL_MUL (Matrix, double, 0.); |
| 5429 | 7828 } |
| 7829 | |
| 5775 | 7830 // FIXME -- it would be nice to share code among the min/max |
| 5164 | 7831 // functions below. |
| 7832 | |
| 7833 #define EMPTY_RETURN_CHECK(T) \ | |
| 7834 if (nr == 0 || nc == 0) \ | |
| 7835 return T (nr, nc); | |
| 7836 | |
| 7837 SparseMatrix | |
| 7838 min (double d, const SparseMatrix& m) | |
| 7839 { | |
| 7840 SparseMatrix result; | |
| 7841 | |
| 5275 | 7842 octave_idx_type nr = m.rows (); |
| 7843 octave_idx_type nc = m.columns (); | |
| 5164 | 7844 |
| 7845 EMPTY_RETURN_CHECK (SparseMatrix); | |
| 7846 | |
| 7847 // Count the number of non-zero elements | |
| 7848 if (d < 0.) | |
| 7849 { | |
| 7850 result = SparseMatrix (nr, nc, d); | |
| 5275 | 7851 for (octave_idx_type j = 0; j < nc; j++) |
| 7852 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7853 { |
| 7854 double tmp = xmin (d, m.data (i)); | |
| 7855 if (tmp != 0.) | |
| 7856 { | |
| 5275 | 7857 octave_idx_type idx = m.ridx(i) + j * nr; |
| 5164 | 7858 result.xdata(idx) = tmp; |
| 7859 result.xridx(idx) = m.ridx(i); | |
| 7860 } | |
| 7861 } | |
| 7862 } | |
| 7863 else | |
| 7864 { | |
| 5275 | 7865 octave_idx_type nel = 0; |
| 7866 for (octave_idx_type j = 0; j < nc; j++) | |
| 7867 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7868 if (xmin (d, m.data (i)) != 0.) |
| 7869 nel++; | |
| 7870 | |
| 7871 result = SparseMatrix (nr, nc, nel); | |
| 7872 | |
| 5275 | 7873 octave_idx_type ii = 0; |
| 5164 | 7874 result.xcidx(0) = 0; |
| 5275 | 7875 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 7876 { |
| 5275 | 7877 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
| 5164 | 7878 { |
| 7879 double tmp = xmin (d, m.data (i)); | |
| 7880 | |
| 7881 if (tmp != 0.) | |
| 7882 { | |
| 7883 result.xdata(ii) = tmp; | |
| 7884 result.xridx(ii++) = m.ridx(i); | |
| 7885 } | |
| 7886 } | |
| 7887 result.xcidx(j+1) = ii; | |
| 7888 } | |
| 7889 } | |
| 7890 | |
| 7891 return result; | |
| 7892 } | |
| 7893 | |
| 7894 SparseMatrix | |
| 7895 min (const SparseMatrix& m, double d) | |
| 7896 { | |
| 7897 return min (d, m); | |
| 7898 } | |
| 7899 | |
| 7900 SparseMatrix | |
| 7901 min (const SparseMatrix& a, const SparseMatrix& b) | |
| 7902 { | |
| 7903 SparseMatrix r; | |
| 7904 | |
| 7905 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 7906 { | |
| 5275 | 7907 octave_idx_type a_nr = a.rows (); |
| 7908 octave_idx_type a_nc = a.cols (); | |
| 7909 | |
| 7910 octave_idx_type b_nr = b.rows (); | |
| 7911 octave_idx_type b_nc = b.cols (); | |
| 5164 | 7912 |
| 7913 if (a_nr != b_nr || a_nc != b_nc) | |
| 7914 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 7915 else | |
| 7916 { | |
| 5681 | 7917 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 7918 |
| 5275 | 7919 octave_idx_type jx = 0; |
| 5164 | 7920 r.cidx (0) = 0; |
| 5275 | 7921 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 7922 { |
| 5275 | 7923 octave_idx_type ja = a.cidx(i); |
| 7924 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 7925 bool ja_lt_max= ja < ja_max; |
| 7926 | |
| 5275 | 7927 octave_idx_type jb = b.cidx(i); |
| 7928 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 7929 bool jb_lt_max = jb < jb_max; |
| 7930 | |
| 7931 while (ja_lt_max || jb_lt_max ) | |
| 7932 { | |
| 7933 OCTAVE_QUIT; | |
| 7934 if ((! jb_lt_max) || | |
| 7935 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 7936 { | |
| 7937 double tmp = xmin (a.data(ja), 0.); | |
| 7938 if (tmp != 0.) | |
| 7939 { | |
| 7940 r.ridx(jx) = a.ridx(ja); | |
| 7941 r.data(jx) = tmp; | |
| 7942 jx++; | |
| 7943 } | |
| 7944 ja++; | |
| 7945 ja_lt_max= ja < ja_max; | |
| 7946 } | |
| 7947 else if (( !ja_lt_max ) || | |
| 7948 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 7949 { | |
| 7950 double tmp = xmin (0., b.data(jb)); | |
| 7951 if (tmp != 0.) | |
| 7952 { | |
| 7953 r.ridx(jx) = b.ridx(jb); | |
| 7954 r.data(jx) = tmp; | |
| 7955 jx++; | |
| 7956 } | |
| 7957 jb++; | |
| 7958 jb_lt_max= jb < jb_max; | |
| 7959 } | |
| 7960 else | |
| 7961 { | |
| 7962 double tmp = xmin (a.data(ja), b.data(jb)); | |
| 7963 if (tmp != 0.) | |
| 7964 { | |
| 7965 r.data(jx) = tmp; | |
| 7966 r.ridx(jx) = a.ridx(ja); | |
| 7967 jx++; | |
| 7968 } | |
| 7969 ja++; | |
| 7970 ja_lt_max= ja < ja_max; | |
| 7971 jb++; | |
| 7972 jb_lt_max= jb < jb_max; | |
| 7973 } | |
| 7974 } | |
| 7975 r.cidx(i+1) = jx; | |
| 7976 } | |
| 7977 | |
| 7978 r.maybe_compress (); | |
| 7979 } | |
| 7980 } | |
| 7981 else | |
| 7982 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 7983 | |
| 7984 return r; | |
| 7985 } | |
| 7986 | |
| 7987 SparseMatrix | |
| 7988 max (double d, const SparseMatrix& m) | |
| 7989 { | |
| 7990 SparseMatrix result; | |
| 7991 | |
| 5275 | 7992 octave_idx_type nr = m.rows (); |
| 7993 octave_idx_type nc = m.columns (); | |
| 5164 | 7994 |
| 7995 EMPTY_RETURN_CHECK (SparseMatrix); | |
| 7996 | |
| 7997 // Count the number of non-zero elements | |
| 7998 if (d > 0.) | |
| 7999 { | |
| 8000 result = SparseMatrix (nr, nc, d); | |
| 5275 | 8001 for (octave_idx_type j = 0; j < nc; j++) |
| 8002 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 8003 { |
| 8004 double tmp = xmax (d, m.data (i)); | |
| 8005 | |
| 8006 if (tmp != 0.) | |
| 8007 { | |
| 5275 | 8008 octave_idx_type idx = m.ridx(i) + j * nr; |
| 5164 | 8009 result.xdata(idx) = tmp; |
| 8010 result.xridx(idx) = m.ridx(i); | |
| 8011 } | |
| 8012 } | |
| 8013 } | |
| 8014 else | |
| 8015 { | |
| 5275 | 8016 octave_idx_type nel = 0; |
| 8017 for (octave_idx_type j = 0; j < nc; j++) | |
| 8018 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 8019 if (xmax (d, m.data (i)) != 0.) |
| 8020 nel++; | |
| 8021 | |
| 8022 result = SparseMatrix (nr, nc, nel); | |
| 8023 | |
| 5275 | 8024 octave_idx_type ii = 0; |
| 5164 | 8025 result.xcidx(0) = 0; |
| 5275 | 8026 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 8027 { |
| 5275 | 8028 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) |
| 5164 | 8029 { |
| 8030 double tmp = xmax (d, m.data (i)); | |
| 8031 if (tmp != 0.) | |
| 8032 { | |
| 8033 result.xdata(ii) = tmp; | |
| 8034 result.xridx(ii++) = m.ridx(i); | |
| 8035 } | |
| 8036 } | |
| 8037 result.xcidx(j+1) = ii; | |
| 8038 } | |
| 8039 } | |
| 8040 | |
| 8041 return result; | |
| 8042 } | |
| 8043 | |
| 8044 SparseMatrix | |
| 8045 max (const SparseMatrix& m, double d) | |
| 8046 { | |
| 8047 return max (d, m); | |
| 8048 } | |
| 8049 | |
| 8050 SparseMatrix | |
| 8051 max (const SparseMatrix& a, const SparseMatrix& b) | |
| 8052 { | |
| 8053 SparseMatrix r; | |
| 8054 | |
| 8055 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 8056 { | |
| 5275 | 8057 octave_idx_type a_nr = a.rows (); |
| 8058 octave_idx_type a_nc = a.cols (); | |
| 8059 | |
| 8060 octave_idx_type b_nr = b.rows (); | |
| 8061 octave_idx_type b_nc = b.cols (); | |
| 5164 | 8062 |
| 8063 if (a_nr != b_nr || a_nc != b_nc) | |
| 8064 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 8065 else | |
| 8066 { | |
| 5681 | 8067 r = SparseMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 8068 |
| 5275 | 8069 octave_idx_type jx = 0; |
| 5164 | 8070 r.cidx (0) = 0; |
| 5275 | 8071 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 8072 { |
| 5275 | 8073 octave_idx_type ja = a.cidx(i); |
| 8074 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 8075 bool ja_lt_max= ja < ja_max; |
| 8076 | |
| 5275 | 8077 octave_idx_type jb = b.cidx(i); |
| 8078 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 8079 bool jb_lt_max = jb < jb_max; |
| 8080 | |
| 8081 while (ja_lt_max || jb_lt_max ) | |
| 8082 { | |
| 8083 OCTAVE_QUIT; | |
| 8084 if ((! jb_lt_max) || | |
| 8085 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 8086 { | |
| 8087 double tmp = xmax (a.data(ja), 0.); | |
| 8088 if (tmp != 0.) | |
| 8089 { | |
| 8090 r.ridx(jx) = a.ridx(ja); | |
| 8091 r.data(jx) = tmp; | |
| 8092 jx++; | |
| 8093 } | |
| 8094 ja++; | |
| 8095 ja_lt_max= ja < ja_max; | |
| 8096 } | |
| 8097 else if (( !ja_lt_max ) || | |
| 8098 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 8099 { | |
| 8100 double tmp = xmax (0., b.data(jb)); | |
| 8101 if (tmp != 0.) | |
| 8102 { | |
| 8103 r.ridx(jx) = b.ridx(jb); | |
| 8104 r.data(jx) = tmp; | |
| 8105 jx++; | |
| 8106 } | |
| 8107 jb++; | |
| 8108 jb_lt_max= jb < jb_max; | |
| 8109 } | |
| 8110 else | |
| 8111 { | |
| 8112 double tmp = xmax (a.data(ja), b.data(jb)); | |
| 8113 if (tmp != 0.) | |
| 8114 { | |
| 8115 r.data(jx) = tmp; | |
| 8116 r.ridx(jx) = a.ridx(ja); | |
| 8117 jx++; | |
| 8118 } | |
| 8119 ja++; | |
| 8120 ja_lt_max= ja < ja_max; | |
| 8121 jb++; | |
| 8122 jb_lt_max= jb < jb_max; | |
| 8123 } | |
| 8124 } | |
| 8125 r.cidx(i+1) = jx; | |
| 8126 } | |
| 8127 | |
| 8128 r.maybe_compress (); | |
| 8129 } | |
| 8130 } | |
| 8131 else | |
| 8132 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 8133 | |
| 8134 return r; | |
| 8135 } | |
| 8136 | |
| 8137 SPARSE_SMS_CMP_OPS (SparseMatrix, 0.0, , double, 0.0, ) | |
| 8138 SPARSE_SMS_BOOL_OPS (SparseMatrix, double, 0.0) | |
| 8139 | |
| 8140 SPARSE_SSM_CMP_OPS (double, 0.0, , SparseMatrix, 0.0, ) | |
| 8141 SPARSE_SSM_BOOL_OPS (double, SparseMatrix, 0.0) | |
| 8142 | |
| 8143 SPARSE_SMSM_CMP_OPS (SparseMatrix, 0.0, , SparseMatrix, 0.0, ) | |
| 8144 SPARSE_SMSM_BOOL_OPS (SparseMatrix, SparseMatrix, 0.0) | |
| 8145 | |
| 8146 /* | |
| 8147 ;;; Local Variables: *** | |
| 8148 ;;; mode: C++ *** | |
| 8149 ;;; End: *** | |
| 8150 */ |