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