Mercurial > hg > octave-nkf
annotate liboctave/CSparse.cc @ 7503:8c32f95c2639
convert mapper functions to new format
| author | David Bateman <dbateman@free.fr> |
|---|---|
| date | Wed, 20 Feb 2008 04:22:50 -0500 |
| parents | 29980c6b8604 |
| children | f3c00dc0912b |
| rev | line source |
|---|---|
| 5164 | 1 /* |
| 2 | |
| 7017 | 3 Copyright (C) 2004, 2005, 2006, 2007 David Bateman |
| 7016 | 4 Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Andy Adler |
| 5 | |
| 6 This file is part of Octave. | |
| 5164 | 7 |
| 8 Octave is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
| 11 option) any later version. | |
| 5164 | 12 |
| 13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 7016 | 19 along with Octave; see the file COPYING. If not, see |
| 20 <http://www.gnu.org/licenses/>. | |
| 5164 | 21 |
| 22 */ | |
| 23 | |
| 24 #ifdef HAVE_CONFIG_H | |
| 25 #include <config.h> | |
| 26 #endif | |
| 27 | |
| 28 #include <cfloat> | |
| 29 | |
| 30 #include <iostream> | |
| 31 #include <vector> | |
| 32 | |
| 33 #include "quit.h" | |
| 34 #include "lo-ieee.h" | |
| 35 #include "lo-mappers.h" | |
| 36 #include "f77-fcn.h" | |
| 37 #include "dRowVector.h" | |
| 38 | |
| 39 #include "CSparse.h" | |
| 40 #include "boolSparse.h" | |
| 41 #include "dSparse.h" | |
| 42 #include "oct-spparms.h" | |
| 43 #include "SparseCmplxLU.h" | |
| 5451 | 44 #include "oct-sparse.h" |
| 5506 | 45 #include "sparse-util.h" |
| 46 #include "SparseCmplxCHOL.h" | |
| 5610 | 47 #include "SparseCmplxQR.h" |
| 5164 | 48 |
| 5681 | 49 // Define whether to use a basic QR solver or one that uses a Dulmange |
| 50 // Mendelsohn factorization to seperate the problem into under-determined, | |
| 51 // well-determined and over-determined parts and solves them seperately | |
| 52 #ifndef USE_QRSOLVE | |
| 53 #include "sparse-dmsolve.cc" | |
| 54 #endif | |
| 55 | |
| 5164 | 56 // Fortran functions we call. |
| 57 extern "C" | |
| 58 { | |
| 59 F77_RET_T | |
| 5275 | 60 F77_FUNC (zgbtrf, ZGBTRF) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, |
| 61 const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type*, octave_idx_type&); | |
| 5164 | 62 |
| 63 F77_RET_T | |
| 5275 | 64 F77_FUNC (zgbtrs, ZGBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 65 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
| 66 const Complex*, const octave_idx_type&, | |
| 67 const octave_idx_type*, Complex*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 68 F77_CHAR_ARG_LEN_DECL); |
| 69 | |
| 70 F77_RET_T | |
| 5275 | 71 F77_FUNC (zgbcon, ZGBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 72 const octave_idx_type&, const octave_idx_type&, Complex*, | |
| 73 const octave_idx_type&, const octave_idx_type*, const double&, | |
| 74 double&, Complex*, double*, octave_idx_type& | |
| 5164 | 75 F77_CHAR_ARG_LEN_DECL); |
| 76 | |
| 77 F77_RET_T | |
| 5275 | 78 F77_FUNC (zpbtrf, ZPBTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 79 const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 80 F77_CHAR_ARG_LEN_DECL); |
| 81 | |
| 82 F77_RET_T | |
| 5275 | 83 F77_FUNC (zpbtrs, ZPBTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 84 const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, | |
| 85 Complex*, const octave_idx_type&, octave_idx_type& | |
| 5164 | 86 F77_CHAR_ARG_LEN_DECL); |
| 87 | |
| 88 F77_RET_T | |
| 5275 | 89 F77_FUNC (zpbcon, ZPBCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 90 const octave_idx_type&, Complex*, const octave_idx_type&, | |
| 5681 | 91 const double&, double&, Complex*, double*, octave_idx_type& |
| 5164 | 92 F77_CHAR_ARG_LEN_DECL); |
| 93 | |
| 94 F77_RET_T | |
| 5275 | 95 F77_FUNC (zgttrf, ZGTTRF) (const octave_idx_type&, Complex*, Complex*, Complex*, |
| 96 Complex*, octave_idx_type*, octave_idx_type&); | |
| 5164 | 97 |
| 98 F77_RET_T | |
| 5275 | 99 F77_FUNC (zgttrs, ZGTTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 100 const octave_idx_type&, const Complex*, const Complex*, | |
| 101 const Complex*, const Complex*, const octave_idx_type*, | |
| 102 Complex *, const octave_idx_type&, octave_idx_type& | |
| 5164 | 103 F77_CHAR_ARG_LEN_DECL); |
| 104 | |
| 105 F77_RET_T | |
| 5322 | 106 F77_FUNC (zptsv, ZPTSV) (const octave_idx_type&, const octave_idx_type&, double*, Complex*, |
| 5275 | 107 Complex*, const octave_idx_type&, octave_idx_type&); |
| 5164 | 108 |
| 109 F77_RET_T | |
| 5275 | 110 F77_FUNC (zgtsv, ZGTSV) (const octave_idx_type&, const octave_idx_type&, Complex*, Complex*, |
| 111 Complex*, Complex*, const octave_idx_type&, octave_idx_type&); | |
| 5164 | 112 } |
| 113 | |
| 114 SparseComplexMatrix::SparseComplexMatrix (const SparseMatrix& a) | |
| 5681 | 115 : MSparse<Complex> (a.rows (), a.cols (), a.nnz ()) |
| 5164 | 116 { |
| 5275 | 117 octave_idx_type nc = cols (); |
| 5681 | 118 octave_idx_type nz = a.nnz (); |
| 5275 | 119 |
| 120 for (octave_idx_type i = 0; i < nc + 1; i++) | |
| 5164 | 121 cidx (i) = a.cidx (i); |
| 122 | |
| 5275 | 123 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 124 { |
| 5681 | 125 data (i) = Complex (a.data (i)); |
| 5164 | 126 ridx (i) = a.ridx (i); |
| 127 } | |
| 128 } | |
| 129 | |
| 130 SparseComplexMatrix::SparseComplexMatrix (const SparseBoolMatrix& a) | |
| 5681 | 131 : MSparse<Complex> (a.rows (), a.cols (), a.nnz ()) |
| 5164 | 132 { |
| 5275 | 133 octave_idx_type nc = cols (); |
| 5681 | 134 octave_idx_type nz = a.nnz (); |
| 5275 | 135 |
| 136 for (octave_idx_type i = 0; i < nc + 1; i++) | |
| 5164 | 137 cidx (i) = a.cidx (i); |
| 138 | |
| 5275 | 139 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 140 { |
| 5681 | 141 data (i) = Complex (a.data (i)); |
| 5164 | 142 ridx (i) = a.ridx (i); |
| 143 } | |
| 144 } | |
| 145 | |
| 146 bool | |
| 147 SparseComplexMatrix::operator == (const SparseComplexMatrix& a) const | |
| 148 { | |
| 5275 | 149 octave_idx_type nr = rows (); |
| 150 octave_idx_type nc = cols (); | |
| 5681 | 151 octave_idx_type nz = nnz (); |
| 5275 | 152 octave_idx_type nr_a = a.rows (); |
| 153 octave_idx_type nc_a = a.cols (); | |
| 5681 | 154 octave_idx_type nz_a = a.nnz (); |
| 5164 | 155 |
| 156 if (nr != nr_a || nc != nc_a || nz != nz_a) | |
| 157 return false; | |
| 158 | |
| 5275 | 159 for (octave_idx_type i = 0; i < nc + 1; i++) |
| 5164 | 160 if (cidx(i) != a.cidx(i)) |
| 161 return false; | |
| 162 | |
| 5275 | 163 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 164 if (data(i) != a.data(i) || ridx(i) != a.ridx(i)) |
| 165 return false; | |
| 166 | |
| 167 return true; | |
| 168 } | |
| 169 | |
| 170 bool | |
| 171 SparseComplexMatrix::operator != (const SparseComplexMatrix& a) const | |
| 172 { | |
| 173 return !(*this == a); | |
| 174 } | |
| 175 | |
| 176 bool | |
| 177 SparseComplexMatrix::is_hermitian (void) const | |
| 178 { | |
| 5275 | 179 octave_idx_type nr = rows (); |
| 180 octave_idx_type nc = cols (); | |
| 5164 | 181 |
| 6207 | 182 if (nr == nc && nr > 0) |
| 5164 | 183 { |
| 6207 | 184 for (octave_idx_type j = 0; j < nc; j++) |
| 185 { | |
| 186 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 187 { | |
| 188 octave_idx_type ri = ridx(i); | |
| 189 | |
| 190 if (ri != j) | |
| 191 { | |
| 192 bool found = false; | |
| 193 | |
| 194 for (octave_idx_type k = cidx(ri); k < cidx(ri+1); k++) | |
| 195 { | |
| 196 if (ridx(k) == j) | |
| 197 { | |
| 198 if (data(i) == conj(data(k))) | |
| 199 found = true; | |
| 200 break; | |
| 201 } | |
| 202 } | |
| 203 | |
| 204 if (! found) | |
| 205 return false; | |
| 206 } | |
| 207 } | |
| 208 } | |
| 5164 | 209 |
| 210 return true; | |
| 211 } | |
| 212 | |
| 213 return false; | |
| 214 } | |
| 215 | |
| 216 static const Complex Complex_NaN_result (octave_NaN, octave_NaN); | |
| 217 | |
| 218 SparseComplexMatrix | |
| 219 SparseComplexMatrix::max (int dim) const | |
| 220 { | |
| 5275 | 221 Array2<octave_idx_type> dummy_idx; |
| 5164 | 222 return max (dummy_idx, dim); |
| 223 } | |
| 224 | |
| 225 SparseComplexMatrix | |
| 5275 | 226 SparseComplexMatrix::max (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 227 { |
| 228 SparseComplexMatrix result; | |
| 229 dim_vector dv = dims (); | |
| 230 | |
| 231 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 232 return result; | |
| 233 | |
| 5275 | 234 octave_idx_type nr = dv(0); |
| 235 octave_idx_type nc = dv(1); | |
| 5164 | 236 |
| 237 if (dim == 0) | |
| 238 { | |
| 239 idx_arg.resize (1, nc); | |
| 5275 | 240 octave_idx_type nel = 0; |
| 241 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 242 { |
| 243 Complex tmp_max; | |
| 244 double abs_max = octave_NaN; | |
| 5275 | 245 octave_idx_type idx_j = 0; |
| 246 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 247 { |
| 248 if (ridx(i) != idx_j) | |
| 249 break; | |
| 250 else | |
| 251 idx_j++; | |
| 252 } | |
| 253 | |
| 254 if (idx_j != nr) | |
| 255 { | |
| 256 tmp_max = 0.; | |
| 257 abs_max = 0.; | |
| 258 } | |
| 259 | |
| 5275 | 260 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 261 { |
| 262 Complex tmp = data (i); | |
| 263 | |
| 5389 | 264 if (xisnan (tmp)) |
| 5164 | 265 continue; |
| 266 | |
| 5261 | 267 double abs_tmp = std::abs (tmp); |
| 5164 | 268 |
| 5389 | 269 if (xisnan (abs_max) || abs_tmp > abs_max) |
| 5164 | 270 { |
| 271 idx_j = ridx (i); | |
| 272 tmp_max = tmp; | |
| 273 abs_max = abs_tmp; | |
| 274 } | |
| 275 } | |
| 276 | |
| 5389 | 277 idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_j; |
| 5164 | 278 if (abs_max != 0.) |
| 279 nel++; | |
| 280 } | |
| 281 | |
| 282 result = SparseComplexMatrix (1, nc, nel); | |
| 283 | |
| 5275 | 284 octave_idx_type ii = 0; |
| 5164 | 285 result.xcidx (0) = 0; |
| 5275 | 286 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 287 { |
| 288 Complex tmp = elem (idx_arg(j), j); | |
| 289 if (tmp != 0.) | |
| 290 { | |
| 291 result.xdata (ii) = tmp; | |
| 292 result.xridx (ii++) = 0; | |
| 293 } | |
| 294 result.xcidx (j+1) = ii; | |
| 295 } | |
| 296 } | |
| 297 else | |
| 298 { | |
| 299 idx_arg.resize (nr, 1, 0); | |
| 300 | |
| 5275 | 301 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 302 idx_arg.elem(ridx(i)) = -1; |
| 303 | |
| 5275 | 304 for (octave_idx_type j = 0; j < nc; j++) |
| 305 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 306 { |
| 307 if (idx_arg.elem(i) != -1) | |
| 308 continue; | |
| 309 bool found = false; | |
| 5275 | 310 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 311 if (ridx(k) == i) |
| 312 { | |
| 313 found = true; | |
| 314 break; | |
| 315 } | |
| 316 | |
| 317 if (!found) | |
| 318 idx_arg.elem(i) = j; | |
| 319 | |
| 320 } | |
| 321 | |
| 5275 | 322 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 323 { |
| 5275 | 324 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 325 { |
| 5275 | 326 octave_idx_type ir = ridx (i); |
| 327 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 328 Complex tmp = data (i); |
| 329 | |
| 5389 | 330 if (xisnan (tmp)) |
| 5164 | 331 continue; |
| 5261 | 332 else if (ix == -1 || std::abs(tmp) > std::abs(elem (ir, ix))) |
| 5164 | 333 idx_arg.elem (ir) = j; |
| 334 } | |
| 335 } | |
| 336 | |
| 5275 | 337 octave_idx_type nel = 0; |
| 338 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 339 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 340 nel++; | |
| 341 | |
| 342 result = SparseComplexMatrix (nr, 1, nel); | |
| 343 | |
| 5275 | 344 octave_idx_type ii = 0; |
| 5164 | 345 result.xcidx (0) = 0; |
| 346 result.xcidx (1) = nel; | |
| 5275 | 347 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 348 { |
| 349 if (idx_arg(j) == -1) | |
| 350 { | |
| 351 idx_arg(j) = 0; | |
| 352 result.xdata (ii) = Complex_NaN_result; | |
| 353 result.xridx (ii++) = j; | |
| 354 } | |
| 355 else | |
| 356 { | |
| 357 Complex tmp = elem (j, idx_arg(j)); | |
| 358 if (tmp != 0.) | |
| 359 { | |
| 360 result.xdata (ii) = tmp; | |
| 361 result.xridx (ii++) = j; | |
| 362 } | |
| 363 } | |
| 364 } | |
| 365 } | |
| 366 | |
| 367 return result; | |
| 368 } | |
| 369 | |
| 370 SparseComplexMatrix | |
| 371 SparseComplexMatrix::min (int dim) const | |
| 372 { | |
| 5275 | 373 Array2<octave_idx_type> dummy_idx; |
| 5164 | 374 return min (dummy_idx, dim); |
| 375 } | |
| 376 | |
| 377 SparseComplexMatrix | |
| 5275 | 378 SparseComplexMatrix::min (Array2<octave_idx_type>& idx_arg, int dim) const |
| 5164 | 379 { |
| 380 SparseComplexMatrix result; | |
| 381 dim_vector dv = dims (); | |
| 382 | |
| 383 if (dv.numel () == 0 || dim > dv.length () || dim < 0) | |
| 384 return result; | |
| 385 | |
| 5275 | 386 octave_idx_type nr = dv(0); |
| 387 octave_idx_type nc = dv(1); | |
| 5164 | 388 |
| 389 if (dim == 0) | |
| 390 { | |
| 391 idx_arg.resize (1, nc); | |
| 5275 | 392 octave_idx_type nel = 0; |
| 393 for (octave_idx_type j = 0; j < nc; j++) | |
| 5164 | 394 { |
| 395 Complex tmp_min; | |
| 396 double abs_min = octave_NaN; | |
| 5275 | 397 octave_idx_type idx_j = 0; |
| 398 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 399 { |
| 400 if (ridx(i) != idx_j) | |
| 401 break; | |
| 402 else | |
| 403 idx_j++; | |
| 404 } | |
| 405 | |
| 406 if (idx_j != nr) | |
| 407 { | |
| 408 tmp_min = 0.; | |
| 409 abs_min = 0.; | |
| 410 } | |
| 411 | |
| 5275 | 412 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 413 { |
| 414 Complex tmp = data (i); | |
| 415 | |
| 5389 | 416 if (xisnan (tmp)) |
| 5164 | 417 continue; |
| 418 | |
| 5261 | 419 double abs_tmp = std::abs (tmp); |
| 5164 | 420 |
| 5389 | 421 if (xisnan (abs_min) || abs_tmp < abs_min) |
| 5164 | 422 { |
| 423 idx_j = ridx (i); | |
| 424 tmp_min = tmp; | |
| 425 abs_min = abs_tmp; | |
| 426 } | |
| 427 } | |
| 428 | |
| 5389 | 429 idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_j; |
| 5164 | 430 if (abs_min != 0.) |
| 431 nel++; | |
| 432 } | |
| 433 | |
| 434 result = SparseComplexMatrix (1, nc, nel); | |
| 435 | |
| 5275 | 436 octave_idx_type ii = 0; |
| 5164 | 437 result.xcidx (0) = 0; |
| 5275 | 438 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 439 { |
| 440 Complex tmp = elem (idx_arg(j), j); | |
| 441 if (tmp != 0.) | |
| 442 { | |
| 443 result.xdata (ii) = tmp; | |
| 444 result.xridx (ii++) = 0; | |
| 445 } | |
| 446 result.xcidx (j+1) = ii; | |
| 447 } | |
| 448 } | |
| 449 else | |
| 450 { | |
| 451 idx_arg.resize (nr, 1, 0); | |
| 452 | |
| 5275 | 453 for (octave_idx_type i = cidx(0); i < cidx(1); i++) |
| 5164 | 454 idx_arg.elem(ridx(i)) = -1; |
| 455 | |
| 5275 | 456 for (octave_idx_type j = 0; j < nc; j++) |
| 457 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 458 { |
| 459 if (idx_arg.elem(i) != -1) | |
| 460 continue; | |
| 461 bool found = false; | |
| 5275 | 462 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) |
| 5164 | 463 if (ridx(k) == i) |
| 464 { | |
| 465 found = true; | |
| 466 break; | |
| 467 } | |
| 468 | |
| 469 if (!found) | |
| 470 idx_arg.elem(i) = j; | |
| 471 | |
| 472 } | |
| 473 | |
| 5275 | 474 for (octave_idx_type j = 0; j < nc; j++) |
| 5164 | 475 { |
| 5275 | 476 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) |
| 5164 | 477 { |
| 5275 | 478 octave_idx_type ir = ridx (i); |
| 479 octave_idx_type ix = idx_arg.elem (ir); | |
| 5164 | 480 Complex tmp = data (i); |
| 481 | |
| 5389 | 482 if (xisnan (tmp)) |
| 5164 | 483 continue; |
| 5261 | 484 else if (ix == -1 || std::abs(tmp) < std::abs(elem (ir, ix))) |
| 5164 | 485 idx_arg.elem (ir) = j; |
| 486 } | |
| 487 } | |
| 488 | |
| 5275 | 489 octave_idx_type nel = 0; |
| 490 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 491 if (idx_arg.elem(j) == -1 || elem (j, idx_arg.elem (j)) != 0.) |
| 492 nel++; | |
| 493 | |
| 494 result = SparseComplexMatrix (nr, 1, nel); | |
| 495 | |
| 5275 | 496 octave_idx_type ii = 0; |
| 5164 | 497 result.xcidx (0) = 0; |
| 498 result.xcidx (1) = nel; | |
| 5275 | 499 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 500 { |
| 501 if (idx_arg(j) == -1) | |
| 502 { | |
| 503 idx_arg(j) = 0; | |
| 504 result.xdata (ii) = Complex_NaN_result; | |
| 505 result.xridx (ii++) = j; | |
| 506 } | |
| 507 else | |
| 508 { | |
| 509 Complex tmp = elem (j, idx_arg(j)); | |
| 510 if (tmp != 0.) | |
| 511 { | |
| 512 result.xdata (ii) = tmp; | |
| 513 result.xridx (ii++) = j; | |
| 514 } | |
| 515 } | |
| 516 } | |
| 517 } | |
| 518 | |
| 519 return result; | |
| 520 } | |
| 521 | |
| 522 // destructive insert/delete/reorder operations | |
| 523 | |
| 524 SparseComplexMatrix& | |
| 5275 | 525 SparseComplexMatrix::insert (const SparseMatrix& a, octave_idx_type r, octave_idx_type c) |
| 5164 | 526 { |
| 527 SparseComplexMatrix tmp (a); | |
| 6060 | 528 return insert (tmp /*a*/, r, c); |
| 5164 | 529 } |
| 530 | |
| 531 SparseComplexMatrix& | |
| 5275 | 532 SparseComplexMatrix::insert (const SparseComplexMatrix& a, octave_idx_type r, octave_idx_type c) |
| 5164 | 533 { |
| 534 MSparse<Complex>::insert (a, r, c); | |
| 535 return *this; | |
| 536 } | |
| 537 | |
| 6823 | 538 SparseComplexMatrix& |
| 539 SparseComplexMatrix::insert (const SparseMatrix& a, const Array<octave_idx_type>& indx) | |
| 540 { | |
| 541 SparseComplexMatrix tmp (a); | |
| 542 return insert (tmp /*a*/, indx); | |
| 543 } | |
| 544 | |
| 545 SparseComplexMatrix& | |
| 546 SparseComplexMatrix::insert (const SparseComplexMatrix& a, const Array<octave_idx_type>& indx) | |
| 547 { | |
| 548 MSparse<Complex>::insert (a, indx); | |
| 549 return *this; | |
| 550 } | |
| 551 | |
| 5164 | 552 SparseComplexMatrix |
| 553 SparseComplexMatrix::concat (const SparseComplexMatrix& rb, | |
| 5275 | 554 const Array<octave_idx_type>& ra_idx) |
| 5164 | 555 { |
| 556 // Don't use numel to avoid all possiblity of an overflow | |
| 557 if (rb.rows () > 0 && rb.cols () > 0) | |
| 558 insert (rb, ra_idx(0), ra_idx(1)); | |
| 559 return *this; | |
| 560 } | |
| 561 | |
| 562 SparseComplexMatrix | |
| 5275 | 563 SparseComplexMatrix::concat (const SparseMatrix& rb, const Array<octave_idx_type>& ra_idx) |
| 5164 | 564 { |
| 565 SparseComplexMatrix tmp (rb); | |
| 566 if (rb.rows () > 0 && rb.cols () > 0) | |
| 567 insert (tmp, ra_idx(0), ra_idx(1)); | |
| 568 return *this; | |
| 569 } | |
| 570 | |
| 571 ComplexMatrix | |
| 572 SparseComplexMatrix::matrix_value (void) const | |
| 573 { | |
| 5275 | 574 octave_idx_type nr = rows (); |
| 575 octave_idx_type nc = cols (); | |
| 5164 | 576 ComplexMatrix retval (nr, nc, Complex (0.0, 0.0)); |
| 577 | |
| 5275 | 578 for (octave_idx_type j = 0; j < nc; j++) |
| 579 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 580 retval.elem (ridx(i), j) = data (i); |
| 581 | |
| 582 return retval; | |
| 583 } | |
| 584 | |
| 585 SparseComplexMatrix | |
| 586 SparseComplexMatrix::hermitian (void) const | |
| 587 { | |
| 5275 | 588 octave_idx_type nr = rows (); |
| 589 octave_idx_type nc = cols (); | |
| 5681 | 590 octave_idx_type nz = nnz (); |
| 5164 | 591 SparseComplexMatrix retval (nc, nr, nz); |
| 592 | |
| 5648 | 593 OCTAVE_LOCAL_BUFFER (octave_idx_type, w, nr + 1); |
| 594 for (octave_idx_type i = 0; i < nr; i++) | |
| 595 w[i] = 0; | |
| 596 for (octave_idx_type i = 0; i < nz; i++) | |
| 597 w[ridx(i)]++; | |
| 598 nz = 0; | |
| 599 for (octave_idx_type i = 0; i < nr; i++) | |
| 5164 | 600 { |
| 5648 | 601 retval.xcidx(i) = nz; |
| 602 nz += w[i]; | |
| 603 w[i] = retval.xcidx(i); | |
| 5164 | 604 } |
| 5648 | 605 retval.xcidx(nr) = nz; |
| 606 w[nr] = nz; | |
| 607 | |
| 608 for (octave_idx_type j = 0; j < nc; j++) | |
| 609 for (octave_idx_type k = cidx(j); k < cidx(j+1); k++) | |
| 610 { | |
| 611 octave_idx_type q = w [ridx(k)]++; | |
| 612 retval.xridx (q) = j; | |
| 613 retval.xdata (q) = conj (data (k)); | |
| 614 } | |
| 5164 | 615 |
| 616 return retval; | |
| 617 } | |
| 618 | |
| 619 SparseComplexMatrix | |
| 620 conj (const SparseComplexMatrix& a) | |
| 621 { | |
| 5275 | 622 octave_idx_type nr = a.rows (); |
| 623 octave_idx_type nc = a.cols (); | |
| 5681 | 624 octave_idx_type nz = a.nnz (); |
| 5164 | 625 SparseComplexMatrix retval (nc, nr, nz); |
| 626 | |
| 5275 | 627 for (octave_idx_type i = 0; i < nc + 1; i++) |
| 5164 | 628 retval.cidx (i) = a.cidx (i); |
| 629 | |
| 5275 | 630 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 631 { |
| 632 retval.data (i) = conj (a.data (i)); | |
| 633 retval.ridx (i) = a.ridx (i); | |
| 634 } | |
| 635 | |
| 636 return retval; | |
| 637 } | |
| 638 | |
| 639 SparseComplexMatrix | |
| 640 SparseComplexMatrix::inverse (void) const | |
| 641 { | |
| 5275 | 642 octave_idx_type info; |
| 5164 | 643 double rcond; |
| 5785 | 644 MatrixType mattype (*this); |
| 5506 | 645 return inverse (mattype, info, rcond, 0, 0); |
| 646 } | |
| 647 | |
| 648 SparseComplexMatrix | |
| 5785 | 649 SparseComplexMatrix::inverse (MatrixType& mattype) const |
| 5506 | 650 { |
| 651 octave_idx_type info; | |
| 652 double rcond; | |
| 653 return inverse (mattype, info, rcond, 0, 0); | |
| 5164 | 654 } |
| 655 | |
| 656 SparseComplexMatrix | |
| 5785 | 657 SparseComplexMatrix::inverse (MatrixType& mattype, octave_idx_type& info) const |
| 5164 | 658 { |
| 659 double rcond; | |
| 5506 | 660 return inverse (mattype, info, rcond, 0, 0); |
| 661 } | |
| 662 | |
| 663 SparseComplexMatrix | |
| 5785 | 664 SparseComplexMatrix::dinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 665 double& rcond, const bool, |
| 5506 | 666 const bool calccond) const |
| 667 { | |
| 668 SparseComplexMatrix retval; | |
| 669 | |
| 670 octave_idx_type nr = rows (); | |
| 671 octave_idx_type nc = cols (); | |
| 672 info = 0; | |
| 673 | |
| 674 if (nr == 0 || nc == 0 || nr != nc) | |
| 675 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 676 else | |
| 677 { | |
| 678 // Print spparms("spumoni") info if requested | |
| 679 int typ = mattyp.type (); | |
| 680 mattyp.info (); | |
| 681 | |
| 5785 | 682 if (typ == MatrixType::Diagonal || |
| 683 typ == MatrixType::Permuted_Diagonal) | |
| 5506 | 684 { |
| 5785 | 685 if (typ == MatrixType::Permuted_Diagonal) |
| 5506 | 686 retval = transpose(); |
| 687 else | |
| 688 retval = *this; | |
| 689 | |
| 690 // Force make_unique to be called | |
| 691 Complex *v = retval.data(); | |
| 692 | |
| 693 if (calccond) | |
| 694 { | |
| 695 double dmax = 0., dmin = octave_Inf; | |
| 696 for (octave_idx_type i = 0; i < nr; i++) | |
| 697 { | |
| 698 double tmp = std::abs(v[i]); | |
| 699 if (tmp > dmax) | |
| 700 dmax = tmp; | |
| 701 if (tmp < dmin) | |
| 702 dmin = tmp; | |
| 703 } | |
| 704 rcond = dmin / dmax; | |
| 705 } | |
| 706 | |
| 707 for (octave_idx_type i = 0; i < nr; i++) | |
| 708 v[i] = 1.0 / v[i]; | |
| 709 } | |
| 710 else | |
| 711 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 712 } | |
| 713 | |
| 714 return retval; | |
| 715 } | |
| 716 | |
| 717 SparseComplexMatrix | |
| 5785 | 718 SparseComplexMatrix::tinverse (MatrixType &mattyp, octave_idx_type& info, |
| 5610 | 719 double& rcond, const bool, |
| 5506 | 720 const bool calccond) const |
| 721 { | |
| 722 SparseComplexMatrix retval; | |
| 723 | |
| 724 octave_idx_type nr = rows (); | |
| 725 octave_idx_type nc = cols (); | |
| 726 info = 0; | |
| 727 | |
| 728 if (nr == 0 || nc == 0 || nr != nc) | |
| 729 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
| 730 else | |
| 731 { | |
| 732 // Print spparms("spumoni") info if requested | |
| 733 int typ = mattyp.type (); | |
| 734 mattyp.info (); | |
| 735 | |
| 5785 | 736 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper || |
| 737 typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) | |
| 5506 | 738 { |
| 739 double anorm = 0.; | |
| 740 double ainvnorm = 0.; | |
| 741 | |
| 742 if (calccond) | |
| 743 { | |
| 744 // Calculate the 1-norm of matrix for rcond calculation | |
| 745 for (octave_idx_type j = 0; j < nr; j++) | |
| 746 { | |
| 747 double atmp = 0.; | |
| 748 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 749 atmp += std::abs(data(i)); | |
| 750 if (atmp > anorm) | |
| 751 anorm = atmp; | |
| 752 } | |
| 753 } | |
| 754 | |
| 5785 | 755 if (typ == MatrixType::Upper || typ == MatrixType::Lower) |
| 5506 | 756 { |
| 5681 | 757 octave_idx_type nz = nnz (); |
| 5506 | 758 octave_idx_type cx = 0; |
| 759 octave_idx_type nz2 = nz; | |
| 760 retval = SparseComplexMatrix (nr, nc, nz2); | |
| 761 | |
| 762 for (octave_idx_type i = 0; i < nr; i++) | |
| 763 { | |
| 764 OCTAVE_QUIT; | |
| 765 // place the 1 in the identity position | |
| 766 octave_idx_type cx_colstart = cx; | |
| 767 | |
| 768 if (cx == nz2) | |
| 769 { | |
| 770 nz2 *= 2; | |
| 771 retval.change_capacity (nz2); | |
| 772 } | |
| 773 | |
| 774 retval.xcidx(i) = cx; | |
| 775 retval.xridx(cx) = i; | |
| 776 retval.xdata(cx) = 1.0; | |
| 777 cx++; | |
| 778 | |
| 779 // iterate accross columns of input matrix | |
| 780 for (octave_idx_type j = i+1; j < nr; j++) | |
| 781 { | |
| 782 Complex v = 0.; | |
| 783 // iterate to calculate sum | |
| 784 octave_idx_type colXp = retval.xcidx(i); | |
| 785 octave_idx_type colUp = cidx(j); | |
| 786 octave_idx_type rpX, rpU; | |
| 5876 | 787 |
| 788 if (cidx(j) == cidx(j+1)) | |
| 789 { | |
| 790 (*current_liboctave_error_handler) | |
| 791 ("division by zero"); | |
| 792 goto inverse_singular; | |
| 793 } | |
| 794 | |
| 5506 | 795 do |
| 796 { | |
| 797 OCTAVE_QUIT; | |
| 798 rpX = retval.xridx(colXp); | |
| 799 rpU = ridx(colUp); | |
| 800 | |
| 801 if (rpX < rpU) | |
| 802 colXp++; | |
| 803 else if (rpX > rpU) | |
| 804 colUp++; | |
| 805 else | |
| 806 { | |
| 807 v -= retval.xdata(colXp) * data(colUp); | |
| 808 colXp++; | |
| 809 colUp++; | |
| 810 } | |
| 811 } while ((rpX<j) && (rpU<j) && | |
| 812 (colXp<cx) && (colUp<nz)); | |
| 813 | |
| 5876 | 814 |
| 5506 | 815 // get A(m,m) |
| 5876 | 816 if (typ == MatrixType::Upper) |
| 817 colUp = cidx(j+1) - 1; | |
| 818 else | |
| 5877 | 819 colUp = cidx(j); |
| 5506 | 820 Complex pivot = data(colUp); |
| 5877 | 821 if (pivot == 0. || ridx(colUp) != j) |
| 5876 | 822 { |
| 823 (*current_liboctave_error_handler) | |
| 824 ("division by zero"); | |
| 825 goto inverse_singular; | |
| 826 } | |
| 5506 | 827 |
| 828 if (v != 0.) | |
| 829 { | |
| 830 if (cx == nz2) | |
| 831 { | |
| 832 nz2 *= 2; | |
| 833 retval.change_capacity (nz2); | |
| 834 } | |
| 835 | |
| 836 retval.xridx(cx) = j; | |
| 837 retval.xdata(cx) = v / pivot; | |
| 838 cx++; | |
| 839 } | |
| 840 } | |
| 841 | |
| 842 // get A(m,m) | |
| 5876 | 843 octave_idx_type colUp; |
| 844 if (typ == MatrixType::Upper) | |
| 845 colUp = cidx(i+1) - 1; | |
| 846 else | |
| 5877 | 847 colUp = cidx(i); |
| 5506 | 848 Complex pivot = data(colUp); |
| 5877 | 849 if (pivot == 0. || ridx(colUp) != i) |
| 5876 | 850 { |
| 851 (*current_liboctave_error_handler) ("division by zero"); | |
| 852 goto inverse_singular; | |
| 853 } | |
| 5506 | 854 |
| 855 if (pivot != 1.0) | |
| 856 for (octave_idx_type j = cx_colstart; j < cx; j++) | |
| 857 retval.xdata(j) /= pivot; | |
| 858 } | |
| 859 retval.xcidx(nr) = cx; | |
| 860 retval.maybe_compress (); | |
| 861 } | |
| 862 else | |
| 863 { | |
| 5681 | 864 octave_idx_type nz = nnz (); |
| 5506 | 865 octave_idx_type cx = 0; |
| 866 octave_idx_type nz2 = nz; | |
| 867 retval = SparseComplexMatrix (nr, nc, nz2); | |
| 868 | |
| 869 OCTAVE_LOCAL_BUFFER (Complex, work, nr); | |
| 870 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nr); | |
| 871 | |
| 872 octave_idx_type *perm = mattyp.triangular_perm(); | |
| 5785 | 873 if (typ == MatrixType::Permuted_Upper) |
| 5506 | 874 { |
| 875 for (octave_idx_type i = 0; i < nr; i++) | |
| 876 rperm[perm[i]] = i; | |
| 877 } | |
| 878 else | |
| 879 { | |
| 880 for (octave_idx_type i = 0; i < nr; i++) | |
| 881 rperm[i] = perm[i]; | |
| 882 for (octave_idx_type i = 0; i < nr; i++) | |
| 883 perm[rperm[i]] = i; | |
| 884 } | |
| 885 | |
| 886 for (octave_idx_type i = 0; i < nr; i++) | |
| 887 { | |
| 888 OCTAVE_QUIT; | |
| 889 octave_idx_type iidx = rperm[i]; | |
| 890 | |
| 891 for (octave_idx_type j = 0; j < nr; j++) | |
| 892 work[j] = 0.; | |
| 893 | |
| 894 // place the 1 in the identity position | |
| 895 work[iidx] = 1.0; | |
| 896 | |
| 897 // iterate accross columns of input matrix | |
| 898 for (octave_idx_type j = iidx+1; j < nr; j++) | |
| 899 { | |
| 900 Complex v = 0.; | |
| 901 octave_idx_type jidx = perm[j]; | |
| 902 // iterate to calculate sum | |
| 903 for (octave_idx_type k = cidx(jidx); | |
| 904 k < cidx(jidx+1); k++) | |
| 905 { | |
| 906 OCTAVE_QUIT; | |
| 907 v -= work[ridx(k)] * data(k); | |
| 908 } | |
| 909 | |
| 910 // get A(m,m) | |
| 5876 | 911 Complex pivot; |
| 912 if (typ == MatrixType::Permuted_Upper) | |
| 913 pivot = data(cidx(jidx+1) - 1); | |
| 914 else | |
| 5877 | 915 pivot = data(cidx(jidx)); |
| 5506 | 916 if (pivot == 0.) |
| 5876 | 917 { |
| 918 (*current_liboctave_error_handler) | |
| 919 ("division by zero"); | |
| 920 goto inverse_singular; | |
| 921 } | |
| 5506 | 922 |
| 923 work[j] = v / pivot; | |
| 924 } | |
| 925 | |
| 926 // get A(m,m) | |
| 5876 | 927 octave_idx_type colUp; |
| 928 if (typ == MatrixType::Permuted_Upper) | |
| 929 colUp = cidx(perm[iidx]+1) - 1; | |
| 930 else | |
| 5877 | 931 colUp = cidx(perm[iidx]); |
| 5876 | 932 |
| 933 Complex pivot = data(colUp); | |
| 934 if (pivot == 0.) | |
| 935 { | |
| 936 (*current_liboctave_error_handler) | |
| 937 ("division by zero"); | |
| 938 goto inverse_singular; | |
| 939 } | |
| 5506 | 940 |
| 941 octave_idx_type new_cx = cx; | |
| 942 for (octave_idx_type j = iidx; j < nr; j++) | |
| 943 if (work[j] != 0.0) | |
| 944 { | |
| 945 new_cx++; | |
| 946 if (pivot != 1.0) | |
| 947 work[j] /= pivot; | |
| 948 } | |
| 949 | |
| 950 if (cx < new_cx) | |
| 951 { | |
| 952 nz2 = (2*nz2 < new_cx ? new_cx : 2*nz2); | |
| 953 retval.change_capacity (nz2); | |
| 954 } | |
| 955 | |
| 956 retval.xcidx(i) = cx; | |
| 957 for (octave_idx_type j = iidx; j < nr; j++) | |
| 958 if (work[j] != 0.) | |
| 959 { | |
| 960 retval.xridx(cx) = j; | |
| 961 retval.xdata(cx++) = work[j]; | |
| 962 } | |
| 963 } | |
| 964 | |
| 965 retval.xcidx(nr) = cx; | |
| 966 retval.maybe_compress (); | |
| 967 } | |
| 968 | |
| 969 if (calccond) | |
| 970 { | |
| 971 // Calculate the 1-norm of inverse matrix for rcond calculation | |
| 972 for (octave_idx_type j = 0; j < nr; j++) | |
| 973 { | |
| 974 double atmp = 0.; | |
| 975 for (octave_idx_type i = retval.cidx(j); | |
| 976 i < retval.cidx(j+1); i++) | |
| 977 atmp += std::abs(retval.data(i)); | |
| 978 if (atmp > ainvnorm) | |
| 979 ainvnorm = atmp; | |
| 980 } | |
| 981 | |
| 982 rcond = 1. / ainvnorm / anorm; | |
| 983 } | |
| 984 } | |
| 985 else | |
| 986 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 987 } | |
| 988 | |
| 989 return retval; | |
| 5876 | 990 |
| 991 inverse_singular: | |
| 992 return SparseComplexMatrix(); | |
| 5164 | 993 } |
| 994 | |
| 995 SparseComplexMatrix | |
| 5785 | 996 SparseComplexMatrix::inverse (MatrixType& mattype, octave_idx_type& info, |
| 5610 | 997 double& rcond, int, int calc_cond) const |
| 5506 | 998 { |
| 999 int typ = mattype.type (false); | |
| 1000 SparseComplexMatrix ret; | |
| 1001 | |
| 5785 | 1002 if (typ == MatrixType::Unknown) |
| 5506 | 1003 typ = mattype.type (*this); |
| 1004 | |
| 5785 | 1005 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5506 | 1006 ret = dinverse (mattype, info, rcond, true, calc_cond); |
| 5785 | 1007 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5506 | 1008 ret = tinverse (mattype, info, rcond, true, calc_cond).transpose(); |
| 5785 | 1009 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 6185 | 1010 { |
| 1011 MatrixType newtype = mattype.transpose(); | |
| 1012 ret = transpose().tinverse (newtype, info, rcond, true, calc_cond); | |
| 1013 } | |
| 6840 | 1014 else |
| 5506 | 1015 { |
| 1016 if (mattype.is_hermitian()) | |
| 1017 { | |
| 5785 | 1018 MatrixType tmp_typ (MatrixType::Upper); |
| 5506 | 1019 SparseComplexCHOL fact (*this, info, false); |
| 1020 rcond = fact.rcond(); | |
| 1021 if (info == 0) | |
| 1022 { | |
| 1023 double rcond2; | |
| 1024 SparseMatrix Q = fact.Q(); | |
| 1025 SparseComplexMatrix InvL = fact.L().transpose(). | |
| 1026 tinverse(tmp_typ, info, rcond2, true, false); | |
| 1027 ret = Q * InvL.hermitian() * InvL * Q.transpose(); | |
| 1028 } | |
| 1029 else | |
| 1030 { | |
| 1031 // Matrix is either singular or not positive definite | |
| 1032 mattype.mark_as_unsymmetric (); | |
| 5785 | 1033 typ = MatrixType::Full; |
| 5506 | 1034 } |
| 1035 } | |
| 1036 | |
| 1037 if (!mattype.is_hermitian()) | |
| 1038 { | |
| 1039 octave_idx_type n = rows(); | |
| 1040 ColumnVector Qinit(n); | |
| 1041 for (octave_idx_type i = 0; i < n; i++) | |
| 1042 Qinit(i) = i; | |
| 1043 | |
| 5785 | 1044 MatrixType tmp_typ (MatrixType::Upper); |
| 5506 | 1045 SparseComplexLU fact (*this, Qinit, -1.0, false); |
| 1046 rcond = fact.rcond(); | |
| 1047 double rcond2; | |
| 1048 SparseComplexMatrix InvL = fact.L().transpose(). | |
| 1049 tinverse(tmp_typ, info, rcond2, true, false); | |
| 1050 SparseComplexMatrix InvU = fact.U(). | |
| 1051 tinverse(tmp_typ, info, rcond2, true, false).transpose(); | |
| 1052 ret = fact.Pc().transpose() * InvU * InvL * fact.Pr(); | |
| 1053 } | |
| 1054 } | |
| 1055 | |
| 1056 return ret; | |
| 5164 | 1057 } |
| 1058 | |
| 1059 ComplexDET | |
| 1060 SparseComplexMatrix::determinant (void) const | |
| 1061 { | |
| 5275 | 1062 octave_idx_type info; |
| 5164 | 1063 double rcond; |
| 1064 return determinant (info, rcond, 0); | |
| 1065 } | |
| 1066 | |
| 1067 ComplexDET | |
| 5275 | 1068 SparseComplexMatrix::determinant (octave_idx_type& info) const |
| 5164 | 1069 { |
| 1070 double rcond; | |
| 1071 return determinant (info, rcond, 0); | |
| 1072 } | |
| 1073 | |
| 1074 ComplexDET | |
| 5610 | 1075 SparseComplexMatrix::determinant (octave_idx_type& err, double& rcond, int) const |
| 5164 | 1076 { |
| 1077 ComplexDET retval; | |
| 5203 | 1078 #ifdef HAVE_UMFPACK |
| 5164 | 1079 |
| 5275 | 1080 octave_idx_type nr = rows (); |
| 1081 octave_idx_type nc = cols (); | |
| 5164 | 1082 |
| 1083 if (nr == 0 || nc == 0 || nr != nc) | |
| 1084 { | |
| 1085 Complex d[2]; | |
| 1086 d[0] = 1.0; | |
| 1087 d[1] = 0.0; | |
| 1088 retval = ComplexDET (d); | |
| 1089 } | |
| 1090 else | |
| 1091 { | |
| 1092 err = 0; | |
| 1093 | |
| 1094 // Setup the control parameters | |
| 1095 Matrix Control (UMFPACK_CONTROL, 1); | |
| 1096 double *control = Control.fortran_vec (); | |
| 5322 | 1097 UMFPACK_ZNAME (defaults) (control); |
| 5164 | 1098 |
| 5893 | 1099 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 1100 if (!xisnan (tmp)) |
| 1101 Control (UMFPACK_PRL) = tmp; | |
| 1102 | |
| 5893 | 1103 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 1104 if (!xisnan (tmp)) |
| 1105 { | |
| 1106 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 1107 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 1108 } | |
| 1109 | |
| 1110 // Set whether we are allowed to modify Q or not | |
| 5893 | 1111 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 1112 if (!xisnan (tmp)) |
| 1113 Control (UMFPACK_FIXQ) = tmp; | |
| 1114 | |
| 1115 // Turn-off UMFPACK scaling for LU | |
| 1116 Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; | |
| 1117 | |
| 5322 | 1118 UMFPACK_ZNAME (report_control) (control); |
| 5164 | 1119 |
| 5275 | 1120 const octave_idx_type *Ap = cidx (); |
| 1121 const octave_idx_type *Ai = ridx (); | |
| 5164 | 1122 const Complex *Ax = data (); |
| 1123 | |
| 5322 | 1124 UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai, |
| 5760 | 1125 reinterpret_cast<const double *> (Ax), |
| 1126 NULL, 1, control); | |
| 5164 | 1127 |
| 1128 void *Symbolic; | |
| 1129 Matrix Info (1, UMFPACK_INFO); | |
| 1130 double *info = Info.fortran_vec (); | |
| 5322 | 1131 int status = UMFPACK_ZNAME (qsymbolic) |
| 5760 | 1132 (nr, nc, Ap, Ai, reinterpret_cast<const double *> (Ax), NULL, |
| 5164 | 1133 NULL, &Symbolic, control, info); |
| 1134 | |
| 1135 if (status < 0) | |
| 1136 { | |
| 1137 (*current_liboctave_error_handler) | |
| 1138 ("SparseComplexMatrix::determinant symbolic factorization failed"); | |
| 1139 | |
| 5322 | 1140 UMFPACK_ZNAME (report_status) (control, status); |
| 1141 UMFPACK_ZNAME (report_info) (control, info); | |
| 1142 | |
| 1143 UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 1144 } |
| 1145 else | |
| 1146 { | |
| 5322 | 1147 UMFPACK_ZNAME (report_symbolic) (Symbolic, control); |
| 5164 | 1148 |
| 1149 void *Numeric; | |
| 5760 | 1150 status |
| 1151 = UMFPACK_ZNAME (numeric) (Ap, Ai, | |
| 1152 reinterpret_cast<const double *> (Ax), | |
| 1153 NULL, Symbolic, &Numeric, control, info) ; | |
| 5322 | 1154 UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; |
| 5164 | 1155 |
| 1156 rcond = Info (UMFPACK_RCOND); | |
| 1157 | |
| 1158 if (status < 0) | |
| 1159 { | |
| 1160 (*current_liboctave_error_handler) | |
| 1161 ("SparseComplexMatrix::determinant numeric factorization failed"); | |
| 1162 | |
| 5322 | 1163 UMFPACK_ZNAME (report_status) (control, status); |
| 1164 UMFPACK_ZNAME (report_info) (control, info); | |
| 1165 | |
| 1166 UMFPACK_ZNAME (free_numeric) (&Numeric); | |
| 5164 | 1167 } |
| 1168 else | |
| 1169 { | |
| 5322 | 1170 UMFPACK_ZNAME (report_numeric) (Numeric, control); |
| 5164 | 1171 |
| 1172 Complex d[2]; | |
| 1173 double d_exponent; | |
| 1174 | |
| 5322 | 1175 status = UMFPACK_ZNAME (get_determinant) |
| 5760 | 1176 (reinterpret_cast<double *> (&d[0]), NULL, &d_exponent, |
| 5164 | 1177 Numeric, info); |
| 1178 d[1] = d_exponent; | |
| 1179 | |
| 1180 if (status < 0) | |
| 1181 { | |
| 1182 (*current_liboctave_error_handler) | |
| 1183 ("SparseComplexMatrix::determinant error calculating determinant"); | |
| 1184 | |
| 5322 | 1185 UMFPACK_ZNAME (report_status) (control, status); |
| 1186 UMFPACK_ZNAME (report_info) (control, info); | |
| 5164 | 1187 } |
| 1188 else | |
| 1189 retval = ComplexDET (d); | |
| 5346 | 1190 |
| 1191 UMFPACK_ZNAME (free_numeric) (&Numeric); | |
| 5164 | 1192 } |
| 1193 } | |
| 1194 } | |
| 5203 | 1195 #else |
| 1196 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 1197 #endif | |
| 5164 | 1198 |
| 1199 return retval; | |
| 1200 } | |
| 1201 | |
| 1202 ComplexMatrix | |
| 5785 | 1203 SparseComplexMatrix::dsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 1204 octave_idx_type& err, double& rcond, |
| 1205 solve_singularity_handler, bool calc_cond) const | |
| 5164 | 1206 { |
| 1207 ComplexMatrix retval; | |
| 1208 | |
| 5275 | 1209 octave_idx_type nr = rows (); |
| 1210 octave_idx_type nc = cols (); | |
| 5630 | 1211 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1212 err = 0; |
| 1213 | |
| 6924 | 1214 if (nr != b.rows ()) |
| 5164 | 1215 (*current_liboctave_error_handler) |
| 1216 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1217 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1218 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 1219 else |
| 1220 { | |
| 1221 // Print spparms("spumoni") info if requested | |
| 1222 int typ = mattype.type (); | |
| 1223 mattype.info (); | |
| 1224 | |
| 5785 | 1225 if (typ == MatrixType::Diagonal || |
| 1226 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1227 { |
| 5630 | 1228 retval.resize (nc, b.cols(), Complex(0.,0.)); |
| 5785 | 1229 if (typ == MatrixType::Diagonal) |
| 5275 | 1230 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1231 for (octave_idx_type i = 0; i < nm; i++) |
| 1232 retval(i,j) = b(i,j) / data (i); | |
| 5164 | 1233 else |
| 5275 | 1234 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1235 for (octave_idx_type k = 0; k < nc; k++) |
| 1236 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1237 retval(k,j) = b(ridx(i),j) / data (i); | |
| 5164 | 1238 |
| 5681 | 1239 if (calc_cond) |
| 1240 { | |
| 1241 double dmax = 0., dmin = octave_Inf; | |
| 1242 for (octave_idx_type i = 0; i < nm; i++) | |
| 1243 { | |
| 1244 double tmp = std::abs(data(i)); | |
| 1245 if (tmp > dmax) | |
| 1246 dmax = tmp; | |
| 1247 if (tmp < dmin) | |
| 1248 dmin = tmp; | |
| 1249 } | |
| 1250 rcond = dmin / dmax; | |
| 1251 } | |
| 1252 else | |
| 1253 rcond = 1.0; | |
| 5164 | 1254 } |
| 1255 else | |
| 1256 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1257 } | |
| 1258 | |
| 1259 return retval; | |
| 1260 } | |
| 1261 | |
| 1262 SparseComplexMatrix | |
| 5785 | 1263 SparseComplexMatrix::dsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 1264 octave_idx_type& err, double& rcond, |
| 5681 | 1265 solve_singularity_handler, |
| 1266 bool calc_cond) const | |
| 5164 | 1267 { |
| 1268 SparseComplexMatrix retval; | |
| 1269 | |
| 5275 | 1270 octave_idx_type nr = rows (); |
| 1271 octave_idx_type nc = cols (); | |
| 5630 | 1272 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1273 err = 0; |
| 1274 | |
| 6924 | 1275 if (nr != b.rows ()) |
| 5164 | 1276 (*current_liboctave_error_handler) |
| 1277 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1278 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1279 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 1280 else |
| 1281 { | |
| 1282 // Print spparms("spumoni") info if requested | |
| 1283 int typ = mattype.type (); | |
| 1284 mattype.info (); | |
| 1285 | |
| 5785 | 1286 if (typ == MatrixType::Diagonal || |
| 1287 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1288 { |
| 5275 | 1289 octave_idx_type b_nc = b.cols (); |
| 5681 | 1290 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1291 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 1292 |
| 1293 retval.xcidx(0) = 0; | |
| 5275 | 1294 octave_idx_type ii = 0; |
| 5785 | 1295 if (typ == MatrixType::Diagonal) |
| 5275 | 1296 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1297 { |
| 5275 | 1298 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1299 { |
| 5681 | 1300 if (b.ridx(i) >= nm) |
| 1301 break; | |
| 5164 | 1302 retval.xridx (ii) = b.ridx(i); |
| 1303 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1304 } | |
| 1305 retval.xcidx(j+1) = ii; | |
| 1306 } | |
| 1307 else | |
| 5275 | 1308 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1309 { |
| 5630 | 1310 for (octave_idx_type l = 0; l < nc; l++) |
| 1311 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1312 { | |
| 1313 bool found = false; | |
| 1314 octave_idx_type k; | |
| 1315 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1316 if (ridx(i) == b.ridx(k)) | |
| 1317 { | |
| 1318 found = true; | |
| 1319 break; | |
| 1320 } | |
| 1321 if (found) | |
| 5164 | 1322 { |
| 5630 | 1323 retval.xridx (ii) = l; |
| 1324 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1325 } |
| 5630 | 1326 } |
| 5164 | 1327 retval.xcidx(j+1) = ii; |
| 1328 } | |
| 1329 | |
| 5681 | 1330 if (calc_cond) |
| 1331 { | |
| 1332 double dmax = 0., dmin = octave_Inf; | |
| 1333 for (octave_idx_type i = 0; i < nm; i++) | |
| 1334 { | |
| 1335 double tmp = std::abs(data(i)); | |
| 1336 if (tmp > dmax) | |
| 1337 dmax = tmp; | |
| 1338 if (tmp < dmin) | |
| 1339 dmin = tmp; | |
| 1340 } | |
| 1341 rcond = dmin / dmax; | |
| 1342 } | |
| 1343 else | |
| 1344 rcond = 1.0; | |
| 5164 | 1345 } |
| 1346 else | |
| 1347 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1348 } | |
| 1349 | |
| 1350 return retval; | |
| 1351 } | |
| 1352 | |
| 1353 ComplexMatrix | |
| 5785 | 1354 SparseComplexMatrix::dsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 1355 octave_idx_type& err, double& rcond, |
| 5681 | 1356 solve_singularity_handler, |
| 1357 bool calc_cond) const | |
| 5164 | 1358 { |
| 1359 ComplexMatrix retval; | |
| 1360 | |
| 5275 | 1361 octave_idx_type nr = rows (); |
| 1362 octave_idx_type nc = cols (); | |
| 5630 | 1363 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1364 err = 0; |
| 1365 | |
| 6924 | 1366 if (nr != b.rows ()) |
| 5164 | 1367 (*current_liboctave_error_handler) |
| 1368 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1369 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1370 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 1371 else |
| 1372 { | |
| 1373 // Print spparms("spumoni") info if requested | |
| 1374 int typ = mattype.type (); | |
| 1375 mattype.info (); | |
| 1376 | |
| 5785 | 1377 if (typ == MatrixType::Diagonal || |
| 1378 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1379 { |
| 5630 | 1380 retval.resize (nc, b.cols(), Complex(0.,0.)); |
| 5785 | 1381 if (typ == MatrixType::Diagonal) |
| 5275 | 1382 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1383 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1384 retval(i,j) = b(i,j) / data (i); |
| 1385 else | |
| 5275 | 1386 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5630 | 1387 for (octave_idx_type k = 0; k < nc; k++) |
| 1388 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 1389 retval(k,j) = b(ridx(i),j) / data (i); | |
| 5164 | 1390 |
| 5681 | 1391 if (calc_cond) |
| 1392 { | |
| 1393 double dmax = 0., dmin = octave_Inf; | |
| 1394 for (octave_idx_type i = 0; i < nr; i++) | |
| 1395 { | |
| 1396 double tmp = std::abs(data(i)); | |
| 1397 if (tmp > dmax) | |
| 1398 dmax = tmp; | |
| 1399 if (tmp < dmin) | |
| 1400 dmin = tmp; | |
| 1401 } | |
| 1402 rcond = dmin / dmax; | |
| 1403 } | |
| 1404 else | |
| 1405 rcond = 1.0; | |
| 5164 | 1406 } |
| 1407 else | |
| 1408 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1409 } | |
| 1410 | |
| 1411 return retval; | |
| 1412 } | |
| 1413 | |
| 1414 SparseComplexMatrix | |
| 5785 | 1415 SparseComplexMatrix::dsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 1416 octave_idx_type& err, double& rcond, |
| 5681 | 1417 solve_singularity_handler, |
| 1418 bool calc_cond) const | |
| 5164 | 1419 { |
| 1420 SparseComplexMatrix retval; | |
| 1421 | |
| 5275 | 1422 octave_idx_type nr = rows (); |
| 1423 octave_idx_type nc = cols (); | |
| 5630 | 1424 octave_idx_type nm = (nc < nr ? nc : nr); |
| 5164 | 1425 err = 0; |
| 1426 | |
| 6924 | 1427 if (nr != b.rows ()) |
| 5164 | 1428 (*current_liboctave_error_handler) |
| 1429 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1430 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1431 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 1432 else |
| 1433 { | |
| 1434 // Print spparms("spumoni") info if requested | |
| 1435 int typ = mattype.type (); | |
| 1436 mattype.info (); | |
| 1437 | |
| 5785 | 1438 if (typ == MatrixType::Diagonal || |
| 1439 typ == MatrixType::Permuted_Diagonal) | |
| 5164 | 1440 { |
| 5275 | 1441 octave_idx_type b_nc = b.cols (); |
| 5681 | 1442 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1443 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 1444 |
| 1445 retval.xcidx(0) = 0; | |
| 5275 | 1446 octave_idx_type ii = 0; |
| 5785 | 1447 if (typ == MatrixType::Diagonal) |
| 5275 | 1448 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1449 { |
| 5275 | 1450 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1451 { |
| 5681 | 1452 if (b.ridx(i) >= nm) |
| 1453 break; | |
| 5164 | 1454 retval.xridx (ii) = b.ridx(i); |
| 1455 retval.xdata (ii++) = b.data(i) / data (b.ridx (i)); | |
| 1456 } | |
| 1457 retval.xcidx(j+1) = ii; | |
| 1458 } | |
| 1459 else | |
| 5275 | 1460 for (octave_idx_type j = 0; j < b.cols(); j++) |
| 5164 | 1461 { |
| 5630 | 1462 for (octave_idx_type l = 0; l < nc; l++) |
| 1463 for (octave_idx_type i = cidx(l); i < cidx(l+1); i++) | |
| 1464 { | |
| 1465 bool found = false; | |
| 1466 octave_idx_type k; | |
| 1467 for (k = b.cidx(j); k < b.cidx(j+1); k++) | |
| 1468 if (ridx(i) == b.ridx(k)) | |
| 1469 { | |
| 1470 found = true; | |
| 1471 break; | |
| 1472 } | |
| 1473 if (found) | |
| 5164 | 1474 { |
| 5630 | 1475 retval.xridx (ii) = l; |
| 1476 retval.xdata (ii++) = b.data(k) / data (i); | |
| 5164 | 1477 } |
| 5630 | 1478 } |
| 5164 | 1479 retval.xcidx(j+1) = ii; |
| 1480 } | |
| 1481 | |
| 5681 | 1482 if (calc_cond) |
| 1483 { | |
| 1484 double dmax = 0., dmin = octave_Inf; | |
| 1485 for (octave_idx_type i = 0; i < nm; i++) | |
| 1486 { | |
| 1487 double tmp = std::abs(data(i)); | |
| 1488 if (tmp > dmax) | |
| 1489 dmax = tmp; | |
| 1490 if (tmp < dmin) | |
| 1491 dmin = tmp; | |
| 1492 } | |
| 1493 rcond = dmin / dmax; | |
| 1494 } | |
| 1495 else | |
| 1496 rcond = 1.0; | |
| 5164 | 1497 } |
| 1498 else | |
| 1499 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1500 } | |
| 1501 | |
| 1502 return retval; | |
| 1503 } | |
| 1504 | |
| 1505 ComplexMatrix | |
| 5785 | 1506 SparseComplexMatrix::utsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 1507 octave_idx_type& err, double& rcond, |
| 5681 | 1508 solve_singularity_handler sing_handler, |
| 1509 bool calc_cond) const | |
| 5164 | 1510 { |
| 1511 ComplexMatrix retval; | |
| 1512 | |
| 5275 | 1513 octave_idx_type nr = rows (); |
| 1514 octave_idx_type nc = cols (); | |
| 5630 | 1515 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1516 err = 0; |
| 1517 | |
| 6924 | 1518 if (nr != b.rows ()) |
| 5164 | 1519 (*current_liboctave_error_handler) |
| 1520 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1521 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1522 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 1523 else |
| 1524 { | |
| 1525 // Print spparms("spumoni") info if requested | |
| 1526 int typ = mattype.type (); | |
| 1527 mattype.info (); | |
| 1528 | |
| 5785 | 1529 if (typ == MatrixType::Permuted_Upper || |
| 1530 typ == MatrixType::Upper) | |
| 5164 | 1531 { |
| 1532 double anorm = 0.; | |
| 1533 double ainvnorm = 0.; | |
| 5630 | 1534 octave_idx_type b_nc = b.cols (); |
| 5681 | 1535 rcond = 1.; |
| 1536 | |
| 1537 if (calc_cond) | |
| 1538 { | |
| 1539 // Calculate the 1-norm of matrix for rcond calculation | |
| 1540 for (octave_idx_type j = 0; j < nc; j++) | |
| 1541 { | |
| 1542 double atmp = 0.; | |
| 1543 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1544 atmp += std::abs(data(i)); | |
| 1545 if (atmp > anorm) | |
| 1546 anorm = atmp; | |
| 1547 } | |
| 5164 | 1548 } |
| 1549 | |
| 5785 | 1550 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1551 { |
| 5630 | 1552 retval.resize (nc, b_nc); |
| 5322 | 1553 octave_idx_type *perm = mattype.triangular_perm (); |
| 5681 | 1554 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5164 | 1555 |
| 5630 | 1556 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1557 { |
| 5275 | 1558 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 1559 work[i] = b(i,j); |
| 5630 | 1560 for (octave_idx_type i = nr; i < nc; i++) |
| 1561 work[i] = 0.; | |
| 1562 | |
| 1563 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1564 { |
| 5322 | 1565 octave_idx_type kidx = perm[k]; |
| 1566 | |
| 1567 if (work[k] != 0.) | |
| 5164 | 1568 { |
| 5681 | 1569 if (ridx(cidx(kidx+1)-1) != k || |
| 1570 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1571 { |
| 1572 err = -2; | |
| 1573 goto triangular_error; | |
| 1574 } | |
| 1575 | |
| 5322 | 1576 Complex tmp = work[k] / data(cidx(kidx+1)-1); |
| 1577 work[k] = tmp; | |
| 1578 for (octave_idx_type i = cidx(kidx); | |
| 1579 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1580 { |
| 5322 | 1581 octave_idx_type iidx = ridx(i); |
| 1582 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1583 } |
| 1584 } | |
| 1585 } | |
| 1586 | |
| 5630 | 1587 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 1588 retval (perm[i], j) = work[i]; |
| 5164 | 1589 } |
| 1590 | |
| 5681 | 1591 if (calc_cond) |
| 1592 { | |
| 1593 // Calculation of 1-norm of inv(*this) | |
| 1594 for (octave_idx_type i = 0; i < nm; i++) | |
| 1595 work[i] = 0.; | |
| 1596 | |
| 1597 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1598 { |
| 5681 | 1599 work[j] = 1.; |
| 1600 | |
| 1601 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1602 { |
| 5681 | 1603 octave_idx_type iidx = perm[k]; |
| 1604 | |
| 1605 if (work[k] != 0.) | |
| 5164 | 1606 { |
| 5681 | 1607 Complex tmp = work[k] / data(cidx(iidx+1)-1); |
| 1608 work[k] = tmp; | |
| 1609 for (octave_idx_type i = cidx(iidx); | |
| 1610 i < cidx(iidx+1)-1; i++) | |
| 1611 { | |
| 1612 octave_idx_type idx2 = ridx(i); | |
| 1613 work[idx2] = work[idx2] - tmp * data(i); | |
| 1614 } | |
| 5164 | 1615 } |
| 1616 } | |
| 5681 | 1617 double atmp = 0; |
| 1618 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1619 { | |
| 1620 atmp += std::abs(work[i]); | |
| 1621 work[i] = 0.; | |
| 1622 } | |
| 1623 if (atmp > ainvnorm) | |
| 1624 ainvnorm = atmp; | |
| 5164 | 1625 } |
| 5681 | 1626 rcond = 1. / ainvnorm / anorm; |
| 5164 | 1627 } |
| 1628 } | |
| 1629 else | |
| 1630 { | |
| 5630 | 1631 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 1632 retval.resize (nc, b_nc); | |
| 1633 | |
| 1634 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 1635 { |
| 5630 | 1636 for (octave_idx_type i = 0; i < nr; i++) |
| 1637 work[i] = b(i,j); | |
| 1638 for (octave_idx_type i = nr; i < nc; i++) | |
| 1639 work[i] = 0.; | |
| 1640 | |
| 1641 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 1642 { |
| 5630 | 1643 if (work[k] != 0.) |
| 5164 | 1644 { |
| 5681 | 1645 if (ridx(cidx(k+1)-1) != k || |
| 1646 data(cidx(k+1)-1) == 0.) | |
| 5164 | 1647 { |
| 1648 err = -2; | |
| 1649 goto triangular_error; | |
| 1650 } | |
| 1651 | |
| 5630 | 1652 Complex tmp = work[k] / data(cidx(k+1)-1); |
| 1653 work[k] = tmp; | |
| 5275 | 1654 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 1655 { |
| 5275 | 1656 octave_idx_type iidx = ridx(i); |
| 5630 | 1657 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 1658 } |
| 1659 } | |
| 1660 } | |
| 5630 | 1661 |
| 1662 for (octave_idx_type i = 0; i < nc; i++) | |
| 1663 retval.xelem (i, j) = work[i]; | |
| 5164 | 1664 } |
| 1665 | |
| 5681 | 1666 if (calc_cond) |
| 1667 { | |
| 1668 // Calculation of 1-norm of inv(*this) | |
| 1669 for (octave_idx_type i = 0; i < nm; i++) | |
| 1670 work[i] = 0.; | |
| 1671 | |
| 1672 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1673 { |
| 5681 | 1674 work[j] = 1.; |
| 1675 | |
| 1676 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1677 { |
| 5681 | 1678 if (work[k] != 0.) |
| 5164 | 1679 { |
| 5681 | 1680 Complex tmp = work[k] / data(cidx(k+1)-1); |
| 1681 work[k] = tmp; | |
| 1682 for (octave_idx_type i = cidx(k); | |
| 1683 i < cidx(k+1)-1; i++) | |
| 1684 { | |
| 1685 octave_idx_type iidx = ridx(i); | |
| 1686 work[iidx] = work[iidx] - tmp * data(i); | |
| 1687 } | |
| 5164 | 1688 } |
| 1689 } | |
| 5681 | 1690 double atmp = 0; |
| 1691 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1692 { | |
| 1693 atmp += std::abs(work[i]); | |
| 1694 work[i] = 0.; | |
| 1695 } | |
| 1696 if (atmp > ainvnorm) | |
| 1697 ainvnorm = atmp; | |
| 5164 | 1698 } |
| 5681 | 1699 rcond = 1. / ainvnorm / anorm; |
| 1700 } | |
| 1701 } | |
| 5164 | 1702 |
| 1703 triangular_error: | |
| 1704 if (err != 0) | |
| 1705 { | |
| 1706 if (sing_handler) | |
| 5681 | 1707 { |
| 1708 sing_handler (rcond); | |
| 1709 mattype.mark_as_rectangular (); | |
| 1710 } | |
| 5164 | 1711 else |
| 1712 (*current_liboctave_error_handler) | |
| 1713 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 1714 rcond); | |
| 1715 } | |
| 1716 | |
| 1717 volatile double rcond_plus_one = rcond + 1.0; | |
| 1718 | |
| 1719 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 1720 { | |
| 1721 err = -2; | |
| 1722 | |
| 1723 if (sing_handler) | |
| 5681 | 1724 { |
| 1725 sing_handler (rcond); | |
| 1726 mattype.mark_as_rectangular (); | |
| 1727 } | |
| 5164 | 1728 else |
| 1729 (*current_liboctave_error_handler) | |
| 1730 ("matrix singular to machine precision, rcond = %g", | |
| 1731 rcond); | |
| 1732 } | |
| 1733 } | |
| 1734 else | |
| 1735 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 1736 } | |
| 1737 | |
| 1738 return retval; | |
| 1739 } | |
| 1740 | |
| 1741 SparseComplexMatrix | |
| 5785 | 1742 SparseComplexMatrix::utsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 1743 octave_idx_type& err, double& rcond, |
| 5681 | 1744 solve_singularity_handler sing_handler, |
| 1745 bool calc_cond) const | |
| 5164 | 1746 { |
| 1747 SparseComplexMatrix retval; | |
| 1748 | |
| 5275 | 1749 octave_idx_type nr = rows (); |
| 1750 octave_idx_type nc = cols (); | |
| 5630 | 1751 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 1752 err = 0; |
| 1753 | |
| 6924 | 1754 if (nr != b.rows ()) |
| 5164 | 1755 (*current_liboctave_error_handler) |
| 1756 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 1757 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 1758 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 1759 else |
| 1760 { | |
| 1761 // Print spparms("spumoni") info if requested | |
| 1762 int typ = mattype.type (); | |
| 1763 mattype.info (); | |
| 1764 | |
| 5785 | 1765 if (typ == MatrixType::Permuted_Upper || |
| 1766 typ == MatrixType::Upper) | |
| 5164 | 1767 { |
| 1768 double anorm = 0.; | |
| 1769 double ainvnorm = 0.; | |
| 5681 | 1770 rcond = 1.; |
| 1771 | |
| 1772 if (calc_cond) | |
| 1773 { | |
| 1774 // Calculate the 1-norm of matrix for rcond calculation | |
| 1775 for (octave_idx_type j = 0; j < nc; j++) | |
| 1776 { | |
| 1777 double atmp = 0.; | |
| 1778 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 1779 atmp += std::abs(data(i)); | |
| 1780 if (atmp > anorm) | |
| 1781 anorm = atmp; | |
| 1782 } | |
| 5164 | 1783 } |
| 1784 | |
| 5275 | 1785 octave_idx_type b_nc = b.cols (); |
| 5681 | 1786 octave_idx_type b_nz = b.nnz (); |
| 5630 | 1787 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 1788 retval.xcidx(0) = 0; |
| 5275 | 1789 octave_idx_type ii = 0; |
| 1790 octave_idx_type x_nz = b_nz; | |
| 5164 | 1791 |
| 5785 | 1792 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 1793 { |
| 5322 | 1794 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 1795 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 1796 | |
| 1797 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 1798 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 1799 rperm[perm[i]] = i; |
| 5164 | 1800 |
| 5275 | 1801 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1802 { |
| 5630 | 1803 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1804 work[i] = 0.; |
| 5275 | 1805 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1806 work[b.ridx(i)] = b.data(i); |
| 1807 | |
| 5630 | 1808 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 1809 { |
| 5322 | 1810 octave_idx_type kidx = perm[k]; |
| 1811 | |
| 1812 if (work[k] != 0.) | |
| 5164 | 1813 { |
| 5681 | 1814 if (ridx(cidx(kidx+1)-1) != k || |
| 1815 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 1816 { |
| 1817 err = -2; | |
| 1818 goto triangular_error; | |
| 1819 } | |
| 1820 | |
| 5322 | 1821 Complex tmp = work[k] / data(cidx(kidx+1)-1); |
| 1822 work[k] = tmp; | |
| 1823 for (octave_idx_type i = cidx(kidx); | |
| 1824 i < cidx(kidx+1)-1; i++) | |
| 5164 | 1825 { |
| 5322 | 1826 octave_idx_type iidx = ridx(i); |
| 1827 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 1828 } |
| 1829 } | |
| 1830 } | |
| 1831 | |
| 1832 // Count non-zeros in work vector and adjust space in | |
| 1833 // retval if needed | |
| 5275 | 1834 octave_idx_type new_nnz = 0; |
| 5630 | 1835 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 1836 if (work[i] != 0.) |
| 1837 new_nnz++; | |
| 1838 | |
| 1839 if (ii + new_nnz > x_nz) | |
| 1840 { | |
| 1841 // Resize the sparse matrix | |
| 5275 | 1842 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 1843 retval.change_capacity (sz); |
| 1844 x_nz = sz; | |
| 1845 } | |
| 1846 | |
| 5630 | 1847 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 1848 if (work[rperm[i]] != 0.) |
| 5164 | 1849 { |
| 1850 retval.xridx(ii) = i; | |
| 5322 | 1851 retval.xdata(ii++) = work[rperm[i]]; |
| 5164 | 1852 } |
| 1853 retval.xcidx(j+1) = ii; | |
| 1854 } | |
| 1855 | |
| 1856 retval.maybe_compress (); | |
| 1857 | |
| 5681 | 1858 if (calc_cond) |
| 1859 { | |
| 1860 // Calculation of 1-norm of inv(*this) | |
| 1861 for (octave_idx_type i = 0; i < nm; i++) | |
| 1862 work[i] = 0.; | |
| 1863 | |
| 1864 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1865 { |
| 5681 | 1866 work[j] = 1.; |
| 1867 | |
| 1868 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1869 { |
| 5681 | 1870 octave_idx_type iidx = perm[k]; |
| 1871 | |
| 1872 if (work[k] != 0.) | |
| 5164 | 1873 { |
| 5681 | 1874 Complex tmp = work[k] / data(cidx(iidx+1)-1); |
| 1875 work[k] = tmp; | |
| 1876 for (octave_idx_type i = cidx(iidx); | |
| 1877 i < cidx(iidx+1)-1; i++) | |
| 1878 { | |
| 1879 octave_idx_type idx2 = ridx(i); | |
| 1880 work[idx2] = work[idx2] - tmp * data(i); | |
| 1881 } | |
| 5164 | 1882 } |
| 1883 } | |
| 5681 | 1884 double atmp = 0; |
| 1885 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1886 { | |
| 1887 atmp += std::abs(work[i]); | |
| 1888 work[i] = 0.; | |
| 1889 } | |
| 1890 if (atmp > ainvnorm) | |
| 1891 ainvnorm = atmp; | |
| 5164 | 1892 } |
| 5681 | 1893 rcond = 1. / ainvnorm / anorm; |
| 5164 | 1894 } |
| 1895 } | |
| 1896 else | |
| 1897 { | |
| 5630 | 1898 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5164 | 1899 |
| 5275 | 1900 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 1901 { |
| 5630 | 1902 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 1903 work[i] = 0.; |
| 5275 | 1904 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 1905 work[b.ridx(i)] = b.data(i); |
| 1906 | |
| 5630 | 1907 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 1908 { |
| 1909 if (work[k] != 0.) | |
| 1910 { | |
| 5681 | 1911 if (ridx(cidx(k+1)-1) != k || |
| 1912 data(cidx(k+1)-1) == 0.) | |
| 5164 | 1913 { |
| 1914 err = -2; | |
| 1915 goto triangular_error; | |
| 1916 } | |
| 1917 | |
| 1918 Complex tmp = work[k] / data(cidx(k+1)-1); | |
| 1919 work[k] = tmp; | |
| 5275 | 1920 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 1921 { |
| 5275 | 1922 octave_idx_type iidx = ridx(i); |
| 5164 | 1923 work[iidx] = work[iidx] - tmp * data(i); |
| 1924 } | |
| 1925 } | |
| 1926 } | |
| 1927 | |
| 1928 // Count non-zeros in work vector and adjust space in | |
| 1929 // retval if needed | |
| 5275 | 1930 octave_idx_type new_nnz = 0; |
| 5630 | 1931 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 1932 if (work[i] != 0.) |
| 1933 new_nnz++; | |
| 1934 | |
| 1935 if (ii + new_nnz > x_nz) | |
| 1936 { | |
| 1937 // Resize the sparse matrix | |
| 5275 | 1938 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 1939 retval.change_capacity (sz); |
| 1940 x_nz = sz; | |
| 1941 } | |
| 1942 | |
| 5630 | 1943 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 1944 if (work[i] != 0.) |
| 1945 { | |
| 1946 retval.xridx(ii) = i; | |
| 1947 retval.xdata(ii++) = work[i]; | |
| 1948 } | |
| 1949 retval.xcidx(j+1) = ii; | |
| 1950 } | |
| 1951 | |
| 1952 retval.maybe_compress (); | |
| 1953 | |
| 5681 | 1954 if (calc_cond) |
| 1955 { | |
| 1956 // Calculation of 1-norm of inv(*this) | |
| 1957 for (octave_idx_type i = 0; i < nm; i++) | |
| 1958 work[i] = 0.; | |
| 1959 | |
| 1960 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 1961 { |
| 5681 | 1962 work[j] = 1.; |
| 1963 | |
| 1964 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 1965 { |
| 5681 | 1966 if (work[k] != 0.) |
| 5164 | 1967 { |
| 5681 | 1968 Complex tmp = work[k] / data(cidx(k+1)-1); |
| 1969 work[k] = tmp; | |
| 1970 for (octave_idx_type i = cidx(k); | |
| 1971 i < cidx(k+1)-1; i++) | |
| 1972 { | |
| 1973 octave_idx_type iidx = ridx(i); | |
| 1974 work[iidx] = work[iidx] - tmp * data(i); | |
| 1975 } | |
| 5164 | 1976 } |
| 1977 } | |
| 5681 | 1978 double atmp = 0; |
| 1979 for (octave_idx_type i = 0; i < j+1; i++) | |
| 1980 { | |
| 1981 atmp += std::abs(work[i]); | |
| 1982 work[i] = 0.; | |
| 1983 } | |
| 1984 if (atmp > ainvnorm) | |
| 1985 ainvnorm = atmp; | |
| 5164 | 1986 } |
| 5681 | 1987 rcond = 1. / ainvnorm / anorm; |
| 1988 } | |
| 1989 } | |
| 5164 | 1990 |
| 1991 triangular_error: | |
| 1992 if (err != 0) | |
| 1993 { | |
| 1994 if (sing_handler) | |
| 5681 | 1995 { |
| 1996 sing_handler (rcond); | |
| 1997 mattype.mark_as_rectangular (); | |
| 1998 } | |
| 5164 | 1999 else |
| 2000 (*current_liboctave_error_handler) | |
| 2001 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2002 rcond); | |
| 2003 } | |
| 2004 | |
| 2005 volatile double rcond_plus_one = rcond + 1.0; | |
| 2006 | |
| 2007 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2008 { | |
| 2009 err = -2; | |
| 2010 | |
| 2011 if (sing_handler) | |
| 5681 | 2012 { |
| 2013 sing_handler (rcond); | |
| 2014 mattype.mark_as_rectangular (); | |
| 2015 } | |
| 5164 | 2016 else |
| 2017 (*current_liboctave_error_handler) | |
| 2018 ("matrix singular to machine precision, rcond = %g", | |
| 2019 rcond); | |
| 2020 } | |
| 2021 } | |
| 2022 else | |
| 2023 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2024 } | |
| 2025 return retval; | |
| 2026 } | |
| 2027 | |
| 2028 ComplexMatrix | |
| 5785 | 2029 SparseComplexMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 2030 octave_idx_type& err, double& rcond, |
| 5681 | 2031 solve_singularity_handler sing_handler, |
| 2032 bool calc_cond) const | |
| 5164 | 2033 { |
| 2034 ComplexMatrix retval; | |
| 2035 | |
| 5275 | 2036 octave_idx_type nr = rows (); |
| 2037 octave_idx_type nc = cols (); | |
| 5630 | 2038 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2039 err = 0; |
| 2040 | |
| 6924 | 2041 if (nr != b.rows ()) |
| 5164 | 2042 (*current_liboctave_error_handler) |
| 2043 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2044 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2045 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 2046 else |
| 2047 { | |
| 2048 // Print spparms("spumoni") info if requested | |
| 2049 int typ = mattype.type (); | |
| 2050 mattype.info (); | |
| 2051 | |
| 5785 | 2052 if (typ == MatrixType::Permuted_Upper || |
| 2053 typ == MatrixType::Upper) | |
| 5164 | 2054 { |
| 2055 double anorm = 0.; | |
| 2056 double ainvnorm = 0.; | |
| 5275 | 2057 octave_idx_type b_nc = b.cols (); |
| 5681 | 2058 rcond = 1.; |
| 2059 | |
| 2060 if (calc_cond) | |
| 2061 { | |
| 2062 // Calculate the 1-norm of matrix for rcond calculation | |
| 2063 for (octave_idx_type j = 0; j < nc; j++) | |
| 2064 { | |
| 2065 double atmp = 0.; | |
| 2066 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2067 atmp += std::abs(data(i)); | |
| 2068 if (atmp > anorm) | |
| 2069 anorm = atmp; | |
| 2070 } | |
| 5164 | 2071 } |
| 2072 | |
| 5785 | 2073 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2074 { |
| 5630 | 2075 retval.resize (nc, b_nc); |
| 5322 | 2076 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2077 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5164 | 2078 |
| 5275 | 2079 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2080 { |
| 5275 | 2081 for (octave_idx_type i = 0; i < nr; i++) |
| 5164 | 2082 work[i] = b(i,j); |
| 5630 | 2083 for (octave_idx_type i = nr; i < nc; i++) |
| 2084 work[i] = 0.; | |
| 2085 | |
| 2086 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2087 { |
| 5322 | 2088 octave_idx_type kidx = perm[k]; |
| 2089 | |
| 2090 if (work[k] != 0.) | |
| 5164 | 2091 { |
| 5681 | 2092 if (ridx(cidx(kidx+1)-1) != k || |
| 2093 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2094 { |
| 2095 err = -2; | |
| 2096 goto triangular_error; | |
| 2097 } | |
| 2098 | |
| 5322 | 2099 Complex tmp = work[k] / data(cidx(kidx+1)-1); |
| 2100 work[k] = tmp; | |
| 2101 for (octave_idx_type i = cidx(kidx); | |
| 2102 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2103 { |
| 5322 | 2104 octave_idx_type iidx = ridx(i); |
| 2105 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2106 } |
| 2107 } | |
| 2108 } | |
| 2109 | |
| 5630 | 2110 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2111 retval (perm[i], j) = work[i]; |
| 5164 | 2112 } |
| 2113 | |
| 5681 | 2114 if (calc_cond) |
| 2115 { | |
| 2116 // Calculation of 1-norm of inv(*this) | |
| 2117 for (octave_idx_type i = 0; i < nm; i++) | |
| 2118 work[i] = 0.; | |
| 2119 | |
| 2120 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2121 { |
| 5681 | 2122 work[j] = 1.; |
| 2123 | |
| 2124 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2125 { |
| 5681 | 2126 octave_idx_type iidx = perm[k]; |
| 2127 | |
| 2128 if (work[k] != 0.) | |
| 5164 | 2129 { |
| 5681 | 2130 Complex tmp = work[k] / data(cidx(iidx+1)-1); |
| 2131 work[k] = tmp; | |
| 2132 for (octave_idx_type i = cidx(iidx); | |
| 2133 i < cidx(iidx+1)-1; i++) | |
| 2134 { | |
| 2135 octave_idx_type idx2 = ridx(i); | |
| 2136 work[idx2] = work[idx2] - tmp * data(i); | |
| 2137 } | |
| 5164 | 2138 } |
| 2139 } | |
| 5681 | 2140 double atmp = 0; |
| 2141 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2142 { | |
| 2143 atmp += std::abs(work[i]); | |
| 2144 work[i] = 0.; | |
| 2145 } | |
| 2146 if (atmp > ainvnorm) | |
| 2147 ainvnorm = atmp; | |
| 5164 | 2148 } |
| 5681 | 2149 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2150 } |
| 2151 } | |
| 2152 else | |
| 2153 { | |
| 5630 | 2154 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 2155 retval.resize (nc, b_nc); | |
| 5164 | 2156 |
| 5275 | 2157 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2158 { |
| 5630 | 2159 for (octave_idx_type i = 0; i < nr; i++) |
| 2160 work[i] = b(i,j); | |
| 2161 for (octave_idx_type i = nr; i < nc; i++) | |
| 2162 work[i] = 0.; | |
| 2163 | |
| 2164 for (octave_idx_type k = nc-1; k >= 0; k--) | |
| 5164 | 2165 { |
| 5630 | 2166 if (work[k] != 0.) |
| 5164 | 2167 { |
| 5681 | 2168 if (ridx(cidx(k+1)-1) != k || |
| 2169 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2170 { |
| 2171 err = -2; | |
| 2172 goto triangular_error; | |
| 2173 } | |
| 2174 | |
| 5630 | 2175 Complex tmp = work[k] / data(cidx(k+1)-1); |
| 2176 work[k] = tmp; | |
| 5275 | 2177 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2178 { |
| 5275 | 2179 octave_idx_type iidx = ridx(i); |
| 5630 | 2180 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 2181 } |
| 2182 } | |
| 2183 } | |
| 5630 | 2184 |
| 2185 for (octave_idx_type i = 0; i < nc; i++) | |
| 2186 retval.xelem (i, j) = work[i]; | |
| 5164 | 2187 } |
| 2188 | |
| 5681 | 2189 if (calc_cond) |
| 2190 { | |
| 2191 // Calculation of 1-norm of inv(*this) | |
| 2192 for (octave_idx_type i = 0; i < nm; i++) | |
| 2193 work[i] = 0.; | |
| 2194 | |
| 2195 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2196 { |
| 5681 | 2197 work[j] = 1.; |
| 2198 | |
| 2199 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2200 { |
| 5681 | 2201 if (work[k] != 0.) |
| 5164 | 2202 { |
| 5681 | 2203 Complex tmp = work[k] / data(cidx(k+1)-1); |
| 2204 work[k] = tmp; | |
| 2205 for (octave_idx_type i = cidx(k); | |
| 2206 i < cidx(k+1)-1; i++) | |
| 2207 { | |
| 2208 octave_idx_type iidx = ridx(i); | |
| 2209 work[iidx] = work[iidx] - tmp * data(i); | |
| 2210 } | |
| 5164 | 2211 } |
| 2212 } | |
| 5681 | 2213 double atmp = 0; |
| 2214 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2215 { | |
| 2216 atmp += std::abs(work[i]); | |
| 2217 work[i] = 0.; | |
| 2218 } | |
| 2219 if (atmp > ainvnorm) | |
| 2220 ainvnorm = atmp; | |
| 5164 | 2221 } |
| 5681 | 2222 rcond = 1. / ainvnorm / anorm; |
| 2223 } | |
| 2224 } | |
| 5164 | 2225 |
| 2226 triangular_error: | |
| 2227 if (err != 0) | |
| 2228 { | |
| 2229 if (sing_handler) | |
| 5681 | 2230 { |
| 2231 sing_handler (rcond); | |
| 2232 mattype.mark_as_rectangular (); | |
| 2233 } | |
| 5164 | 2234 else |
| 2235 (*current_liboctave_error_handler) | |
| 2236 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2237 rcond); | |
| 2238 } | |
| 2239 | |
| 2240 volatile double rcond_plus_one = rcond + 1.0; | |
| 2241 | |
| 2242 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2243 { | |
| 2244 err = -2; | |
| 2245 | |
| 2246 if (sing_handler) | |
| 5681 | 2247 { |
| 2248 sing_handler (rcond); | |
| 2249 mattype.mark_as_rectangular (); | |
| 2250 } | |
| 5164 | 2251 else |
| 2252 (*current_liboctave_error_handler) | |
| 2253 ("matrix singular to machine precision, rcond = %g", | |
| 2254 rcond); | |
| 2255 } | |
| 2256 } | |
| 2257 else | |
| 2258 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2259 } | |
| 2260 | |
| 2261 return retval; | |
| 2262 } | |
| 2263 | |
| 2264 SparseComplexMatrix | |
| 5785 | 2265 SparseComplexMatrix::utsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 2266 octave_idx_type& err, double& rcond, |
| 5681 | 2267 solve_singularity_handler sing_handler, |
| 2268 bool calc_cond) const | |
| 5164 | 2269 { |
| 2270 SparseComplexMatrix retval; | |
| 2271 | |
| 5275 | 2272 octave_idx_type nr = rows (); |
| 2273 octave_idx_type nc = cols (); | |
| 5630 | 2274 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2275 err = 0; |
| 2276 | |
| 6924 | 2277 if (nr != b.rows ()) |
| 5164 | 2278 (*current_liboctave_error_handler) |
| 2279 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2280 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2281 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 2282 else |
| 2283 { | |
| 2284 // Print spparms("spumoni") info if requested | |
| 2285 int typ = mattype.type (); | |
| 2286 mattype.info (); | |
| 2287 | |
| 5785 | 2288 if (typ == MatrixType::Permuted_Upper || |
| 2289 typ == MatrixType::Upper) | |
| 5164 | 2290 { |
| 2291 double anorm = 0.; | |
| 2292 double ainvnorm = 0.; | |
| 5681 | 2293 rcond = 1.; |
| 2294 | |
| 2295 if (calc_cond) | |
| 2296 { | |
| 2297 // Calculate the 1-norm of matrix for rcond calculation | |
| 2298 for (octave_idx_type j = 0; j < nc; j++) | |
| 2299 { | |
| 2300 double atmp = 0.; | |
| 2301 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2302 atmp += std::abs(data(i)); | |
| 2303 if (atmp > anorm) | |
| 2304 anorm = atmp; | |
| 2305 } | |
| 5164 | 2306 } |
| 2307 | |
| 5275 | 2308 octave_idx_type b_nc = b.cols (); |
| 5681 | 2309 octave_idx_type b_nz = b.nnz (); |
| 5630 | 2310 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 2311 retval.xcidx(0) = 0; |
| 5275 | 2312 octave_idx_type ii = 0; |
| 2313 octave_idx_type x_nz = b_nz; | |
| 5164 | 2314 |
| 5785 | 2315 if (typ == MatrixType::Permuted_Upper) |
| 5164 | 2316 { |
| 5322 | 2317 octave_idx_type *perm = mattype.triangular_perm (); |
| 5630 | 2318 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 2319 | |
| 2320 OCTAVE_LOCAL_BUFFER (octave_idx_type, rperm, nc); | |
| 2321 for (octave_idx_type i = 0; i < nc; i++) | |
| 5322 | 2322 rperm[perm[i]] = i; |
| 5164 | 2323 |
| 5275 | 2324 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2325 { |
| 5630 | 2326 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 2327 work[i] = 0.; |
| 5275 | 2328 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 2329 work[b.ridx(i)] = b.data(i); |
| 2330 | |
| 5630 | 2331 for (octave_idx_type k = nc-1; k >= 0; k--) |
| 5164 | 2332 { |
| 5322 | 2333 octave_idx_type kidx = perm[k]; |
| 2334 | |
| 2335 if (work[k] != 0.) | |
| 5164 | 2336 { |
| 5681 | 2337 if (ridx(cidx(kidx+1)-1) != k || |
| 2338 data(cidx(kidx+1)-1) == 0.) | |
| 5164 | 2339 { |
| 2340 err = -2; | |
| 2341 goto triangular_error; | |
| 2342 } | |
| 2343 | |
| 5322 | 2344 Complex tmp = work[k] / data(cidx(kidx+1)-1); |
| 2345 work[k] = tmp; | |
| 2346 for (octave_idx_type i = cidx(kidx); | |
| 2347 i < cidx(kidx+1)-1; i++) | |
| 5164 | 2348 { |
| 5322 | 2349 octave_idx_type iidx = ridx(i); |
| 2350 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2351 } |
| 2352 } | |
| 2353 } | |
| 2354 | |
| 2355 // Count non-zeros in work vector and adjust space in | |
| 2356 // retval if needed | |
| 5275 | 2357 octave_idx_type new_nnz = 0; |
| 5630 | 2358 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2359 if (work[i] != 0.) |
| 2360 new_nnz++; | |
| 2361 | |
| 2362 if (ii + new_nnz > x_nz) | |
| 2363 { | |
| 2364 // Resize the sparse matrix | |
| 5275 | 2365 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2366 retval.change_capacity (sz); |
| 2367 x_nz = sz; | |
| 2368 } | |
| 2369 | |
| 5630 | 2370 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2371 if (work[rperm[i]] != 0.) |
| 5164 | 2372 { |
| 2373 retval.xridx(ii) = i; | |
| 5322 | 2374 retval.xdata(ii++) = work[rperm[i]]; |
| 5164 | 2375 } |
| 2376 retval.xcidx(j+1) = ii; | |
| 2377 } | |
| 2378 | |
| 2379 retval.maybe_compress (); | |
| 2380 | |
| 5681 | 2381 if (calc_cond) |
| 2382 { | |
| 2383 // Calculation of 1-norm of inv(*this) | |
| 2384 for (octave_idx_type i = 0; i < nm; i++) | |
| 2385 work[i] = 0.; | |
| 2386 | |
| 2387 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2388 { |
| 5681 | 2389 work[j] = 1.; |
| 2390 | |
| 2391 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2392 { |
| 5681 | 2393 octave_idx_type iidx = perm[k]; |
| 2394 | |
| 2395 if (work[k] != 0.) | |
| 5164 | 2396 { |
| 5681 | 2397 Complex tmp = work[k] / data(cidx(iidx+1)-1); |
| 2398 work[k] = tmp; | |
| 2399 for (octave_idx_type i = cidx(iidx); | |
| 2400 i < cidx(iidx+1)-1; i++) | |
| 2401 { | |
| 2402 octave_idx_type idx2 = ridx(i); | |
| 2403 work[idx2] = work[idx2] - tmp * data(i); | |
| 2404 } | |
| 5164 | 2405 } |
| 2406 } | |
| 5681 | 2407 double atmp = 0; |
| 2408 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2409 { | |
| 2410 atmp += std::abs(work[i]); | |
| 2411 work[i] = 0.; | |
| 2412 } | |
| 2413 if (atmp > ainvnorm) | |
| 2414 ainvnorm = atmp; | |
| 5164 | 2415 } |
| 5681 | 2416 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2417 } |
| 2418 } | |
| 2419 else | |
| 2420 { | |
| 5630 | 2421 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5164 | 2422 |
| 5275 | 2423 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2424 { |
| 5630 | 2425 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 2426 work[i] = 0.; |
| 5275 | 2427 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 2428 work[b.ridx(i)] = b.data(i); |
| 2429 | |
| 5275 | 2430 for (octave_idx_type k = nr-1; k >= 0; k--) |
| 5164 | 2431 { |
| 2432 if (work[k] != 0.) | |
| 2433 { | |
| 5681 | 2434 if (ridx(cidx(k+1)-1) != k || |
| 2435 data(cidx(k+1)-1) == 0.) | |
| 5164 | 2436 { |
| 2437 err = -2; | |
| 2438 goto triangular_error; | |
| 2439 } | |
| 2440 | |
| 2441 Complex tmp = work[k] / data(cidx(k+1)-1); | |
| 2442 work[k] = tmp; | |
| 5275 | 2443 for (octave_idx_type i = cidx(k); i < cidx(k+1)-1; i++) |
| 5164 | 2444 { |
| 5275 | 2445 octave_idx_type iidx = ridx(i); |
| 5164 | 2446 work[iidx] = work[iidx] - tmp * data(i); |
| 2447 } | |
| 2448 } | |
| 2449 } | |
| 2450 | |
| 2451 // Count non-zeros in work vector and adjust space in | |
| 2452 // retval if needed | |
| 5275 | 2453 octave_idx_type new_nnz = 0; |
| 5630 | 2454 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2455 if (work[i] != 0.) |
| 2456 new_nnz++; | |
| 2457 | |
| 2458 if (ii + new_nnz > x_nz) | |
| 2459 { | |
| 2460 // Resize the sparse matrix | |
| 5275 | 2461 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2462 retval.change_capacity (sz); |
| 2463 x_nz = sz; | |
| 2464 } | |
| 2465 | |
| 5630 | 2466 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2467 if (work[i] != 0.) |
| 2468 { | |
| 2469 retval.xridx(ii) = i; | |
| 2470 retval.xdata(ii++) = work[i]; | |
| 2471 } | |
| 2472 retval.xcidx(j+1) = ii; | |
| 2473 } | |
| 2474 | |
| 2475 retval.maybe_compress (); | |
| 2476 | |
| 5681 | 2477 if (calc_cond) |
| 2478 { | |
| 2479 // Calculation of 1-norm of inv(*this) | |
| 2480 for (octave_idx_type i = 0; i < nm; i++) | |
| 2481 work[i] = 0.; | |
| 2482 | |
| 2483 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2484 { |
| 5681 | 2485 work[j] = 1.; |
| 2486 | |
| 2487 for (octave_idx_type k = j; k >= 0; k--) | |
| 5164 | 2488 { |
| 5681 | 2489 if (work[k] != 0.) |
| 5164 | 2490 { |
| 5681 | 2491 Complex tmp = work[k] / data(cidx(k+1)-1); |
| 2492 work[k] = tmp; | |
| 2493 for (octave_idx_type i = cidx(k); | |
| 2494 i < cidx(k+1)-1; i++) | |
| 2495 { | |
| 2496 octave_idx_type iidx = ridx(i); | |
| 2497 work[iidx] = work[iidx] - tmp * data(i); | |
| 2498 } | |
| 5164 | 2499 } |
| 2500 } | |
| 5681 | 2501 double atmp = 0; |
| 2502 for (octave_idx_type i = 0; i < j+1; i++) | |
| 2503 { | |
| 2504 atmp += std::abs(work[i]); | |
| 2505 work[i] = 0.; | |
| 2506 } | |
| 2507 if (atmp > ainvnorm) | |
| 2508 ainvnorm = atmp; | |
| 5164 | 2509 } |
| 5681 | 2510 rcond = 1. / ainvnorm / anorm; |
| 2511 } | |
| 2512 } | |
| 5164 | 2513 |
| 2514 triangular_error: | |
| 2515 if (err != 0) | |
| 2516 { | |
| 2517 if (sing_handler) | |
| 5681 | 2518 { |
| 2519 sing_handler (rcond); | |
| 2520 mattype.mark_as_rectangular (); | |
| 2521 } | |
| 5164 | 2522 else |
| 2523 (*current_liboctave_error_handler) | |
| 2524 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2525 rcond); | |
| 2526 } | |
| 2527 | |
| 2528 volatile double rcond_plus_one = rcond + 1.0; | |
| 2529 | |
| 2530 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2531 { | |
| 2532 err = -2; | |
| 2533 | |
| 2534 if (sing_handler) | |
| 5681 | 2535 { |
| 2536 sing_handler (rcond); | |
| 2537 mattype.mark_as_rectangular (); | |
| 2538 } | |
| 5164 | 2539 else |
| 2540 (*current_liboctave_error_handler) | |
| 2541 ("matrix singular to machine precision, rcond = %g", | |
| 2542 rcond); | |
| 2543 } | |
| 2544 } | |
| 2545 else | |
| 2546 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2547 } | |
| 2548 | |
| 2549 return retval; | |
| 2550 } | |
| 2551 | |
| 2552 ComplexMatrix | |
| 5785 | 2553 SparseComplexMatrix::ltsolve (MatrixType &mattype, const Matrix& b, |
| 5630 | 2554 octave_idx_type& err, double& rcond, |
| 5681 | 2555 solve_singularity_handler sing_handler, |
| 2556 bool calc_cond) const | |
| 5164 | 2557 { |
| 2558 ComplexMatrix retval; | |
| 2559 | |
| 5275 | 2560 octave_idx_type nr = rows (); |
| 2561 octave_idx_type nc = cols (); | |
| 5630 | 2562 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 2563 err = 0; |
| 2564 | |
| 6924 | 2565 if (nr != b.rows ()) |
| 5164 | 2566 (*current_liboctave_error_handler) |
| 2567 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2568 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2569 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 2570 else |
| 2571 { | |
| 2572 // Print spparms("spumoni") info if requested | |
| 2573 int typ = mattype.type (); | |
| 2574 mattype.info (); | |
| 2575 | |
| 5785 | 2576 if (typ == MatrixType::Permuted_Lower || |
| 2577 typ == MatrixType::Lower) | |
| 5164 | 2578 { |
| 2579 double anorm = 0.; | |
| 2580 double ainvnorm = 0.; | |
| 5630 | 2581 octave_idx_type b_nc = b.cols (); |
| 5681 | 2582 rcond = 1.; |
| 2583 | |
| 2584 if (calc_cond) | |
| 2585 { | |
| 2586 // Calculate the 1-norm of matrix for rcond calculation | |
| 2587 for (octave_idx_type j = 0; j < nc; j++) | |
| 2588 { | |
| 2589 double atmp = 0.; | |
| 2590 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2591 atmp += std::abs(data(i)); | |
| 2592 if (atmp > anorm) | |
| 2593 anorm = atmp; | |
| 2594 } | |
| 5164 | 2595 } |
| 2596 | |
| 5785 | 2597 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 2598 { |
| 5630 | 2599 retval.resize (nc, b_nc); |
| 2600 OCTAVE_LOCAL_BUFFER (Complex, work, nm); | |
| 5322 | 2601 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 2602 |
| 5630 | 2603 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2604 { |
| 5630 | 2605 for (octave_idx_type i = 0; i < nm; i++) |
| 2606 work[i] = 0.; | |
| 5275 | 2607 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 2608 work[perm[i]] = b(i,j); |
| 5164 | 2609 |
| 5630 | 2610 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 2611 { |
| 5322 | 2612 if (work[k] != 0.) |
| 5164 | 2613 { |
| 5322 | 2614 octave_idx_type minr = nr; |
| 2615 octave_idx_type mini = 0; | |
| 2616 | |
| 2617 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 2618 if (perm[ridx(i)] < minr) | |
| 2619 { | |
| 2620 minr = perm[ridx(i)]; | |
| 2621 mini = i; | |
| 2622 } | |
| 2623 | |
| 5681 | 2624 if (minr != k || data (mini) == 0.) |
| 5164 | 2625 { |
| 2626 err = -2; | |
| 2627 goto triangular_error; | |
| 2628 } | |
| 2629 | |
| 5322 | 2630 Complex tmp = work[k] / data(mini); |
| 2631 work[k] = tmp; | |
| 2632 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 2633 { |
| 5322 | 2634 if (i == mini) |
| 2635 continue; | |
| 2636 | |
| 2637 octave_idx_type iidx = perm[ridx(i)]; | |
| 2638 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2639 } |
| 2640 } | |
| 2641 } | |
| 2642 | |
| 5630 | 2643 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2644 retval (i, j) = work[i]; |
| 5164 | 2645 } |
| 2646 | |
| 5681 | 2647 if (calc_cond) |
| 2648 { | |
| 2649 // Calculation of 1-norm of inv(*this) | |
| 2650 for (octave_idx_type i = 0; i < nm; i++) | |
| 2651 work[i] = 0.; | |
| 2652 | |
| 2653 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2654 { |
| 5681 | 2655 work[j] = 1.; |
| 2656 | |
| 2657 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2658 { |
| 5681 | 2659 if (work[k] != 0.) |
| 5164 | 2660 { |
| 5681 | 2661 octave_idx_type minr = nr; |
| 2662 octave_idx_type mini = 0; | |
| 2663 | |
| 2664 for (octave_idx_type i = cidx(k); | |
| 2665 i < cidx(k+1); i++) | |
| 2666 if (perm[ridx(i)] < minr) | |
| 2667 { | |
| 2668 minr = perm[ridx(i)]; | |
| 2669 mini = i; | |
| 2670 } | |
| 2671 | |
| 2672 Complex tmp = work[k] / data(mini); | |
| 2673 work[k] = tmp; | |
| 2674 for (octave_idx_type i = cidx(k); | |
| 2675 i < cidx(k+1); i++) | |
| 2676 { | |
| 2677 if (i == mini) | |
| 2678 continue; | |
| 2679 | |
| 2680 octave_idx_type iidx = perm[ridx(i)]; | |
| 2681 work[iidx] = work[iidx] - tmp * data(i); | |
| 2682 } | |
| 5164 | 2683 } |
| 2684 } | |
| 5681 | 2685 |
| 2686 double atmp = 0; | |
| 2687 for (octave_idx_type i = j; i < nc; i++) | |
| 2688 { | |
| 2689 atmp += std::abs(work[i]); | |
| 2690 work[i] = 0.; | |
| 2691 } | |
| 2692 if (atmp > ainvnorm) | |
| 2693 ainvnorm = atmp; | |
| 5164 | 2694 } |
| 5681 | 2695 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2696 } |
| 2697 } | |
| 2698 else | |
| 2699 { | |
| 5630 | 2700 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 2701 retval.resize (nc, b_nc, 0.); | |
| 2702 | |
| 2703 for (octave_idx_type j = 0; j < b_nc; j++) | |
| 5164 | 2704 { |
| 5630 | 2705 for (octave_idx_type i = 0; i < nr; i++) |
| 2706 work[i] = b(i,j); | |
| 2707 for (octave_idx_type i = nr; i < nc; i++) | |
| 2708 work[i] = 0.; | |
| 2709 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2710 { |
| 5630 | 2711 if (work[k] != 0.) |
| 5164 | 2712 { |
| 5681 | 2713 if (ridx(cidx(k)) != k || |
| 2714 data(cidx(k)) == 0.) | |
| 5164 | 2715 { |
| 2716 err = -2; | |
| 2717 goto triangular_error; | |
| 2718 } | |
| 2719 | |
| 5630 | 2720 Complex tmp = work[k] / data(cidx(k)); |
| 2721 work[k] = tmp; | |
| 5275 | 2722 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 2723 { |
| 5275 | 2724 octave_idx_type iidx = ridx(i); |
| 5630 | 2725 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 2726 } |
| 2727 } | |
| 2728 } | |
| 5630 | 2729 for (octave_idx_type i = 0; i < nc; i++) |
| 2730 retval.xelem (i, j) = work[i]; | |
| 5164 | 2731 } |
| 2732 | |
| 5681 | 2733 if (calc_cond) |
| 2734 { | |
| 2735 // Calculation of 1-norm of inv(*this) | |
| 2736 for (octave_idx_type i = 0; i < nm; i++) | |
| 2737 work[i] = 0.; | |
| 2738 | |
| 2739 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2740 { |
| 5681 | 2741 work[j] = 1.; |
| 2742 | |
| 2743 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 2744 { |
| 5681 | 2745 |
| 2746 if (work[k] != 0.) | |
| 5164 | 2747 { |
| 5681 | 2748 Complex tmp = work[k] / data(cidx(k)); |
| 2749 work[k] = tmp; | |
| 2750 for (octave_idx_type i = cidx(k)+1; | |
| 2751 i < cidx(k+1); i++) | |
| 2752 { | |
| 2753 octave_idx_type iidx = ridx(i); | |
| 2754 work[iidx] = work[iidx] - tmp * data(i); | |
| 2755 } | |
| 5164 | 2756 } |
| 2757 } | |
| 5681 | 2758 double atmp = 0; |
| 2759 for (octave_idx_type i = j; i < nc; i++) | |
| 2760 { | |
| 2761 atmp += std::abs(work[i]); | |
| 2762 work[i] = 0.; | |
| 2763 } | |
| 2764 if (atmp > ainvnorm) | |
| 2765 ainvnorm = atmp; | |
| 5164 | 2766 } |
| 5681 | 2767 rcond = 1. / ainvnorm / anorm; |
| 2768 } | |
| 2769 } | |
| 5164 | 2770 triangular_error: |
| 2771 if (err != 0) | |
| 2772 { | |
| 2773 if (sing_handler) | |
| 5681 | 2774 { |
| 2775 sing_handler (rcond); | |
| 2776 mattype.mark_as_rectangular (); | |
| 2777 } | |
| 5164 | 2778 else |
| 2779 (*current_liboctave_error_handler) | |
| 2780 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 2781 rcond); | |
| 2782 } | |
| 2783 | |
| 2784 volatile double rcond_plus_one = rcond + 1.0; | |
| 2785 | |
| 2786 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 2787 { | |
| 2788 err = -2; | |
| 2789 | |
| 2790 if (sing_handler) | |
| 5681 | 2791 { |
| 2792 sing_handler (rcond); | |
| 2793 mattype.mark_as_rectangular (); | |
| 2794 } | |
| 5164 | 2795 else |
| 2796 (*current_liboctave_error_handler) | |
| 2797 ("matrix singular to machine precision, rcond = %g", | |
| 2798 rcond); | |
| 2799 } | |
| 2800 } | |
| 2801 else | |
| 2802 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 2803 } | |
| 2804 | |
| 2805 return retval; | |
| 2806 } | |
| 2807 | |
| 2808 SparseComplexMatrix | |
| 5785 | 2809 SparseComplexMatrix::ltsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5630 | 2810 octave_idx_type& err, double& rcond, |
| 5681 | 2811 solve_singularity_handler sing_handler, |
| 2812 bool calc_cond) const | |
| 5164 | 2813 { |
| 2814 SparseComplexMatrix retval; | |
| 2815 | |
| 5275 | 2816 octave_idx_type nr = rows (); |
| 2817 octave_idx_type nc = cols (); | |
| 5630 | 2818 octave_idx_type nm = (nc > nr ? nc : nr); |
| 2819 | |
| 5164 | 2820 err = 0; |
| 2821 | |
| 6924 | 2822 if (nr != b.rows ()) |
| 5164 | 2823 (*current_liboctave_error_handler) |
| 2824 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 2825 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 2826 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 2827 else |
| 2828 { | |
| 2829 // Print spparms("spumoni") info if requested | |
| 2830 int typ = mattype.type (); | |
| 2831 mattype.info (); | |
| 2832 | |
| 5785 | 2833 if (typ == MatrixType::Permuted_Lower || |
| 2834 typ == MatrixType::Lower) | |
| 5164 | 2835 { |
| 2836 double anorm = 0.; | |
| 2837 double ainvnorm = 0.; | |
| 5681 | 2838 rcond = 1.; |
| 2839 | |
| 2840 if (calc_cond) | |
| 2841 { | |
| 2842 // Calculate the 1-norm of matrix for rcond calculation | |
| 2843 for (octave_idx_type j = 0; j < nc; j++) | |
| 2844 { | |
| 2845 double atmp = 0.; | |
| 2846 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 2847 atmp += std::abs(data(i)); | |
| 2848 if (atmp > anorm) | |
| 2849 anorm = atmp; | |
| 2850 } | |
| 5164 | 2851 } |
| 2852 | |
| 5275 | 2853 octave_idx_type b_nc = b.cols (); |
| 5681 | 2854 octave_idx_type b_nz = b.nnz (); |
| 5630 | 2855 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 2856 retval.xcidx(0) = 0; |
| 5275 | 2857 octave_idx_type ii = 0; |
| 2858 octave_idx_type x_nz = b_nz; | |
| 5164 | 2859 |
| 5785 | 2860 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 2861 { |
| 5630 | 2862 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5322 | 2863 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 2864 |
| 5275 | 2865 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2866 { |
| 5630 | 2867 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 2868 work[i] = 0.; |
| 5275 | 2869 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 2870 work[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 2871 |
| 5630 | 2872 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 2873 { |
| 5322 | 2874 if (work[k] != 0.) |
| 5164 | 2875 { |
| 5322 | 2876 octave_idx_type minr = nr; |
| 2877 octave_idx_type mini = 0; | |
| 2878 | |
| 2879 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 2880 if (perm[ridx(i)] < minr) | |
| 2881 { | |
| 2882 minr = perm[ridx(i)]; | |
| 2883 mini = i; | |
| 2884 } | |
| 2885 | |
| 5681 | 2886 if (minr != k || data (mini) == 0.) |
| 5164 | 2887 { |
| 2888 err = -2; | |
| 2889 goto triangular_error; | |
| 2890 } | |
| 2891 | |
| 5322 | 2892 Complex tmp = work[k] / data(mini); |
| 2893 work[k] = tmp; | |
| 2894 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 2895 { |
| 5322 | 2896 if (i == mini) |
| 2897 continue; | |
| 2898 | |
| 2899 octave_idx_type iidx = perm[ridx(i)]; | |
| 2900 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 2901 } |
| 2902 } | |
| 2903 } | |
| 2904 | |
| 2905 // Count non-zeros in work vector and adjust space in | |
| 2906 // retval if needed | |
| 5275 | 2907 octave_idx_type new_nnz = 0; |
| 5630 | 2908 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 2909 if (work[i] != 0.) |
| 2910 new_nnz++; | |
| 2911 | |
| 2912 if (ii + new_nnz > x_nz) | |
| 2913 { | |
| 2914 // Resize the sparse matrix | |
| 5275 | 2915 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 2916 retval.change_capacity (sz); |
| 2917 x_nz = sz; | |
| 2918 } | |
| 2919 | |
| 5630 | 2920 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 2921 if (work[i] != 0.) |
| 5164 | 2922 { |
| 2923 retval.xridx(ii) = i; | |
| 5322 | 2924 retval.xdata(ii++) = work[i]; |
| 5164 | 2925 } |
| 2926 retval.xcidx(j+1) = ii; | |
| 2927 } | |
| 2928 | |
| 2929 retval.maybe_compress (); | |
| 2930 | |
| 5681 | 2931 if (calc_cond) |
| 2932 { | |
| 2933 // Calculation of 1-norm of inv(*this) | |
| 2934 for (octave_idx_type i = 0; i < nm; i++) | |
| 2935 work[i] = 0.; | |
| 2936 | |
| 2937 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 2938 { |
| 5681 | 2939 work[j] = 1.; |
| 2940 | |
| 2941 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 2942 { |
| 5681 | 2943 if (work[k] != 0.) |
| 5164 | 2944 { |
| 5681 | 2945 octave_idx_type minr = nr; |
| 2946 octave_idx_type mini = 0; | |
| 2947 | |
| 2948 for (octave_idx_type i = cidx(k); | |
| 2949 i < cidx(k+1); i++) | |
| 2950 if (perm[ridx(i)] < minr) | |
| 2951 { | |
| 2952 minr = perm[ridx(i)]; | |
| 2953 mini = i; | |
| 2954 } | |
| 2955 | |
| 2956 Complex tmp = work[k] / data(mini); | |
| 2957 work[k] = tmp; | |
| 2958 for (octave_idx_type i = cidx(k); | |
| 2959 i < cidx(k+1); i++) | |
| 2960 { | |
| 2961 if (i == mini) | |
| 2962 continue; | |
| 2963 | |
| 2964 octave_idx_type iidx = perm[ridx(i)]; | |
| 2965 work[iidx] = work[iidx] - tmp * data(i); | |
| 2966 } | |
| 5164 | 2967 } |
| 2968 } | |
| 5681 | 2969 |
| 2970 double atmp = 0; | |
| 2971 for (octave_idx_type i = j; i < nc; i++) | |
| 2972 { | |
| 2973 atmp += std::abs(work[i]); | |
| 2974 work[i] = 0.; | |
| 2975 } | |
| 2976 if (atmp > ainvnorm) | |
| 2977 ainvnorm = atmp; | |
| 5164 | 2978 } |
| 5681 | 2979 rcond = 1. / ainvnorm / anorm; |
| 5164 | 2980 } |
| 2981 } | |
| 2982 else | |
| 2983 { | |
| 5630 | 2984 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5164 | 2985 |
| 5275 | 2986 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 2987 { |
| 5630 | 2988 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 2989 work[i] = 0.; |
| 5275 | 2990 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 2991 work[b.ridx(i)] = b.data(i); |
| 2992 | |
| 5630 | 2993 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 2994 { |
| 2995 if (work[k] != 0.) | |
| 2996 { | |
| 5681 | 2997 if (ridx(cidx(k)) != k || |
| 2998 data(cidx(k)) == 0.) | |
| 5164 | 2999 { |
| 3000 err = -2; | |
| 3001 goto triangular_error; | |
| 3002 } | |
| 3003 | |
| 3004 Complex tmp = work[k] / data(cidx(k)); | |
| 3005 work[k] = tmp; | |
| 5275 | 3006 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3007 { |
| 5275 | 3008 octave_idx_type iidx = ridx(i); |
| 5164 | 3009 work[iidx] = work[iidx] - tmp * data(i); |
| 3010 } | |
| 3011 } | |
| 3012 } | |
| 3013 | |
| 3014 // Count non-zeros in work vector and adjust space in | |
| 3015 // retval if needed | |
| 5275 | 3016 octave_idx_type new_nnz = 0; |
| 5630 | 3017 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3018 if (work[i] != 0.) |
| 3019 new_nnz++; | |
| 3020 | |
| 3021 if (ii + new_nnz > x_nz) | |
| 3022 { | |
| 3023 // Resize the sparse matrix | |
| 5275 | 3024 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3025 retval.change_capacity (sz); |
| 3026 x_nz = sz; | |
| 3027 } | |
| 3028 | |
| 5630 | 3029 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3030 if (work[i] != 0.) |
| 3031 { | |
| 3032 retval.xridx(ii) = i; | |
| 3033 retval.xdata(ii++) = work[i]; | |
| 3034 } | |
| 3035 retval.xcidx(j+1) = ii; | |
| 3036 } | |
| 3037 | |
| 3038 retval.maybe_compress (); | |
| 3039 | |
| 5681 | 3040 if (calc_cond) |
| 3041 { | |
| 3042 // Calculation of 1-norm of inv(*this) | |
| 3043 for (octave_idx_type i = 0; i < nm; i++) | |
| 3044 work[i] = 0.; | |
| 3045 | |
| 3046 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3047 { |
| 5681 | 3048 work[j] = 1.; |
| 3049 | |
| 3050 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3051 { |
| 5681 | 3052 |
| 3053 if (work[k] != 0.) | |
| 5164 | 3054 { |
| 5681 | 3055 Complex tmp = work[k] / data(cidx(k)); |
| 3056 work[k] = tmp; | |
| 3057 for (octave_idx_type i = cidx(k)+1; | |
| 3058 i < cidx(k+1); i++) | |
| 3059 { | |
| 3060 octave_idx_type iidx = ridx(i); | |
| 3061 work[iidx] = work[iidx] - tmp * data(i); | |
| 3062 } | |
| 5164 | 3063 } |
| 3064 } | |
| 5681 | 3065 double atmp = 0; |
| 3066 for (octave_idx_type i = j; i < nc; i++) | |
| 3067 { | |
| 3068 atmp += std::abs(work[i]); | |
| 3069 work[i] = 0.; | |
| 3070 } | |
| 3071 if (atmp > ainvnorm) | |
| 3072 ainvnorm = atmp; | |
| 5164 | 3073 } |
| 5681 | 3074 rcond = 1. / ainvnorm / anorm; |
| 3075 } | |
| 3076 } | |
| 5164 | 3077 |
| 3078 triangular_error: | |
| 3079 if (err != 0) | |
| 3080 { | |
| 3081 if (sing_handler) | |
| 5681 | 3082 { |
| 3083 sing_handler (rcond); | |
| 3084 mattype.mark_as_rectangular (); | |
| 3085 } | |
| 5164 | 3086 else |
| 3087 (*current_liboctave_error_handler) | |
| 3088 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3089 rcond); | |
| 3090 } | |
| 3091 | |
| 3092 volatile double rcond_plus_one = rcond + 1.0; | |
| 3093 | |
| 3094 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3095 { | |
| 3096 err = -2; | |
| 3097 | |
| 3098 if (sing_handler) | |
| 5681 | 3099 { |
| 3100 sing_handler (rcond); | |
| 3101 mattype.mark_as_rectangular (); | |
| 3102 } | |
| 5164 | 3103 else |
| 3104 (*current_liboctave_error_handler) | |
| 3105 ("matrix singular to machine precision, rcond = %g", | |
| 3106 rcond); | |
| 3107 } | |
| 3108 } | |
| 3109 else | |
| 3110 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3111 } | |
| 3112 | |
| 3113 return retval; | |
| 3114 } | |
| 3115 | |
| 3116 ComplexMatrix | |
| 5785 | 3117 SparseComplexMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5630 | 3118 octave_idx_type& err, double& rcond, |
| 5681 | 3119 solve_singularity_handler sing_handler, |
| 3120 bool calc_cond) const | |
| 5164 | 3121 { |
| 3122 ComplexMatrix retval; | |
| 3123 | |
| 5275 | 3124 octave_idx_type nr = rows (); |
| 3125 octave_idx_type nc = cols (); | |
| 5630 | 3126 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3127 err = 0; |
| 3128 | |
| 6924 | 3129 if (nr != b.rows ()) |
| 5164 | 3130 (*current_liboctave_error_handler) |
| 3131 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3132 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3133 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 3134 else |
| 3135 { | |
| 3136 // Print spparms("spumoni") info if requested | |
| 3137 int typ = mattype.type (); | |
| 3138 mattype.info (); | |
| 3139 | |
| 5785 | 3140 if (typ == MatrixType::Permuted_Lower || |
| 3141 typ == MatrixType::Lower) | |
| 5164 | 3142 { |
| 3143 double anorm = 0.; | |
| 3144 double ainvnorm = 0.; | |
| 5275 | 3145 octave_idx_type b_nc = b.cols (); |
| 5681 | 3146 rcond = 1.; |
| 3147 | |
| 3148 if (calc_cond) | |
| 3149 { | |
| 3150 // Calculate the 1-norm of matrix for rcond calculation | |
| 3151 for (octave_idx_type j = 0; j < nc; j++) | |
| 3152 { | |
| 3153 double atmp = 0.; | |
| 3154 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3155 atmp += std::abs(data(i)); | |
| 3156 if (atmp > anorm) | |
| 3157 anorm = atmp; | |
| 3158 } | |
| 5164 | 3159 } |
| 3160 | |
| 5785 | 3161 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3162 { |
| 5630 | 3163 retval.resize (nc, b_nc); |
| 3164 OCTAVE_LOCAL_BUFFER (Complex, work, nm); | |
| 5322 | 3165 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3166 |
| 5275 | 3167 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3168 { |
| 5630 | 3169 for (octave_idx_type i = 0; i < nm; i++) |
| 3170 work[i] = 0.; | |
| 5275 | 3171 for (octave_idx_type i = 0; i < nr; i++) |
| 5322 | 3172 work[perm[i]] = b(i,j); |
| 5164 | 3173 |
| 5630 | 3174 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3175 { |
| 5322 | 3176 if (work[k] != 0.) |
| 5164 | 3177 { |
| 5322 | 3178 octave_idx_type minr = nr; |
| 3179 octave_idx_type mini = 0; | |
| 3180 | |
| 3181 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3182 if (perm[ridx(i)] < minr) | |
| 3183 { | |
| 3184 minr = perm[ridx(i)]; | |
| 3185 mini = i; | |
| 3186 } | |
| 3187 | |
| 5681 | 3188 if (minr != k || data (mini) == 0.) |
| 5164 | 3189 { |
| 3190 err = -2; | |
| 3191 goto triangular_error; | |
| 3192 } | |
| 3193 | |
| 5322 | 3194 Complex tmp = work[k] / data(mini); |
| 3195 work[k] = tmp; | |
| 3196 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3197 { |
| 5322 | 3198 if (i == mini) |
| 3199 continue; | |
| 3200 | |
| 3201 octave_idx_type iidx = perm[ridx(i)]; | |
| 3202 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 3203 } |
| 3204 } | |
| 3205 } | |
| 3206 | |
| 5630 | 3207 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3208 retval (i, j) = work[i]; |
| 5164 | 3209 } |
| 3210 | |
| 5681 | 3211 if (calc_cond) |
| 3212 { | |
| 3213 // Calculation of 1-norm of inv(*this) | |
| 3214 for (octave_idx_type i = 0; i < nm; i++) | |
| 3215 work[i] = 0.; | |
| 3216 | |
| 3217 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3218 { |
| 5681 | 3219 work[j] = 1.; |
| 3220 | |
| 3221 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3222 { |
| 5681 | 3223 if (work[k] != 0.) |
| 5164 | 3224 { |
| 5681 | 3225 octave_idx_type minr = nr; |
| 3226 octave_idx_type mini = 0; | |
| 3227 | |
| 3228 for (octave_idx_type i = cidx(k); | |
| 3229 i < cidx(k+1); i++) | |
| 3230 if (perm[ridx(i)] < minr) | |
| 3231 { | |
| 3232 minr = perm[ridx(i)]; | |
| 3233 mini = i; | |
| 3234 } | |
| 3235 | |
| 3236 Complex tmp = work[k] / data(mini); | |
| 3237 work[k] = tmp; | |
| 3238 for (octave_idx_type i = cidx(k); | |
| 3239 i < cidx(k+1); i++) | |
| 3240 { | |
| 3241 if (i == mini) | |
| 3242 continue; | |
| 3243 | |
| 3244 octave_idx_type iidx = perm[ridx(i)]; | |
| 3245 work[iidx] = work[iidx] - tmp * data(i); | |
| 3246 } | |
| 5164 | 3247 } |
| 3248 } | |
| 5681 | 3249 |
| 3250 double atmp = 0; | |
| 3251 for (octave_idx_type i = j; i < nc; i++) | |
| 3252 { | |
| 3253 atmp += std::abs(work[i]); | |
| 3254 work[i] = 0.; | |
| 3255 } | |
| 3256 if (atmp > ainvnorm) | |
| 3257 ainvnorm = atmp; | |
| 5164 | 3258 } |
| 5681 | 3259 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3260 } |
| 3261 } | |
| 3262 else | |
| 3263 { | |
| 5630 | 3264 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 3265 retval.resize (nc, b_nc, 0.); | |
| 3266 | |
| 5164 | 3267 |
| 5275 | 3268 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3269 { |
| 5630 | 3270 for (octave_idx_type i = 0; i < nr; i++) |
| 3271 work[i] = b(i,j); | |
| 3272 for (octave_idx_type i = nr; i < nc; i++) | |
| 3273 work[i] = 0.; | |
| 3274 | |
| 3275 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3276 { |
| 5630 | 3277 if (work[k] != 0.) |
| 5164 | 3278 { |
| 5681 | 3279 if (ridx(cidx(k)) != k || |
| 3280 data(cidx(k)) == 0.) | |
| 5164 | 3281 { |
| 3282 err = -2; | |
| 3283 goto triangular_error; | |
| 3284 } | |
| 3285 | |
| 5630 | 3286 Complex tmp = work[k] / data(cidx(k)); |
| 3287 work[k] = tmp; | |
| 5275 | 3288 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3289 { |
| 5275 | 3290 octave_idx_type iidx = ridx(i); |
| 5630 | 3291 work[iidx] = work[iidx] - tmp * data(i); |
| 5164 | 3292 } |
| 3293 } | |
| 3294 } | |
| 5630 | 3295 |
| 3296 for (octave_idx_type i = 0; i < nc; i++) | |
| 3297 retval.xelem (i, j) = work[i]; | |
| 5164 | 3298 } |
| 3299 | |
| 5681 | 3300 if (calc_cond) |
| 3301 { | |
| 3302 // Calculation of 1-norm of inv(*this) | |
| 3303 for (octave_idx_type i = 0; i < nm; i++) | |
| 3304 work[i] = 0.; | |
| 3305 | |
| 3306 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3307 { |
| 5681 | 3308 work[j] = 1.; |
| 3309 | |
| 3310 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3311 { |
| 5681 | 3312 |
| 3313 if (work[k] != 0.) | |
| 5164 | 3314 { |
| 5681 | 3315 Complex tmp = work[k] / data(cidx(k)); |
| 3316 work[k] = tmp; | |
| 3317 for (octave_idx_type i = cidx(k)+1; | |
| 3318 i < cidx(k+1); i++) | |
| 3319 { | |
| 3320 octave_idx_type iidx = ridx(i); | |
| 3321 work[iidx] = work[iidx] - tmp * data(i); | |
| 3322 } | |
| 5164 | 3323 } |
| 3324 } | |
| 5681 | 3325 double atmp = 0; |
| 3326 for (octave_idx_type i = j; i < nc; i++) | |
| 3327 { | |
| 3328 atmp += std::abs(work[i]); | |
| 3329 work[i] = 0.; | |
| 3330 } | |
| 3331 if (atmp > ainvnorm) | |
| 3332 ainvnorm = atmp; | |
| 5164 | 3333 } |
| 5681 | 3334 rcond = 1. / ainvnorm / anorm; |
| 3335 } | |
| 3336 } | |
| 5164 | 3337 |
| 3338 triangular_error: | |
| 3339 if (err != 0) | |
| 3340 { | |
| 3341 if (sing_handler) | |
| 5681 | 3342 { |
| 3343 sing_handler (rcond); | |
| 3344 mattype.mark_as_rectangular (); | |
| 3345 } | |
| 5164 | 3346 else |
| 3347 (*current_liboctave_error_handler) | |
| 3348 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3349 rcond); | |
| 3350 } | |
| 3351 | |
| 3352 volatile double rcond_plus_one = rcond + 1.0; | |
| 3353 | |
| 3354 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3355 { | |
| 3356 err = -2; | |
| 3357 | |
| 3358 if (sing_handler) | |
| 5681 | 3359 { |
| 3360 sing_handler (rcond); | |
| 3361 mattype.mark_as_rectangular (); | |
| 3362 } | |
| 5164 | 3363 else |
| 3364 (*current_liboctave_error_handler) | |
| 3365 ("matrix singular to machine precision, rcond = %g", | |
| 3366 rcond); | |
| 3367 } | |
| 3368 } | |
| 3369 else | |
| 3370 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3371 } | |
| 3372 | |
| 3373 return retval; | |
| 3374 } | |
| 3375 | |
| 3376 SparseComplexMatrix | |
| 5785 | 3377 SparseComplexMatrix::ltsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5630 | 3378 octave_idx_type& err, double& rcond, |
| 5681 | 3379 solve_singularity_handler sing_handler, |
| 3380 bool calc_cond) const | |
| 5164 | 3381 { |
| 3382 SparseComplexMatrix retval; | |
| 3383 | |
| 5275 | 3384 octave_idx_type nr = rows (); |
| 3385 octave_idx_type nc = cols (); | |
| 5630 | 3386 octave_idx_type nm = (nc > nr ? nc : nr); |
| 5164 | 3387 err = 0; |
| 3388 | |
| 6924 | 3389 if (nr != b.rows ()) |
| 5164 | 3390 (*current_liboctave_error_handler) |
| 3391 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3392 else if (nr == 0 || nc == 0 || b.cols () == 0) |
| 3393 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 3394 else |
| 3395 { | |
| 3396 // Print spparms("spumoni") info if requested | |
| 3397 int typ = mattype.type (); | |
| 3398 mattype.info (); | |
| 3399 | |
| 5785 | 3400 if (typ == MatrixType::Permuted_Lower || |
| 3401 typ == MatrixType::Lower) | |
| 5164 | 3402 { |
| 3403 double anorm = 0.; | |
| 3404 double ainvnorm = 0.; | |
| 5681 | 3405 rcond = 1.; |
| 3406 | |
| 3407 if (calc_cond) | |
| 3408 { | |
| 3409 // Calculate the 1-norm of matrix for rcond calculation | |
| 3410 for (octave_idx_type j = 0; j < nc; j++) | |
| 3411 { | |
| 3412 double atmp = 0.; | |
| 3413 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 3414 atmp += std::abs(data(i)); | |
| 3415 if (atmp > anorm) | |
| 3416 anorm = atmp; | |
| 3417 } | |
| 5164 | 3418 } |
| 3419 | |
| 5275 | 3420 octave_idx_type b_nc = b.cols (); |
| 5681 | 3421 octave_idx_type b_nz = b.nnz (); |
| 5630 | 3422 retval = SparseComplexMatrix (nc, b_nc, b_nz); |
| 5164 | 3423 retval.xcidx(0) = 0; |
| 5275 | 3424 octave_idx_type ii = 0; |
| 3425 octave_idx_type x_nz = b_nz; | |
| 5164 | 3426 |
| 5785 | 3427 if (typ == MatrixType::Permuted_Lower) |
| 5164 | 3428 { |
| 5630 | 3429 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5322 | 3430 octave_idx_type *perm = mattype.triangular_perm (); |
| 5164 | 3431 |
| 5275 | 3432 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3433 { |
| 5630 | 3434 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 3435 work[i] = 0.; |
| 5275 | 3436 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5322 | 3437 work[perm[b.ridx(i)]] = b.data(i); |
| 5164 | 3438 |
| 5630 | 3439 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3440 { |
| 5322 | 3441 if (work[k] != 0.) |
| 5164 | 3442 { |
| 5322 | 3443 octave_idx_type minr = nr; |
| 3444 octave_idx_type mini = 0; | |
| 3445 | |
| 3446 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 3447 if (perm[ridx(i)] < minr) | |
| 3448 { | |
| 3449 minr = perm[ridx(i)]; | |
| 3450 mini = i; | |
| 3451 } | |
| 3452 | |
| 5681 | 3453 if (minr != k || data (mini) == 0.) |
| 5164 | 3454 { |
| 3455 err = -2; | |
| 3456 goto triangular_error; | |
| 3457 } | |
| 3458 | |
| 5322 | 3459 Complex tmp = work[k] / data(mini); |
| 3460 work[k] = tmp; | |
| 3461 for (octave_idx_type i = cidx(k); i < cidx(k+1); i++) | |
| 5164 | 3462 { |
| 5322 | 3463 if (i == mini) |
| 3464 continue; | |
| 3465 | |
| 3466 octave_idx_type iidx = perm[ridx(i)]; | |
| 3467 work[iidx] = work[iidx] - tmp * data(i); | |
| 5164 | 3468 } |
| 3469 } | |
| 3470 } | |
| 3471 | |
| 3472 // Count non-zeros in work vector and adjust space in | |
| 3473 // retval if needed | |
| 5275 | 3474 octave_idx_type new_nnz = 0; |
| 5630 | 3475 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3476 if (work[i] != 0.) |
| 3477 new_nnz++; | |
| 3478 | |
| 3479 if (ii + new_nnz > x_nz) | |
| 3480 { | |
| 3481 // Resize the sparse matrix | |
| 5275 | 3482 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3483 retval.change_capacity (sz); |
| 3484 x_nz = sz; | |
| 3485 } | |
| 3486 | |
| 5630 | 3487 for (octave_idx_type i = 0; i < nc; i++) |
| 5322 | 3488 if (work[i] != 0.) |
| 5164 | 3489 { |
| 3490 retval.xridx(ii) = i; | |
| 5322 | 3491 retval.xdata(ii++) = work[i]; |
| 5164 | 3492 } |
| 3493 retval.xcidx(j+1) = ii; | |
| 3494 } | |
| 3495 | |
| 3496 retval.maybe_compress (); | |
| 3497 | |
| 5681 | 3498 if (calc_cond) |
| 3499 { | |
| 3500 // Calculation of 1-norm of inv(*this) | |
| 3501 for (octave_idx_type i = 0; i < nm; i++) | |
| 3502 work[i] = 0.; | |
| 3503 | |
| 3504 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3505 { |
| 5681 | 3506 work[j] = 1.; |
| 3507 | |
| 3508 for (octave_idx_type k = 0; k < nc; k++) | |
| 5164 | 3509 { |
| 5681 | 3510 if (work[k] != 0.) |
| 5164 | 3511 { |
| 5681 | 3512 octave_idx_type minr = nr; |
| 3513 octave_idx_type mini = 0; | |
| 3514 | |
| 3515 for (octave_idx_type i = cidx(k); | |
| 3516 i < cidx(k+1); i++) | |
| 3517 if (perm[ridx(i)] < minr) | |
| 3518 { | |
| 3519 minr = perm[ridx(i)]; | |
| 3520 mini = i; | |
| 3521 } | |
| 3522 | |
| 3523 Complex tmp = work[k] / data(mini); | |
| 3524 work[k] = tmp; | |
| 3525 for (octave_idx_type i = cidx(k); | |
| 3526 i < cidx(k+1); i++) | |
| 3527 { | |
| 3528 if (i == mini) | |
| 3529 continue; | |
| 3530 | |
| 3531 octave_idx_type iidx = perm[ridx(i)]; | |
| 3532 work[iidx] = work[iidx] - tmp * data(i); | |
| 3533 } | |
| 5164 | 3534 } |
| 3535 } | |
| 5681 | 3536 |
| 3537 double atmp = 0; | |
| 3538 for (octave_idx_type i = j; i < nc; i++) | |
| 3539 { | |
| 3540 atmp += std::abs(work[i]); | |
| 3541 work[i] = 0.; | |
| 3542 } | |
| 3543 if (atmp > ainvnorm) | |
| 3544 ainvnorm = atmp; | |
| 5164 | 3545 } |
| 5681 | 3546 rcond = 1. / ainvnorm / anorm; |
| 5164 | 3547 } |
| 3548 } | |
| 3549 else | |
| 3550 { | |
| 5630 | 3551 OCTAVE_LOCAL_BUFFER (Complex, work, nm); |
| 5164 | 3552 |
| 5275 | 3553 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 3554 { |
| 5630 | 3555 for (octave_idx_type i = 0; i < nm; i++) |
| 5164 | 3556 work[i] = 0.; |
| 5275 | 3557 for (octave_idx_type i = b.cidx(j); i < b.cidx(j+1); i++) |
| 5164 | 3558 work[b.ridx(i)] = b.data(i); |
| 3559 | |
| 5630 | 3560 for (octave_idx_type k = 0; k < nc; k++) |
| 5164 | 3561 { |
| 3562 if (work[k] != 0.) | |
| 3563 { | |
| 5681 | 3564 if (ridx(cidx(k)) != k || |
| 3565 data(cidx(k)) == 0.) | |
| 5164 | 3566 { |
| 3567 err = -2; | |
| 3568 goto triangular_error; | |
| 3569 } | |
| 3570 | |
| 3571 Complex tmp = work[k] / data(cidx(k)); | |
| 3572 work[k] = tmp; | |
| 5275 | 3573 for (octave_idx_type i = cidx(k)+1; i < cidx(k+1); i++) |
| 5164 | 3574 { |
| 5275 | 3575 octave_idx_type iidx = ridx(i); |
| 5164 | 3576 work[iidx] = work[iidx] - tmp * data(i); |
| 3577 } | |
| 3578 } | |
| 3579 } | |
| 3580 | |
| 3581 // Count non-zeros in work vector and adjust space in | |
| 3582 // retval if needed | |
| 5275 | 3583 octave_idx_type new_nnz = 0; |
| 5630 | 3584 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3585 if (work[i] != 0.) |
| 3586 new_nnz++; | |
| 3587 | |
| 3588 if (ii + new_nnz > x_nz) | |
| 3589 { | |
| 3590 // Resize the sparse matrix | |
| 5275 | 3591 octave_idx_type sz = new_nnz * (b_nc - j) + x_nz; |
| 5164 | 3592 retval.change_capacity (sz); |
| 3593 x_nz = sz; | |
| 3594 } | |
| 3595 | |
| 5630 | 3596 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 3597 if (work[i] != 0.) |
| 3598 { | |
| 3599 retval.xridx(ii) = i; | |
| 3600 retval.xdata(ii++) = work[i]; | |
| 3601 } | |
| 3602 retval.xcidx(j+1) = ii; | |
| 3603 } | |
| 3604 | |
| 3605 retval.maybe_compress (); | |
| 3606 | |
| 5681 | 3607 if (calc_cond) |
| 3608 { | |
| 3609 // Calculation of 1-norm of inv(*this) | |
| 3610 for (octave_idx_type i = 0; i < nm; i++) | |
| 3611 work[i] = 0.; | |
| 3612 | |
| 3613 for (octave_idx_type j = 0; j < nr; j++) | |
| 5164 | 3614 { |
| 5681 | 3615 work[j] = 1.; |
| 3616 | |
| 3617 for (octave_idx_type k = j; k < nc; k++) | |
| 5164 | 3618 { |
| 5681 | 3619 |
| 3620 if (work[k] != 0.) | |
| 5164 | 3621 { |
| 5681 | 3622 Complex tmp = work[k] / data(cidx(k)); |
| 3623 work[k] = tmp; | |
| 3624 for (octave_idx_type i = cidx(k)+1; | |
| 3625 i < cidx(k+1); i++) | |
| 3626 { | |
| 3627 octave_idx_type iidx = ridx(i); | |
| 3628 work[iidx] = work[iidx] - tmp * data(i); | |
| 3629 } | |
| 5164 | 3630 } |
| 3631 } | |
| 5681 | 3632 double atmp = 0; |
| 3633 for (octave_idx_type i = j; i < nc; i++) | |
| 3634 { | |
| 3635 atmp += std::abs(work[i]); | |
| 3636 work[i] = 0.; | |
| 3637 } | |
| 3638 if (atmp > ainvnorm) | |
| 3639 ainvnorm = atmp; | |
| 5164 | 3640 } |
| 5681 | 3641 rcond = 1. / ainvnorm / anorm; |
| 3642 } | |
| 3643 } | |
| 5164 | 3644 |
| 3645 triangular_error: | |
| 3646 if (err != 0) | |
| 3647 { | |
| 3648 if (sing_handler) | |
| 5681 | 3649 { |
| 3650 sing_handler (rcond); | |
| 3651 mattype.mark_as_rectangular (); | |
| 3652 } | |
| 5164 | 3653 else |
| 3654 (*current_liboctave_error_handler) | |
| 3655 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 3656 rcond); | |
| 3657 } | |
| 3658 | |
| 3659 volatile double rcond_plus_one = rcond + 1.0; | |
| 3660 | |
| 3661 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 3662 { | |
| 3663 err = -2; | |
| 3664 | |
| 3665 if (sing_handler) | |
| 5681 | 3666 { |
| 3667 sing_handler (rcond); | |
| 3668 mattype.mark_as_rectangular (); | |
| 3669 } | |
| 5164 | 3670 else |
| 3671 (*current_liboctave_error_handler) | |
| 3672 ("matrix singular to machine precision, rcond = %g", | |
| 3673 rcond); | |
| 3674 } | |
| 3675 } | |
| 3676 else | |
| 3677 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
| 3678 } | |
| 3679 | |
| 3680 return retval; | |
| 3681 } | |
| 3682 | |
| 3683 ComplexMatrix | |
| 5785 | 3684 SparseComplexMatrix::trisolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 3685 octave_idx_type& err, double& rcond, |
| 3686 solve_singularity_handler sing_handler, | |
| 3687 bool calc_cond) const | |
| 5164 | 3688 { |
| 3689 ComplexMatrix retval; | |
| 3690 | |
| 5275 | 3691 octave_idx_type nr = rows (); |
| 3692 octave_idx_type nc = cols (); | |
| 5164 | 3693 err = 0; |
| 3694 | |
| 6924 | 3695 if (nr != nc || nr != b.rows ()) |
| 5164 | 3696 (*current_liboctave_error_handler) |
| 3697 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3698 else if (nr == 0 || b.cols () == 0) |
| 3699 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5681 | 3700 else if (calc_cond) |
| 3701 (*current_liboctave_error_handler) | |
| 3702 ("calculation of condition number not implemented"); | |
| 5164 | 3703 else |
| 3704 { | |
| 3705 // Print spparms("spumoni") info if requested | |
| 3706 volatile int typ = mattype.type (); | |
| 3707 mattype.info (); | |
| 3708 | |
| 5785 | 3709 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3710 { |
| 5322 | 3711 OCTAVE_LOCAL_BUFFER (double, D, nr); |
| 5164 | 3712 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); |
| 3713 | |
| 3714 if (mattype.is_dense ()) | |
| 3715 { | |
| 5275 | 3716 octave_idx_type ii = 0; |
| 3717 | |
| 3718 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3719 { |
| 5322 | 3720 D[j] = std::real(data(ii++)); |
| 5164 | 3721 DL[j] = data(ii); |
| 3722 ii += 2; | |
| 3723 } | |
| 5322 | 3724 D[nc-1] = std::real(data(ii)); |
| 5164 | 3725 } |
| 3726 else | |
| 3727 { | |
| 3728 D[0] = 0.; | |
| 5275 | 3729 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3730 { |
| 3731 D[i+1] = 0.; | |
| 3732 DL[i] = 0.; | |
| 3733 } | |
| 3734 | |
| 5275 | 3735 for (octave_idx_type j = 0; j < nc; j++) |
| 3736 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3737 { |
| 3738 if (ridx(i) == j) | |
| 5322 | 3739 D[j] = std::real(data(i)); |
| 5164 | 3740 else if (ridx(i) == j + 1) |
| 3741 DL[j] = data(i); | |
| 3742 } | |
| 3743 } | |
| 3744 | |
| 5275 | 3745 octave_idx_type b_nc = b.cols(); |
| 5164 | 3746 retval = ComplexMatrix (b); |
| 3747 Complex *result = retval.fortran_vec (); | |
| 3748 | |
| 3749 F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, | |
| 3750 b.rows(), err)); | |
| 3751 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3752 if (err != 0) |
| 5164 | 3753 { |
| 3754 err = 0; | |
| 3755 mattype.mark_as_unsymmetric (); | |
| 5785 | 3756 typ = MatrixType::Tridiagonal; |
| 5164 | 3757 } |
| 3758 else | |
| 3759 rcond = 1.; | |
| 3760 } | |
| 3761 | |
| 5785 | 3762 if (typ == MatrixType::Tridiagonal) |
| 5164 | 3763 { |
| 3764 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); | |
| 3765 OCTAVE_LOCAL_BUFFER (Complex, D, nr); | |
| 3766 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); | |
| 3767 | |
| 3768 if (mattype.is_dense ()) | |
| 3769 { | |
| 5275 | 3770 octave_idx_type ii = 0; |
| 3771 | |
| 3772 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3773 { |
| 3774 D[j] = data(ii++); | |
| 3775 DL[j] = data(ii++); | |
| 3776 DU[j] = data(ii++); | |
| 3777 } | |
| 3778 D[nc-1] = data(ii); | |
| 3779 } | |
| 3780 else | |
| 3781 { | |
| 3782 D[0] = 0.; | |
| 5275 | 3783 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3784 { |
| 3785 D[i+1] = 0.; | |
| 3786 DL[i] = 0.; | |
| 3787 DU[i] = 0.; | |
| 3788 } | |
| 3789 | |
| 5275 | 3790 for (octave_idx_type j = 0; j < nc; j++) |
| 3791 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3792 { |
| 3793 if (ridx(i) == j) | |
| 3794 D[j] = data(i); | |
| 3795 else if (ridx(i) == j + 1) | |
| 3796 DL[j] = data(i); | |
| 3797 else if (ridx(i) == j - 1) | |
| 5322 | 3798 DU[j-1] = data(i); |
| 5164 | 3799 } |
| 3800 } | |
| 3801 | |
| 5275 | 3802 octave_idx_type b_nc = b.cols(); |
| 5164 | 3803 retval = ComplexMatrix (b); |
| 3804 Complex *result = retval.fortran_vec (); | |
| 3805 | |
| 3806 F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, | |
| 3807 b.rows(), err)); | |
| 3808 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3809 if (err != 0) |
| 5164 | 3810 { |
| 3811 rcond = 0.; | |
| 3812 err = -2; | |
| 3813 | |
| 3814 if (sing_handler) | |
| 5681 | 3815 { |
| 3816 sing_handler (rcond); | |
| 3817 mattype.mark_as_rectangular (); | |
| 3818 } | |
| 5164 | 3819 else |
| 3820 (*current_liboctave_error_handler) | |
| 3821 ("matrix singular to machine precision"); | |
| 3822 | |
| 3823 } | |
| 3824 else | |
| 3825 rcond = 1.; | |
| 3826 } | |
| 5785 | 3827 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3828 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 3829 } | |
| 3830 | |
| 3831 return retval; | |
| 3832 } | |
| 3833 | |
| 3834 SparseComplexMatrix | |
| 5785 | 3835 SparseComplexMatrix::trisolve (MatrixType &mattype, const SparseMatrix& b, |
| 5681 | 3836 octave_idx_type& err, double& rcond, |
| 3837 solve_singularity_handler sing_handler, | |
| 3838 bool calc_cond) const | |
| 5164 | 3839 { |
| 3840 SparseComplexMatrix retval; | |
| 3841 | |
| 5275 | 3842 octave_idx_type nr = rows (); |
| 3843 octave_idx_type nc = cols (); | |
| 5164 | 3844 err = 0; |
| 3845 | |
| 6924 | 3846 if (nr != nc || nr != b.rows ()) |
| 5164 | 3847 (*current_liboctave_error_handler) |
| 3848 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3849 else if (nr == 0 || b.cols () == 0) |
| 3850 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5681 | 3851 else if (calc_cond) |
| 3852 (*current_liboctave_error_handler) | |
| 3853 ("calculation of condition number not implemented"); | |
| 5164 | 3854 else |
| 3855 { | |
| 3856 // Print spparms("spumoni") info if requested | |
| 3857 int typ = mattype.type (); | |
| 3858 mattype.info (); | |
| 3859 | |
| 3860 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 3861 if (typ == MatrixType::Tridiagonal || |
| 3862 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 3863 { |
| 3864 OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); | |
| 3865 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); | |
| 3866 OCTAVE_LOCAL_BUFFER (Complex, D, nr); | |
| 3867 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); | |
| 5275 | 3868 Array<octave_idx_type> ipvt (nr); |
| 3869 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 3870 |
| 3871 if (mattype.is_dense ()) | |
| 3872 { | |
| 5275 | 3873 octave_idx_type ii = 0; |
| 3874 | |
| 3875 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 3876 { |
| 3877 D[j] = data(ii++); | |
| 3878 DL[j] = data(ii++); | |
| 3879 DU[j] = data(ii++); | |
| 3880 } | |
| 3881 D[nc-1] = data(ii); | |
| 3882 } | |
| 3883 else | |
| 3884 { | |
| 3885 D[0] = 0.; | |
| 5275 | 3886 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 3887 { |
| 3888 D[i+1] = 0.; | |
| 3889 DL[i] = 0.; | |
| 3890 DU[i] = 0.; | |
| 3891 } | |
| 3892 | |
| 5275 | 3893 for (octave_idx_type j = 0; j < nc; j++) |
| 3894 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 3895 { |
| 3896 if (ridx(i) == j) | |
| 3897 D[j] = data(i); | |
| 3898 else if (ridx(i) == j + 1) | |
| 3899 DL[j] = data(i); | |
| 3900 else if (ridx(i) == j - 1) | |
| 5322 | 3901 DU[j-1] = data(i); |
| 5164 | 3902 } |
| 3903 } | |
| 3904 | |
| 3905 F77_XFCN (zgttrf, ZGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 3906 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3907 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3908 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3909 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3910 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3911 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3912 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3913 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3914 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3915 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3916 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3917 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3918 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3919 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3920 |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3923 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3924 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3925 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
|
3926 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3927 retval = SparseComplexMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3928 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3929 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3930 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3931 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3932 OCTAVE_LOCAL_BUFFER (Complex, work, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3933 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3934 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
|
3935 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3936 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
|
3937 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3938 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
|
3939 work[b.ridx(i)] = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3940 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3941 F77_XFCN (zgttrs, ZGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3942 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3943 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3944 work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3945 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3946 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3947 // 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
|
3948 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3949 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3950 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
|
3951 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3952 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3953 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3954 if (ii + new_nnz > x_nz) |
| 5164 | 3955 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3956 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3957 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
|
3958 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3959 x_nz = sz; |
| 5164 | 3960 } |
| 3961 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3962 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
|
3963 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3964 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3965 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3966 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3967 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3968 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
3969 } |
|
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 retval.maybe_compress (); |
| 5164 | 3972 } |
| 3973 } | |
| 5785 | 3974 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 3975 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 3976 } | |
| 3977 | |
| 3978 return retval; | |
| 3979 } | |
| 3980 | |
| 3981 ComplexMatrix | |
| 5785 | 3982 SparseComplexMatrix::trisolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 3983 octave_idx_type& err, double& rcond, |
| 5681 | 3984 solve_singularity_handler sing_handler, |
| 3985 bool calc_cond) const | |
| 5164 | 3986 { |
| 3987 ComplexMatrix retval; | |
| 3988 | |
| 5275 | 3989 octave_idx_type nr = rows (); |
| 3990 octave_idx_type nc = cols (); | |
| 5164 | 3991 err = 0; |
| 3992 | |
| 6924 | 3993 if (nr != nc || nr != b.rows ()) |
| 5164 | 3994 (*current_liboctave_error_handler) |
| 3995 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 3996 else if (nr == 0 || b.cols () == 0) |
| 3997 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5681 | 3998 else if (calc_cond) |
| 3999 (*current_liboctave_error_handler) | |
| 4000 ("calculation of condition number not implemented"); | |
| 5164 | 4001 else |
| 4002 { | |
| 4003 // Print spparms("spumoni") info if requested | |
| 4004 volatile int typ = mattype.type (); | |
| 4005 mattype.info (); | |
| 4006 | |
| 5785 | 4007 if (typ == MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4008 { |
| 5322 | 4009 OCTAVE_LOCAL_BUFFER (double, D, nr); |
| 5164 | 4010 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); |
| 4011 | |
| 4012 if (mattype.is_dense ()) | |
| 4013 { | |
| 5275 | 4014 octave_idx_type ii = 0; |
| 4015 | |
| 4016 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4017 { |
| 5322 | 4018 D[j] = std::real(data(ii++)); |
| 5164 | 4019 DL[j] = data(ii); |
| 4020 ii += 2; | |
| 4021 } | |
| 5322 | 4022 D[nc-1] = std::real(data(ii)); |
| 5164 | 4023 } |
| 4024 else | |
| 4025 { | |
| 4026 D[0] = 0.; | |
| 5275 | 4027 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4028 { |
| 4029 D[i+1] = 0.; | |
| 4030 DL[i] = 0.; | |
| 4031 } | |
| 4032 | |
| 5275 | 4033 for (octave_idx_type j = 0; j < nc; j++) |
| 4034 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4035 { |
| 4036 if (ridx(i) == j) | |
| 5322 | 4037 D[j] = std::real (data(i)); |
| 5164 | 4038 else if (ridx(i) == j + 1) |
| 4039 DL[j] = data(i); | |
| 4040 } | |
| 4041 } | |
| 4042 | |
| 5275 | 4043 octave_idx_type b_nr = b.rows (); |
| 4044 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4045 rcond = 1.; |
| 4046 | |
| 4047 retval = ComplexMatrix (b); | |
| 4048 Complex *result = retval.fortran_vec (); | |
| 4049 | |
| 4050 F77_XFCN (zptsv, ZPTSV, (nr, b_nc, D, DL, result, | |
| 4051 b_nr, err)); | |
| 4052 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4053 if (err != 0) |
| 5164 | 4054 { |
| 4055 err = 0; | |
| 4056 mattype.mark_as_unsymmetric (); | |
| 5785 | 4057 typ = MatrixType::Tridiagonal; |
| 5164 | 4058 } |
| 4059 } | |
| 4060 | |
| 5785 | 4061 if (typ == MatrixType::Tridiagonal) |
| 5164 | 4062 { |
| 4063 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); | |
| 4064 OCTAVE_LOCAL_BUFFER (Complex, D, nr); | |
| 4065 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); | |
| 4066 | |
| 4067 if (mattype.is_dense ()) | |
| 4068 { | |
| 5275 | 4069 octave_idx_type ii = 0; |
| 4070 | |
| 4071 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4072 { |
| 4073 D[j] = data(ii++); | |
| 4074 DL[j] = data(ii++); | |
| 4075 DU[j] = data(ii++); | |
| 4076 } | |
| 4077 D[nc-1] = data(ii); | |
| 4078 } | |
| 4079 else | |
| 4080 { | |
| 4081 D[0] = 0.; | |
| 5275 | 4082 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4083 { |
| 4084 D[i+1] = 0.; | |
| 4085 DL[i] = 0.; | |
| 4086 DU[i] = 0.; | |
| 4087 } | |
| 4088 | |
| 5275 | 4089 for (octave_idx_type j = 0; j < nc; j++) |
| 4090 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4091 { |
| 4092 if (ridx(i) == j) | |
| 4093 D[j] = data(i); | |
| 4094 else if (ridx(i) == j + 1) | |
| 4095 DL[j] = data(i); | |
| 4096 else if (ridx(i) == j - 1) | |
| 5322 | 4097 DU[j-1] = data(i); |
| 5164 | 4098 } |
| 4099 } | |
| 4100 | |
| 5275 | 4101 octave_idx_type b_nr = b.rows(); |
| 4102 octave_idx_type b_nc = b.cols(); | |
| 5164 | 4103 rcond = 1.; |
| 4104 | |
| 4105 retval = ComplexMatrix (b); | |
| 4106 Complex *result = retval.fortran_vec (); | |
| 4107 | |
| 4108 F77_XFCN (zgtsv, ZGTSV, (nr, b_nc, DL, D, DU, result, | |
| 4109 b_nr, err)); | |
| 4110 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4111 if (err != 0) |
| 5164 | 4112 { |
| 4113 rcond = 0.; | |
| 4114 err = -2; | |
| 4115 | |
| 4116 if (sing_handler) | |
| 5681 | 4117 { |
| 4118 sing_handler (rcond); | |
| 4119 mattype.mark_as_rectangular (); | |
| 4120 } | |
| 5164 | 4121 else |
| 4122 (*current_liboctave_error_handler) | |
| 4123 ("matrix singular to machine precision"); | |
| 4124 } | |
| 4125 } | |
| 5785 | 4126 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4127 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4128 } | |
| 4129 | |
| 4130 return retval; | |
| 4131 } | |
| 4132 | |
| 4133 SparseComplexMatrix | |
| 5785 | 4134 SparseComplexMatrix::trisolve (MatrixType &mattype, |
| 5681 | 4135 const SparseComplexMatrix& b, |
| 4136 octave_idx_type& err, double& rcond, | |
| 4137 solve_singularity_handler sing_handler, | |
| 4138 bool calc_cond) const | |
| 5164 | 4139 { |
| 4140 SparseComplexMatrix retval; | |
| 4141 | |
| 5275 | 4142 octave_idx_type nr = rows (); |
| 4143 octave_idx_type nc = cols (); | |
| 5164 | 4144 err = 0; |
| 4145 | |
| 6924 | 4146 if (nr != nc || nr != b.rows ()) |
| 5164 | 4147 (*current_liboctave_error_handler) |
| 4148 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4149 else if (nr == 0 || b.cols () == 0) |
| 4150 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5681 | 4151 else if (calc_cond) |
| 4152 (*current_liboctave_error_handler) | |
| 4153 ("calculation of condition number not implemented"); | |
| 5164 | 4154 else |
| 4155 { | |
| 4156 // Print spparms("spumoni") info if requested | |
| 4157 int typ = mattype.type (); | |
| 4158 mattype.info (); | |
| 4159 | |
| 4160 // Note can't treat symmetric case as there is no dpttrf function | |
| 5785 | 4161 if (typ == MatrixType::Tridiagonal || |
| 4162 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5164 | 4163 { |
| 4164 OCTAVE_LOCAL_BUFFER (Complex, DU2, nr - 2); | |
| 4165 OCTAVE_LOCAL_BUFFER (Complex, DU, nr - 1); | |
| 4166 OCTAVE_LOCAL_BUFFER (Complex, D, nr); | |
| 4167 OCTAVE_LOCAL_BUFFER (Complex, DL, nr - 1); | |
| 5275 | 4168 Array<octave_idx_type> ipvt (nr); |
| 4169 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4170 |
| 4171 if (mattype.is_dense ()) | |
| 4172 { | |
| 5275 | 4173 octave_idx_type ii = 0; |
| 4174 | |
| 4175 for (octave_idx_type j = 0; j < nc-1; j++) | |
| 5164 | 4176 { |
| 4177 D[j] = data(ii++); | |
| 4178 DL[j] = data(ii++); | |
| 4179 DU[j] = data(ii++); | |
| 4180 } | |
| 4181 D[nc-1] = data(ii); | |
| 4182 } | |
| 4183 else | |
| 4184 { | |
| 4185 D[0] = 0.; | |
| 5275 | 4186 for (octave_idx_type i = 0; i < nr - 1; i++) |
| 5164 | 4187 { |
| 4188 D[i+1] = 0.; | |
| 4189 DL[i] = 0.; | |
| 4190 DU[i] = 0.; | |
| 4191 } | |
| 4192 | |
| 5275 | 4193 for (octave_idx_type j = 0; j < nc; j++) |
| 4194 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4195 { |
| 4196 if (ridx(i) == j) | |
| 4197 D[j] = data(i); | |
| 4198 else if (ridx(i) == j + 1) | |
| 4199 DL[j] = data(i); | |
| 4200 else if (ridx(i) == j - 1) | |
| 5322 | 4201 DU[j-1] = data(i); |
| 5164 | 4202 } |
| 4203 } | |
| 4204 | |
| 4205 F77_XFCN (zgttrf, ZGTTRF, (nr, DL, D, DU, DU2, pipvt, err)); | |
| 4206 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4207 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4208 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4209 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4210 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4211 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4212 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4213 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4214 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4215 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4216 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4217 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4218 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4219 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4220 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4221 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4222 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4223 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4224 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4225 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4226 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4227 OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4228 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4229 // 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
|
4230 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4231 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
|
4232 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4233 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
|
4234 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4235 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4236 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
|
4237 { |
|
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 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
|
4240 Bx[i] = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4241 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4242 F77_XFCN (zgttrs, ZGTTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4243 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4244 nr, 1, DL, D, DU, DU2, pipvt, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4245 Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4246 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4247 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4248 if (err != 0) |
| 5164 | 4249 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4250 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4251 ("SparseComplexMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4252 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4253 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4254 break; |
| 5164 | 4255 } |
| 4256 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4257 // 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
|
4258 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4259 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4260 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
|
4261 if (Bx[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4262 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4263 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4264 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4265 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4266 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4267 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
|
4268 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4269 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4270 } |
|
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 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
|
4273 if (Bx[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4274 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4275 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4276 retval.xdata(ii++) = Bx[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4277 } |
|
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 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4280 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4281 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4282 retval.maybe_compress (); |
| 5164 | 4283 } |
| 4284 } | |
| 5785 | 4285 else if (typ != MatrixType::Tridiagonal_Hermitian) |
| 5164 | 4286 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4287 } | |
| 4288 | |
| 4289 return retval; | |
| 4290 } | |
| 4291 | |
| 4292 ComplexMatrix | |
| 5785 | 4293 SparseComplexMatrix::bsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 4294 octave_idx_type& err, double& rcond, |
| 4295 solve_singularity_handler sing_handler, | |
| 4296 bool calc_cond) const | |
| 5164 | 4297 { |
| 4298 ComplexMatrix retval; | |
| 4299 | |
| 5275 | 4300 octave_idx_type nr = rows (); |
| 4301 octave_idx_type nc = cols (); | |
| 5164 | 4302 err = 0; |
| 4303 | |
| 6924 | 4304 if (nr != nc || nr != b.rows ()) |
| 5164 | 4305 (*current_liboctave_error_handler) |
| 4306 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4307 else if (nr == 0 || b.cols () == 0) |
| 4308 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 4309 else |
| 4310 { | |
| 4311 // Print spparms("spumoni") info if requested | |
| 4312 volatile int typ = mattype.type (); | |
| 4313 mattype.info (); | |
| 4314 | |
| 5785 | 4315 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4316 { |
| 5275 | 4317 octave_idx_type n_lower = mattype.nlower (); |
| 4318 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4319 ComplexMatrix m_band (ldm, nc); |
| 4320 Complex *tmp_data = m_band.fortran_vec (); | |
| 4321 | |
| 4322 if (! mattype.is_dense ()) | |
| 4323 { | |
| 5275 | 4324 octave_idx_type ii = 0; |
| 4325 | |
| 4326 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4327 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4328 tmp_data[ii++] = 0.; |
| 4329 } | |
| 4330 | |
| 5275 | 4331 for (octave_idx_type j = 0; j < nc; j++) |
| 4332 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4333 { |
| 5275 | 4334 octave_idx_type ri = ridx (i); |
| 5164 | 4335 if (ri >= j) |
| 4336 m_band(ri - j, j) = data(i); | |
| 4337 } | |
| 4338 | |
| 4339 // Calculate the norm of the matrix, for later use. | |
| 5681 | 4340 double anorm; |
| 4341 if (calc_cond) | |
| 4342 anorm = m_band.abs().sum().row(0).max(); | |
| 5164 | 4343 |
| 4344 char job = 'L'; | |
| 4345 F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4346 nr, n_lower, tmp_data, ldm, err | |
| 4347 F77_CHAR_ARG_LEN (1))); | |
| 4348 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4349 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4350 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4351 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4352 // 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
|
4353 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4354 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4355 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4356 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4357 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4358 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4359 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4360 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4361 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4362 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4363 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4364 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4365 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4366 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4367 F77_XFCN (zpbcon, ZPBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4368 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4369 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4370 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4371 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4372 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4373 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4374 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4375 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4376 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
|
4377 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4378 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4379 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4380 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4381 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4382 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4383 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4384 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4385 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4386 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4387 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4388 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4389 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4390 rcond); |
| 5681 | 4391 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4392 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4393 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4394 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4395 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4396 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4397 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4398 retval = ComplexMatrix (b); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4399 Complex *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4400 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4401 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4402 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4403 F77_XFCN (zpbtrs, ZPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4404 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4405 nr, n_lower, b_nc, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4406 ldm, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4407 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4408 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4409 if (err != 0) |
| 5681 | 4410 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4411 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4412 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4413 err = -1; |
| 5164 | 4414 } |
| 4415 } | |
| 4416 } | |
| 4417 } | |
| 4418 | |
| 5785 | 4419 if (typ == MatrixType::Banded) |
| 5164 | 4420 { |
| 4421 // Create the storage for the banded form of the sparse matrix | |
| 5275 | 4422 octave_idx_type n_upper = mattype.nupper (); |
| 4423 octave_idx_type n_lower = mattype.nlower (); | |
| 4424 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4425 |
| 4426 ComplexMatrix m_band (ldm, nc); | |
| 4427 Complex *tmp_data = m_band.fortran_vec (); | |
| 4428 | |
| 4429 if (! mattype.is_dense ()) | |
| 4430 { | |
| 5275 | 4431 octave_idx_type ii = 0; |
| 4432 | |
| 4433 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4434 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4435 tmp_data[ii++] = 0.; |
| 4436 } | |
| 4437 | |
| 5275 | 4438 for (octave_idx_type j = 0; j < nc; j++) |
| 4439 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4440 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4441 | |
| 5681 | 4442 // Calculate the norm of the matrix, for later use. |
| 4443 double anorm; | |
| 4444 if (calc_cond) | |
| 4445 { | |
| 4446 for (octave_idx_type j = 0; j < nr; j++) | |
| 4447 { | |
| 4448 double atmp = 0.; | |
| 4449 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4450 atmp += std::abs(data(i)); | |
| 4451 if (atmp > anorm) | |
| 4452 anorm = atmp; | |
| 4453 } | |
| 4454 } | |
| 4455 | |
| 5275 | 4456 Array<octave_idx_type> ipvt (nr); |
| 4457 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4458 |
| 5630 | 4459 F77_XFCN (zgbtrf, ZGBTRF, (nr, nc, n_lower, n_upper, tmp_data, |
| 5164 | 4460 ldm, pipvt, err)); |
| 4461 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4462 // 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
|
4463 // change output. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4464 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4465 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4466 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4467 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4468 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4469 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4470 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4471 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4472 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4473 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4474 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4475 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4476 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4477 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4478 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4479 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4480 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4481 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4482 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4483 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4484 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4485 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4486 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4487 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4488 F77_XFCN (zgbcon, ZGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4489 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4490 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
|
4491 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4492 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4493 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4494 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4495 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4496 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4497 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
|
4498 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4499 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4500 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4501 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4502 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4503 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4504 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4505 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4506 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4507 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4508 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4509 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4510 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4511 rcond); |
| 5681 | 4512 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4513 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4514 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4515 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4516 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4517 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4518 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4519 retval = ComplexMatrix (b); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4520 Complex *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4521 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4522 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4523 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4524 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4525 F77_XFCN (zgbtrs, ZGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4526 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4527 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
|
4528 ldm, pipvt, result, b.rows(), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4529 F77_CHAR_ARG_LEN (1))); |
| 5164 | 4530 } |
| 4531 } | |
| 4532 } | |
| 5785 | 4533 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 4534 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4535 } | |
| 4536 | |
| 4537 return retval; | |
| 4538 } | |
| 4539 | |
| 4540 SparseComplexMatrix | |
| 5785 | 4541 SparseComplexMatrix::bsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 4542 octave_idx_type& err, double& rcond, |
| 5681 | 4543 solve_singularity_handler sing_handler, |
| 4544 bool calc_cond) const | |
| 5164 | 4545 { |
| 4546 SparseComplexMatrix retval; | |
| 4547 | |
| 5275 | 4548 octave_idx_type nr = rows (); |
| 4549 octave_idx_type nc = cols (); | |
| 5164 | 4550 err = 0; |
| 4551 | |
| 6924 | 4552 if (nr != nc || nr != b.rows ()) |
| 5164 | 4553 (*current_liboctave_error_handler) |
| 4554 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4555 else if (nr == 0 || b.cols () == 0) |
| 4556 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 4557 else |
| 4558 { | |
| 4559 // Print spparms("spumoni") info if requested | |
| 4560 volatile int typ = mattype.type (); | |
| 4561 mattype.info (); | |
| 4562 | |
| 5785 | 4563 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4564 { |
| 5275 | 4565 octave_idx_type n_lower = mattype.nlower (); |
| 4566 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4567 |
| 4568 ComplexMatrix m_band (ldm, nc); | |
| 4569 Complex *tmp_data = m_band.fortran_vec (); | |
| 4570 | |
| 4571 if (! mattype.is_dense ()) | |
| 4572 { | |
| 5275 | 4573 octave_idx_type ii = 0; |
| 4574 | |
| 4575 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4576 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4577 tmp_data[ii++] = 0.; |
| 4578 } | |
| 4579 | |
| 5275 | 4580 for (octave_idx_type j = 0; j < nc; j++) |
| 4581 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4582 { |
| 5275 | 4583 octave_idx_type ri = ridx (i); |
| 5164 | 4584 if (ri >= j) |
| 4585 m_band(ri - j, j) = data(i); | |
| 4586 } | |
| 4587 | |
| 5681 | 4588 // Calculate the norm of the matrix, for later use. |
| 4589 double anorm; | |
| 4590 if (calc_cond) | |
| 4591 anorm = m_band.abs().sum().row(0).max(); | |
| 4592 | |
| 5164 | 4593 char job = 'L'; |
| 4594 F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4595 nr, n_lower, tmp_data, ldm, err | |
| 4596 F77_CHAR_ARG_LEN (1))); | |
| 4597 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4598 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4599 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4600 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4601 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4602 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4603 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4604 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4605 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4606 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4607 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4608 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4609 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4610 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4611 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4612 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4613 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4614 F77_XFCN (zpbcon, ZPBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4615 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4616 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4617 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4618 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4619 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4620 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4621 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4622 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4623 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
|
4624 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4625 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4626 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4627 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4628 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4629 if (sing_handler) |
| 5681 | 4630 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4631 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4632 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4633 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4634 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4635 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4636 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4637 rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4638 } |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4641 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4642 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4643 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4644 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4645 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4646 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4647 OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4648 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4649 // 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
|
4650 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4651 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
|
4652 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4653 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
|
4654 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4655 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4656 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
|
4657 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4658 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
|
4659 Bx[i] = b.elem (i, j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4660 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4661 F77_XFCN (zpbtrs, ZPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4662 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4663 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4664 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4665 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4666 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4667 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4668 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4669 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4670 ("SparseComplexMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4671 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4672 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4673 } |
|
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 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
|
4676 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4677 Complex tmp = Bx[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4678 if (tmp != 0.0) |
| 5681 | 4679 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4680 if (ii == x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4681 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4682 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4683 octave_idx_type sz = x_nz * |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4684 (b_nc - j) / b_nc; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4685 sz = (sz > 10 ? sz : 10) + x_nz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4686 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4687 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4688 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4689 retval.xdata(ii) = tmp; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4690 retval.xridx(ii++) = i; |
| 5681 | 4691 } |
| 5164 | 4692 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4693 retval.xcidx(j+1) = ii; |
| 5164 | 4694 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4695 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4696 retval.maybe_compress (); |
| 5164 | 4697 } |
| 4698 } | |
| 4699 } | |
| 4700 | |
| 5785 | 4701 if (typ == MatrixType::Banded) |
| 5164 | 4702 { |
| 4703 // Create the storage for the banded form of the sparse matrix | |
| 5275 | 4704 octave_idx_type n_upper = mattype.nupper (); |
| 4705 octave_idx_type n_lower = mattype.nlower (); | |
| 4706 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4707 |
| 4708 ComplexMatrix m_band (ldm, nc); | |
| 4709 Complex *tmp_data = m_band.fortran_vec (); | |
| 4710 | |
| 4711 if (! mattype.is_dense ()) | |
| 4712 { | |
| 5275 | 4713 octave_idx_type ii = 0; |
| 4714 | |
| 4715 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4716 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4717 tmp_data[ii++] = 0.; |
| 4718 } | |
| 4719 | |
| 5275 | 4720 for (octave_idx_type j = 0; j < nc; j++) |
| 4721 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4722 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 4723 | |
| 5681 | 4724 // Calculate the norm of the matrix, for later use. |
| 4725 double anorm; | |
| 4726 if (calc_cond) | |
| 4727 { | |
| 4728 for (octave_idx_type j = 0; j < nr; j++) | |
| 4729 { | |
| 4730 double atmp = 0.; | |
| 4731 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 4732 atmp += std::abs(data(i)); | |
| 4733 if (atmp > anorm) | |
| 4734 anorm = atmp; | |
| 4735 } | |
| 4736 } | |
| 4737 | |
| 5275 | 4738 Array<octave_idx_type> ipvt (nr); |
| 4739 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 4740 |
| 4741 F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 4742 ldm, pipvt, err)); | |
| 4743 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4744 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4745 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4746 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4747 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4748 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4749 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4750 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4751 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4752 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4753 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4754 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4755 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4756 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4757 |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4760 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4761 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4762 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4763 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4764 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4765 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4766 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4767 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4768 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4769 F77_XFCN (zgbcon, ZGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4770 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4771 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
|
4772 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4773 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4774 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4775 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4776 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4777 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4778 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
|
4779 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4780 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 4781 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4782 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4783 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4784 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4785 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4786 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4787 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4788 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4789 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4790 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4791 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4792 rcond); |
| 5681 | 4793 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4794 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4795 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4796 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4797 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4798 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4799 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4800 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4801 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
|
4802 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4803 retval = SparseComplexMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4804 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4805 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4806 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4807 OCTAVE_LOCAL_BUFFER (Complex, work, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4808 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4809 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 4810 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4811 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
|
4812 work[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4813 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
|
4814 i < b.cidx(j+1); i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4815 work[b.ridx(i)] = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4816 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4817 F77_XFCN (zgbtrs, ZGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4818 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4819 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
|
4820 ldm, pipvt, work, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4821 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4822 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4823 // 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
|
4824 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4825 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4826 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
|
4827 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4828 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4829 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4830 if (ii + new_nnz > x_nz) |
| 5164 | 4831 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4832 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4833 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
|
4834 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4835 x_nz = sz; |
| 5164 | 4836 } |
| 4837 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4838 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
|
4839 if (work[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4840 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4841 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4842 retval.xdata(ii++) = work[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4843 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4844 retval.xcidx(j+1) = ii; |
| 5164 | 4845 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4846 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4847 retval.maybe_compress (); |
| 5164 | 4848 } |
| 4849 } | |
| 4850 } | |
| 5785 | 4851 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 4852 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 4853 } | |
| 4854 | |
| 4855 return retval; | |
| 4856 } | |
| 4857 | |
| 4858 ComplexMatrix | |
| 5785 | 4859 SparseComplexMatrix::bsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 4860 octave_idx_type& err, double& rcond, |
| 5681 | 4861 solve_singularity_handler sing_handler, |
| 4862 bool calc_cond) const | |
| 5164 | 4863 { |
| 4864 ComplexMatrix retval; | |
| 4865 | |
| 5275 | 4866 octave_idx_type nr = rows (); |
| 4867 octave_idx_type nc = cols (); | |
| 5164 | 4868 err = 0; |
| 4869 | |
| 6924 | 4870 if (nr != nc || nr != b.rows ()) |
| 5164 | 4871 (*current_liboctave_error_handler) |
| 4872 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 4873 else if (nr == 0 || b.cols () == 0) |
| 4874 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 4875 else |
| 4876 { | |
| 4877 // Print spparms("spumoni") info if requested | |
| 4878 volatile int typ = mattype.type (); | |
| 4879 mattype.info (); | |
| 4880 | |
| 5785 | 4881 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 4882 { |
| 5275 | 4883 octave_idx_type n_lower = mattype.nlower (); |
| 4884 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 4885 |
| 4886 ComplexMatrix m_band (ldm, nc); | |
| 4887 Complex *tmp_data = m_band.fortran_vec (); | |
| 4888 | |
| 4889 if (! mattype.is_dense ()) | |
| 4890 { | |
| 5275 | 4891 octave_idx_type ii = 0; |
| 4892 | |
| 4893 for (octave_idx_type j = 0; j < ldm; j++) | |
| 4894 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 4895 tmp_data[ii++] = 0.; |
| 4896 } | |
| 4897 | |
| 5275 | 4898 for (octave_idx_type j = 0; j < nc; j++) |
| 4899 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 4900 { |
| 5275 | 4901 octave_idx_type ri = ridx (i); |
| 5164 | 4902 if (ri >= j) |
| 4903 m_band(ri - j, j) = data(i); | |
| 4904 } | |
| 4905 | |
| 5681 | 4906 // Calculate the norm of the matrix, for later use. |
| 4907 double anorm; | |
| 4908 if (calc_cond) | |
| 4909 anorm = m_band.abs().sum().row(0).max(); | |
| 4910 | |
| 5164 | 4911 char job = 'L'; |
| 4912 F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 4913 nr, n_lower, tmp_data, ldm, err | |
| 4914 F77_CHAR_ARG_LEN (1))); | |
| 4915 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4916 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4917 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4918 // 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
|
4919 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4920 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4921 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4922 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4923 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4924 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4925 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4926 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4927 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4928 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4929 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4930 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4931 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4932 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4933 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4934 F77_XFCN (zpbcon, ZPBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4935 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4936 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4937 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4938 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4939 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4940 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4941 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4942 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4943 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
|
4944 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4945 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 4946 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4947 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4948 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4949 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4950 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4951 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4952 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4953 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4954 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4955 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4956 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4957 rcond); |
| 5681 | 4958 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4959 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4960 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4961 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4962 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4963 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4964 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4965 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4966 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4967 retval = ComplexMatrix (b); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4968 Complex *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4969 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4970 F77_XFCN (zpbtrs, ZPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4971 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4972 nr, n_lower, b_nc, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4973 ldm, result, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4974 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4975 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4976 if (err != 0) |
| 5681 | 4977 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4978 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4979 ("SparseComplexMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
4980 err = -1; |
| 5164 | 4981 } |
| 4982 } | |
| 4983 } | |
| 4984 } | |
| 4985 | |
| 5785 | 4986 if (typ == MatrixType::Banded) |
| 5164 | 4987 { |
| 4988 // Create the storage for the banded form of the sparse matrix | |
| 5275 | 4989 octave_idx_type n_upper = mattype.nupper (); |
| 4990 octave_idx_type n_lower = mattype.nlower (); | |
| 4991 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 4992 |
| 4993 ComplexMatrix m_band (ldm, nc); | |
| 4994 Complex *tmp_data = m_band.fortran_vec (); | |
| 4995 | |
| 4996 if (! mattype.is_dense ()) | |
| 4997 { | |
| 5275 | 4998 octave_idx_type ii = 0; |
| 4999 | |
| 5000 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5001 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5002 tmp_data[ii++] = 0.; |
| 5003 } | |
| 5004 | |
| 5275 | 5005 for (octave_idx_type j = 0; j < nc; j++) |
| 5006 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5007 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5008 | |
| 5681 | 5009 // Calculate the norm of the matrix, for later use. |
| 5010 double anorm; | |
| 5011 if (calc_cond) | |
| 5012 { | |
| 5013 for (octave_idx_type j = 0; j < nr; j++) | |
| 5014 { | |
| 5015 double atmp = 0.; | |
| 5016 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5017 atmp += std::abs(data(i)); | |
| 5018 if (atmp > anorm) | |
| 5019 anorm = atmp; | |
| 5020 } | |
| 5021 } | |
| 5022 | |
| 5275 | 5023 Array<octave_idx_type> ipvt (nr); |
| 5024 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5025 |
| 5026 F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5027 ldm, pipvt, err)); | |
| 5028 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5029 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5030 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5031 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5032 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5033 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5034 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5035 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5036 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5037 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5038 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5039 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5040 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5041 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5042 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5043 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5044 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5045 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5046 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5047 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5048 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5049 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5050 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5051 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5052 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5053 F77_XFCN (zgbcon, ZGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5054 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5055 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
|
5056 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5057 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5058 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5059 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5060 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5061 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5062 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
|
5063 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5064 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5065 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5066 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5067 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5068 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5069 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5070 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5071 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5072 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5073 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5074 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5075 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5076 rcond); |
| 5681 | 5077 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5078 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5079 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5080 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5081 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5082 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5083 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5084 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5085 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5086 retval = ComplexMatrix (b); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5087 Complex *result = retval.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5088 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5089 F77_XFCN (zgbtrs, ZGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5090 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5091 nr, n_lower, n_upper, b_nc, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5092 ldm, pipvt, result, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5093 F77_CHAR_ARG_LEN (1))); |
| 5164 | 5094 } |
| 5095 } | |
| 5096 } | |
| 5785 | 5097 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5098 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5099 } | |
| 5100 | |
| 5101 return retval; | |
| 5102 } | |
| 5103 | |
| 5104 SparseComplexMatrix | |
| 5785 | 5105 SparseComplexMatrix::bsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5681 | 5106 octave_idx_type& err, double& rcond, |
| 5107 solve_singularity_handler sing_handler, | |
| 5108 bool calc_cond) const | |
| 5164 | 5109 { |
| 5110 SparseComplexMatrix retval; | |
| 5111 | |
| 5275 | 5112 octave_idx_type nr = rows (); |
| 5113 octave_idx_type nc = cols (); | |
| 5164 | 5114 err = 0; |
| 5115 | |
| 6924 | 5116 if (nr != nc || nr != b.rows ()) |
| 5164 | 5117 (*current_liboctave_error_handler) |
| 5118 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5119 else if (nr == 0 || b.cols () == 0) |
| 5120 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 5121 else |
| 5122 { | |
| 5123 // Print spparms("spumoni") info if requested | |
| 5124 volatile int typ = mattype.type (); | |
| 5125 mattype.info (); | |
| 5126 | |
| 5785 | 5127 if (typ == MatrixType::Banded_Hermitian) |
| 5164 | 5128 { |
| 5275 | 5129 octave_idx_type n_lower = mattype.nlower (); |
| 5130 octave_idx_type ldm = n_lower + 1; | |
| 5164 | 5131 |
| 5132 ComplexMatrix m_band (ldm, nc); | |
| 5133 Complex *tmp_data = m_band.fortran_vec (); | |
| 5134 | |
| 5135 if (! mattype.is_dense ()) | |
| 5136 { | |
| 5275 | 5137 octave_idx_type ii = 0; |
| 5138 | |
| 5139 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5140 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5141 tmp_data[ii++] = 0.; |
| 5142 } | |
| 5143 | |
| 5275 | 5144 for (octave_idx_type j = 0; j < nc; j++) |
| 5145 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5146 { |
| 5275 | 5147 octave_idx_type ri = ridx (i); |
| 5164 | 5148 if (ri >= j) |
| 5149 m_band(ri - j, j) = data(i); | |
| 5150 } | |
| 5151 | |
| 5681 | 5152 // Calculate the norm of the matrix, for later use. |
| 5153 double anorm; | |
| 5154 if (calc_cond) | |
| 5155 anorm = m_band.abs().sum().row(0).max(); | |
| 5156 | |
| 5164 | 5157 char job = 'L'; |
| 5158 F77_XFCN (zpbtrf, ZPBTRF, (F77_CONST_CHAR_ARG2 (&job, 1), | |
| 5159 nr, n_lower, tmp_data, ldm, err | |
| 5160 F77_CHAR_ARG_LEN (1))); | |
| 5161 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5162 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5163 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5164 // 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
|
5165 // unsymmetric banded solver. |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5166 mattype.mark_as_unsymmetric (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5167 typ = MatrixType::Banded; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5168 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5169 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5170 err = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5171 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5172 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5173 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5174 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5175 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5176 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5177 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5178 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5179 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5180 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5181 F77_XFCN (zpbcon, ZPBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5182 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5183 nr, n_lower, tmp_data, ldm, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5184 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5185 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5186 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5187 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5188 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5189 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5190 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
|
5191 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5192 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5681 | 5193 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5194 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5195 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5196 if (sing_handler) |
| 5164 | 5197 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5198 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5199 mattype.mark_as_rectangular (); |
| 5681 | 5200 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5201 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5202 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5203 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5204 rcond); |
| 5164 | 5205 } |
| 5206 } | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5207 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5208 rcond = 1.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5209 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5210 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5211 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5212 octave_idx_type b_nr = b.rows (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5213 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5214 OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5215 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5216 // 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
|
5217 // will be as many as in b |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5218 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
|
5219 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5220 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
|
5221 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5222 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5223 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
|
5224 { |
|
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 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
|
5227 Bx[i] = b (i,j); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5228 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5229 F77_XFCN (zpbtrs, ZPBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5230 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5231 nr, n_lower, 1, tmp_data, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5232 ldm, Bx, b_nr, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5233 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5234 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5235 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5236 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5237 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5238 ("SparseMatrix::solve solve failed"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5239 err = -1; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5240 break; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5241 } |
|
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 // 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
|
5244 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5245 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5246 for (octave_idx_type i = 0; i < nr; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5247 if (Bx[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5248 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5249 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5250 if (ii + new_nnz > x_nz) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5251 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5252 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5253 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
|
5254 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5255 x_nz = sz; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5256 } |
|
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 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
|
5259 if (Bx[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5260 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5261 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5262 retval.xdata(ii++) = Bx[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5263 } |
|
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 retval.xcidx(j+1) = ii; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5266 } |
|
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 retval.maybe_compress (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5269 } |
| 5164 | 5270 } |
| 5271 } | |
| 5272 | |
| 5785 | 5273 if (typ == MatrixType::Banded) |
| 5164 | 5274 { |
| 5275 // Create the storage for the banded form of the sparse matrix | |
| 5275 | 5276 octave_idx_type n_upper = mattype.nupper (); |
| 5277 octave_idx_type n_lower = mattype.nlower (); | |
| 5278 octave_idx_type ldm = n_upper + 2 * n_lower + 1; | |
| 5164 | 5279 |
| 5280 ComplexMatrix m_band (ldm, nc); | |
| 5281 Complex *tmp_data = m_band.fortran_vec (); | |
| 5282 | |
| 5283 if (! mattype.is_dense ()) | |
| 5284 { | |
| 5275 | 5285 octave_idx_type ii = 0; |
| 5286 | |
| 5287 for (octave_idx_type j = 0; j < ldm; j++) | |
| 5288 for (octave_idx_type i = 0; i < nc; i++) | |
| 5164 | 5289 tmp_data[ii++] = 0.; |
| 5290 } | |
| 5291 | |
| 5275 | 5292 for (octave_idx_type j = 0; j < nc; j++) |
| 5293 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5164 | 5294 m_band(ridx(i) - j + n_lower + n_upper, j) = data(i); |
| 5295 | |
| 5681 | 5296 // Calculate the norm of the matrix, for later use. |
| 5297 double anorm; | |
| 5298 if (calc_cond) | |
| 5299 { | |
| 5300 for (octave_idx_type j = 0; j < nr; j++) | |
| 5301 { | |
| 5302 double atmp = 0.; | |
| 5303 for (octave_idx_type i = cidx(j); i < cidx(j+1); i++) | |
| 5304 atmp += std::abs(data(i)); | |
| 5305 if (atmp > anorm) | |
| 5306 anorm = atmp; | |
| 5307 } | |
| 5308 } | |
| 5309 | |
| 5275 | 5310 Array<octave_idx_type> ipvt (nr); |
| 5311 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
| 5164 | 5312 |
| 5313 F77_XFCN (zgbtrf, ZGBTRF, (nr, nr, n_lower, n_upper, tmp_data, | |
| 5314 ldm, pipvt, err)); | |
| 5315 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5316 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5317 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5318 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5319 rcond = 0.0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5320 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5321 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5322 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5323 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5324 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5325 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5326 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5327 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5328 ("matrix singular to machine precision"); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5329 |
|
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 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5332 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5333 if (calc_cond) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5334 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5335 char job = '1'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5336 Array<Complex> z (2 * nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5337 Complex *pz = z.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5338 Array<double> iz (nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5339 double *piz = iz.fortran_vec (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5340 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5341 F77_XFCN (zgbcon, ZGBCON, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5342 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5343 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
|
5344 anorm, rcond, pz, piz, err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5345 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5346 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5347 if (err != 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5348 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5349 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5350 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
|
5351 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5352 if (rcond_plus_one == 1.0 || xisnan (rcond)) |
| 5164 | 5353 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5354 err = -2; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5355 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5356 if (sing_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5357 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5358 sing_handler (rcond); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5359 mattype.mark_as_rectangular (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5360 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5361 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5362 (*current_liboctave_error_handler) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5363 ("matrix singular to machine precision, rcond = %g", |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5364 rcond); |
| 5681 | 5365 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5366 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5367 else |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5368 rcond = 1.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5369 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5370 if (err == 0) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5371 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5372 char job = 'N'; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5373 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
|
5374 octave_idx_type b_nc = b.cols (); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5375 retval = SparseComplexMatrix (nr, b_nc, x_nz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5376 retval.xcidx(0) = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5377 volatile octave_idx_type ii = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5378 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5379 OCTAVE_LOCAL_BUFFER (Complex, Bx, nr); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5380 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5381 for (volatile octave_idx_type j = 0; j < b_nc; j++) |
| 5681 | 5382 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5383 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
|
5384 Bx[i] = 0.; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5385 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5386 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
|
5387 i < b.cidx(j+1); i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5388 Bx[b.ridx(i)] = b.data(i); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5389 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5390 F77_XFCN (zgbtrs, ZGBTRS, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5391 (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5392 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
|
5393 ldm, pipvt, Bx, b.rows (), err |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5394 F77_CHAR_ARG_LEN (1))); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5395 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5396 // 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
|
5397 // space in retval if needed |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5398 octave_idx_type new_nnz = 0; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5399 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
|
5400 if (Bx[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5401 new_nnz++; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5402 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5403 if (ii + new_nnz > x_nz) |
| 5164 | 5404 { |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5405 // Resize the sparse matrix |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5406 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
|
5407 retval.change_capacity (sz); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5408 x_nz = sz; |
| 5164 | 5409 } |
| 5410 | |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5411 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
|
5412 if (Bx[i] != 0.) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5413 { |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5414 retval.xridx(ii) = i; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5415 retval.xdata(ii++) = Bx[i]; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5416 } |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5417 retval.xcidx(j+1) = ii; |
| 5164 | 5418 } |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5419 |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7433
diff
changeset
|
5420 retval.maybe_compress (); |
| 5164 | 5421 } |
| 5422 } | |
| 5423 } | |
| 5785 | 5424 else if (typ != MatrixType::Banded_Hermitian) |
| 5164 | 5425 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5426 } | |
| 5427 | |
| 5428 return retval; | |
| 5429 } | |
| 5430 | |
| 5431 void * | |
| 5681 | 5432 SparseComplexMatrix::factorize (octave_idx_type& err, double &rcond, |
| 5433 Matrix &Control, Matrix &Info, | |
| 5434 solve_singularity_handler sing_handler, | |
| 5435 bool calc_cond) const | |
| 5164 | 5436 { |
| 5437 // The return values | |
| 5404 | 5438 void *Numeric = 0; |
| 5164 | 5439 err = 0; |
| 5440 | |
| 5203 | 5441 #ifdef HAVE_UMFPACK |
| 5164 | 5442 // Setup the control parameters |
| 5443 Control = Matrix (UMFPACK_CONTROL, 1); | |
| 5444 double *control = Control.fortran_vec (); | |
| 5322 | 5445 UMFPACK_ZNAME (defaults) (control); |
| 5164 | 5446 |
| 5893 | 5447 double tmp = octave_sparse_params::get_key ("spumoni"); |
| 5164 | 5448 if (!xisnan (tmp)) |
| 5449 Control (UMFPACK_PRL) = tmp; | |
| 5893 | 5450 tmp = octave_sparse_params::get_key ("piv_tol"); |
| 5164 | 5451 if (!xisnan (tmp)) |
| 5452 { | |
| 5453 Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; | |
| 5454 Control (UMFPACK_PIVOT_TOLERANCE) = tmp; | |
| 5455 } | |
| 5456 | |
| 5457 // Set whether we are allowed to modify Q or not | |
| 5893 | 5458 tmp = octave_sparse_params::get_key ("autoamd"); |
| 5164 | 5459 if (!xisnan (tmp)) |
| 5460 Control (UMFPACK_FIXQ) = tmp; | |
| 5461 | |
| 5322 | 5462 UMFPACK_ZNAME (report_control) (control); |
| 5164 | 5463 |
| 5275 | 5464 const octave_idx_type *Ap = cidx (); |
| 5465 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5466 const Complex *Ax = data (); |
| 5275 | 5467 octave_idx_type nr = rows (); |
| 5468 octave_idx_type nc = cols (); | |
| 5164 | 5469 |
| 5322 | 5470 UMFPACK_ZNAME (report_matrix) (nr, nc, Ap, Ai, |
| 5760 | 5471 reinterpret_cast<const double *> (Ax), |
| 5472 NULL, 1, control); | |
| 5164 | 5473 |
| 5474 void *Symbolic; | |
| 5475 Info = Matrix (1, UMFPACK_INFO); | |
| 5476 double *info = Info.fortran_vec (); | |
| 5322 | 5477 int status = UMFPACK_ZNAME (qsymbolic) (nr, nc, Ap, Ai, |
| 5760 | 5478 reinterpret_cast<const double *> (Ax), |
| 5164 | 5479 NULL, NULL, &Symbolic, control, info); |
| 5480 | |
| 5481 if (status < 0) | |
| 5482 { | |
| 5483 (*current_liboctave_error_handler) | |
| 5484 ("SparseComplexMatrix::solve symbolic factorization failed"); | |
| 5485 err = -1; | |
| 5486 | |
| 5322 | 5487 UMFPACK_ZNAME (report_status) (control, status); |
| 5488 UMFPACK_ZNAME (report_info) (control, info); | |
| 5489 | |
| 5490 UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; | |
| 5164 | 5491 } |
| 5492 else | |
| 5493 { | |
| 5322 | 5494 UMFPACK_ZNAME (report_symbolic) (Symbolic, control); |
| 5495 | |
| 5496 status = UMFPACK_ZNAME (numeric) (Ap, Ai, | |
| 5760 | 5497 reinterpret_cast<const double *> (Ax), NULL, |
| 5164 | 5498 Symbolic, &Numeric, control, info) ; |
| 5322 | 5499 UMFPACK_ZNAME (free_symbolic) (&Symbolic) ; |
| 5164 | 5500 |
| 5681 | 5501 if (calc_cond) |
| 5502 rcond = Info (UMFPACK_RCOND); | |
| 5503 else | |
| 5504 rcond = 1.; | |
| 5164 | 5505 volatile double rcond_plus_one = rcond + 1.0; |
| 5506 | |
| 5507 if (status == UMFPACK_WARNING_singular_matrix || | |
| 5508 rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5509 { | |
| 5322 | 5510 UMFPACK_ZNAME (report_numeric) (Numeric, control); |
| 5164 | 5511 |
| 5512 err = -2; | |
| 5513 | |
| 5514 if (sing_handler) | |
| 5515 sing_handler (rcond); | |
| 5516 else | |
| 5517 (*current_liboctave_error_handler) | |
| 5518 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5519 rcond); | |
| 5520 | |
| 5521 } | |
| 5610 | 5522 else if (status < 0) |
| 5164 | 5523 { |
| 5524 (*current_liboctave_error_handler) | |
| 5525 ("SparseComplexMatrix::solve numeric factorization failed"); | |
| 5526 | |
| 5322 | 5527 UMFPACK_ZNAME (report_status) (control, status); |
| 5528 UMFPACK_ZNAME (report_info) (control, info); | |
| 5164 | 5529 |
| 5530 err = -1; | |
| 5531 } | |
| 5532 else | |
| 5533 { | |
| 5322 | 5534 UMFPACK_ZNAME (report_numeric) (Numeric, control); |
| 5164 | 5535 } |
| 5536 } | |
| 5537 | |
| 5538 if (err != 0) | |
| 5322 | 5539 UMFPACK_ZNAME (free_numeric) (&Numeric); |
| 5203 | 5540 #else |
| 5541 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 5542 #endif | |
| 5164 | 5543 |
| 5544 return Numeric; | |
| 5545 } | |
| 5546 | |
| 5547 ComplexMatrix | |
| 5785 | 5548 SparseComplexMatrix::fsolve (MatrixType &mattype, const Matrix& b, |
| 5681 | 5549 octave_idx_type& err, double& rcond, |
| 5550 solve_singularity_handler sing_handler, | |
| 5551 bool calc_cond) const | |
| 5164 | 5552 { |
| 5553 ComplexMatrix retval; | |
| 5554 | |
| 5275 | 5555 octave_idx_type nr = rows (); |
| 5556 octave_idx_type nc = cols (); | |
| 5164 | 5557 err = 0; |
| 5558 | |
| 6924 | 5559 if (nr != nc || nr != b.rows ()) |
| 5164 | 5560 (*current_liboctave_error_handler) |
| 5561 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5562 else if (nr == 0 || b.cols () == 0) |
| 5563 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 5564 else |
| 5565 { | |
| 5566 // Print spparms("spumoni") info if requested | |
| 5567 volatile int typ = mattype.type (); | |
| 5568 mattype.info (); | |
| 5569 | |
| 5785 | 5570 if (typ == MatrixType::Hermitian) |
| 5164 | 5571 { |
| 5506 | 5572 #ifdef HAVE_CHOLMOD |
| 5573 cholmod_common Common; | |
| 5574 cholmod_common *cm = &Common; | |
| 5575 | |
| 5576 // Setup initial parameters | |
| 5577 CHOLMOD_NAME(start) (cm); | |
| 5526 | 5578 cm->prefer_zomplex = false; |
| 5506 | 5579 |
| 5893 | 5580 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 5581 if (spu == 0.) |
| 5582 { | |
| 5583 cm->print = -1; | |
| 5584 cm->print_function = NULL; | |
| 5585 } | |
| 5586 else | |
| 5587 { | |
| 5760 | 5588 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 5589 cm->print_function =&SparseCholPrint; |
| 5590 } | |
| 5591 | |
| 5592 cm->error_handler = &SparseCholError; | |
| 5593 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 5594 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 5595 | |
| 5526 | 5596 cm->final_ll = true; |
| 5506 | 5597 |
| 5598 cholmod_sparse Astore; | |
| 5599 cholmod_sparse *A = &Astore; | |
| 5600 double dummy; | |
| 5601 A->nrow = nr; | |
| 5602 A->ncol = nc; | |
| 5603 | |
| 5604 A->p = cidx(); | |
| 5605 A->i = ridx(); | |
| 5604 | 5606 A->nzmax = nnz(); |
| 5526 | 5607 A->packed = true; |
| 5608 A->sorted = true; | |
| 5506 | 5609 A->nz = NULL; |
| 5610 #ifdef IDX_TYPE_LONG | |
| 5611 A->itype = CHOLMOD_LONG; | |
| 5612 #else | |
| 5613 A->itype = CHOLMOD_INT; | |
| 5614 #endif | |
| 5615 A->dtype = CHOLMOD_DOUBLE; | |
| 5616 A->stype = 1; | |
| 5617 A->xtype = CHOLMOD_COMPLEX; | |
| 5618 | |
| 5619 if (nr < 1) | |
| 5620 A->x = &dummy; | |
| 5621 else | |
| 5622 A->x = data(); | |
| 5623 | |
| 5624 cholmod_dense Bstore; | |
| 5625 cholmod_dense *B = &Bstore; | |
| 5626 B->nrow = b.rows(); | |
| 5627 B->ncol = b.cols(); | |
| 5628 B->d = B->nrow; | |
| 5629 B->nzmax = B->nrow * B->ncol; | |
| 5630 B->dtype = CHOLMOD_DOUBLE; | |
| 5631 B->xtype = CHOLMOD_REAL; | |
| 5632 if (nc < 1 || b.cols() < 1) | |
| 5633 B->x = &dummy; | |
| 5634 else | |
| 5635 // We won't alter it, honest :-) | |
| 5636 B->x = const_cast<double *>(b.fortran_vec()); | |
| 5637 | |
| 5638 cholmod_factor *L; | |
| 5639 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5640 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 5641 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 5642 if (calc_cond) |
| 5643 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 5644 else | |
| 5645 rcond = 1.; | |
| 5506 | 5646 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5647 | |
| 5648 if (rcond == 0.0) | |
| 5649 { | |
| 5650 // Either its indefinite or singular. Try UMFPACK | |
| 5651 mattype.mark_as_unsymmetric (); | |
| 5785 | 5652 typ = MatrixType::Full; |
| 5506 | 5653 } |
| 5654 else | |
| 5655 { | |
| 5656 volatile double rcond_plus_one = rcond + 1.0; | |
| 5657 | |
| 5658 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5659 { | |
| 5660 err = -2; | |
| 5661 | |
| 5662 if (sing_handler) | |
| 5681 | 5663 { |
| 5664 sing_handler (rcond); | |
| 5665 mattype.mark_as_rectangular (); | |
| 5666 } | |
| 5506 | 5667 else |
| 5668 (*current_liboctave_error_handler) | |
| 5669 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5670 rcond); | |
| 5671 | |
| 5672 return retval; | |
| 5673 } | |
| 5674 | |
| 5675 cholmod_dense *X; | |
| 5676 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5677 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 5678 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5679 | |
| 5680 retval.resize (b.rows (), b.cols()); | |
| 5681 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 5682 { | |
| 5683 octave_idx_type jr = j * b.rows(); | |
| 5684 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 5685 retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; | |
| 5686 } | |
| 5687 | |
| 5688 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5689 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 5690 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 5691 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 5692 static char tmp[] = " "; |
| 5693 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 5694 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5695 } | |
| 5696 #else | |
| 5164 | 5697 (*current_liboctave_warning_handler) |
| 5506 | 5698 ("CHOLMOD not installed"); |
| 5164 | 5699 |
| 5700 mattype.mark_as_unsymmetric (); | |
| 5785 | 5701 typ = MatrixType::Full; |
| 5506 | 5702 #endif |
| 5164 | 5703 } |
| 5704 | |
| 5785 | 5705 if (typ == MatrixType::Full) |
| 5164 | 5706 { |
| 5203 | 5707 #ifdef HAVE_UMFPACK |
| 5164 | 5708 Matrix Control, Info; |
| 5709 void *Numeric = factorize (err, rcond, Control, Info, | |
| 5681 | 5710 sing_handler, calc_cond); |
| 5164 | 5711 |
| 5712 if (err == 0) | |
| 5713 { | |
| 5275 | 5714 octave_idx_type b_nr = b.rows (); |
| 5715 octave_idx_type b_nc = b.cols (); | |
| 5164 | 5716 int status = 0; |
| 5717 double *control = Control.fortran_vec (); | |
| 5718 double *info = Info.fortran_vec (); | |
| 5275 | 5719 const octave_idx_type *Ap = cidx (); |
| 5720 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5721 const Complex *Ax = data (); |
| 5203 | 5722 #ifdef UMFPACK_SEPARATE_SPLIT |
| 5164 | 5723 const double *Bx = b.fortran_vec (); |
| 5724 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 5275 | 5725 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 5726 Bz[i] = 0.; |
| 5203 | 5727 #else |
| 5728 OCTAVE_LOCAL_BUFFER (Complex, Bz, b_nr); | |
| 5729 #endif | |
| 5164 | 5730 retval.resize (b_nr, b_nc); |
| 5731 Complex *Xx = retval.fortran_vec (); | |
| 5732 | |
| 5275 | 5733 for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) |
| 5164 | 5734 { |
| 5203 | 5735 #ifdef UMFPACK_SEPARATE_SPLIT |
| 5322 | 5736 status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, |
| 5760 | 5737 Ai, |
| 5738 reinterpret_cast<const double *> (Ax), | |
| 5164 | 5739 NULL, |
| 5760 | 5740 reinterpret_cast<double *> (&Xx[iidx]), |
| 5164 | 5741 NULL, |
| 5742 &Bx[iidx], Bz, Numeric, | |
| 5743 control, info); | |
| 5203 | 5744 #else |
| 5275 | 5745 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5203 | 5746 Bz[i] = b.elem (i, j); |
| 5747 | |
| 5322 | 5748 status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, |
| 5760 | 5749 Ai, |
| 5750 reinterpret_cast<const double *> (Ax), | |
| 5203 | 5751 NULL, |
| 5780 | 5752 reinterpret_cast<double *> (&Xx[iidx]), |
| 5203 | 5753 NULL, |
| 5760 | 5754 reinterpret_cast<const double *> (Bz), |
| 5203 | 5755 NULL, Numeric, |
| 5756 control, info); | |
| 5757 #endif | |
| 5758 | |
| 5164 | 5759 if (status < 0) |
| 5760 { | |
| 5761 (*current_liboctave_error_handler) | |
| 5762 ("SparseComplexMatrix::solve solve failed"); | |
| 5763 | |
| 5322 | 5764 UMFPACK_ZNAME (report_status) (control, status); |
| 5164 | 5765 |
| 5766 err = -1; | |
| 5767 | |
| 5768 break; | |
| 5769 } | |
| 5770 } | |
| 5771 | |
| 5322 | 5772 UMFPACK_ZNAME (report_info) (control, info); |
| 5773 | |
| 5774 UMFPACK_ZNAME (free_numeric) (&Numeric); | |
| 5164 | 5775 } |
| 5681 | 5776 else |
| 5777 mattype.mark_as_rectangular (); | |
| 5778 | |
| 5203 | 5779 #else |
| 5780 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 5781 #endif | |
| 5164 | 5782 } |
| 5785 | 5783 else if (typ != MatrixType::Hermitian) |
| 5164 | 5784 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 5785 } | |
| 5786 | |
| 5787 return retval; | |
| 5788 } | |
| 5789 | |
| 5790 SparseComplexMatrix | |
| 5785 | 5791 SparseComplexMatrix::fsolve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 5792 octave_idx_type& err, double& rcond, |
| 5681 | 5793 solve_singularity_handler sing_handler, |
| 5794 bool calc_cond) const | |
| 5164 | 5795 { |
| 5796 SparseComplexMatrix retval; | |
| 5797 | |
| 5275 | 5798 octave_idx_type nr = rows (); |
| 5799 octave_idx_type nc = cols (); | |
| 5164 | 5800 err = 0; |
| 5801 | |
| 6924 | 5802 if (nr != nc || nr != b.rows ()) |
| 5164 | 5803 (*current_liboctave_error_handler) |
| 5804 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 5805 else if (nr == 0 || b.cols () == 0) |
| 5806 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 5807 else |
| 5808 { | |
| 5809 // Print spparms("spumoni") info if requested | |
| 5506 | 5810 volatile int typ = mattype.type (); |
| 5164 | 5811 mattype.info (); |
| 5812 | |
| 5785 | 5813 if (typ == MatrixType::Hermitian) |
| 5164 | 5814 { |
| 5506 | 5815 #ifdef HAVE_CHOLMOD |
| 5816 cholmod_common Common; | |
| 5817 cholmod_common *cm = &Common; | |
| 5818 | |
| 5819 // Setup initial parameters | |
| 5820 CHOLMOD_NAME(start) (cm); | |
| 5526 | 5821 cm->prefer_zomplex = false; |
| 5506 | 5822 |
| 5893 | 5823 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 5824 if (spu == 0.) |
| 5825 { | |
| 5826 cm->print = -1; | |
| 5827 cm->print_function = NULL; | |
| 5828 } | |
| 5829 else | |
| 5830 { | |
| 5760 | 5831 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 5832 cm->print_function =&SparseCholPrint; |
| 5833 } | |
| 5834 | |
| 5835 cm->error_handler = &SparseCholError; | |
| 5836 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 5837 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 5838 | |
| 5526 | 5839 cm->final_ll = true; |
| 5506 | 5840 |
| 5841 cholmod_sparse Astore; | |
| 5842 cholmod_sparse *A = &Astore; | |
| 5843 double dummy; | |
| 5844 A->nrow = nr; | |
| 5845 A->ncol = nc; | |
| 5846 | |
| 5847 A->p = cidx(); | |
| 5848 A->i = ridx(); | |
| 5604 | 5849 A->nzmax = nnz(); |
| 5526 | 5850 A->packed = true; |
| 5851 A->sorted = true; | |
| 5506 | 5852 A->nz = NULL; |
| 5853 #ifdef IDX_TYPE_LONG | |
| 5854 A->itype = CHOLMOD_LONG; | |
| 5855 #else | |
| 5856 A->itype = CHOLMOD_INT; | |
| 5857 #endif | |
| 5858 A->dtype = CHOLMOD_DOUBLE; | |
| 5859 A->stype = 1; | |
| 5860 A->xtype = CHOLMOD_COMPLEX; | |
| 5861 | |
| 5862 if (nr < 1) | |
| 5863 A->x = &dummy; | |
| 5864 else | |
| 5865 A->x = data(); | |
| 5866 | |
| 5867 cholmod_sparse Bstore; | |
| 5868 cholmod_sparse *B = &Bstore; | |
| 5869 B->nrow = b.rows(); | |
| 5870 B->ncol = b.cols(); | |
| 5871 B->p = b.cidx(); | |
| 5872 B->i = b.ridx(); | |
| 5604 | 5873 B->nzmax = b.nnz(); |
| 5526 | 5874 B->packed = true; |
| 5875 B->sorted = true; | |
| 5506 | 5876 B->nz = NULL; |
| 5877 #ifdef IDX_TYPE_LONG | |
| 5878 B->itype = CHOLMOD_LONG; | |
| 5879 #else | |
| 5880 B->itype = CHOLMOD_INT; | |
| 5881 #endif | |
| 5882 B->dtype = CHOLMOD_DOUBLE; | |
| 5883 B->stype = 0; | |
| 5884 B->xtype = CHOLMOD_REAL; | |
| 5885 | |
| 5886 if (b.rows() < 1 || b.cols() < 1) | |
| 5887 B->x = &dummy; | |
| 5888 else | |
| 5889 B->x = b.data(); | |
| 5890 | |
| 5891 cholmod_factor *L; | |
| 5892 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5893 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 5894 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 5895 if (calc_cond) |
| 5896 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 5897 else | |
| 5898 rcond = 1.; | |
| 5506 | 5899 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5900 | |
| 5901 if (rcond == 0.0) | |
| 5902 { | |
| 5903 // Either its indefinite or singular. Try UMFPACK | |
| 5904 mattype.mark_as_unsymmetric (); | |
| 5785 | 5905 typ = MatrixType::Full; |
| 5506 | 5906 } |
| 5907 else | |
| 5908 { | |
| 5909 volatile double rcond_plus_one = rcond + 1.0; | |
| 5910 | |
| 5911 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 5912 { | |
| 5913 err = -2; | |
| 5914 | |
| 5915 if (sing_handler) | |
| 5681 | 5916 { |
| 5917 sing_handler (rcond); | |
| 5918 mattype.mark_as_rectangular (); | |
| 5919 } | |
| 5506 | 5920 else |
| 5921 (*current_liboctave_error_handler) | |
| 5922 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 5923 rcond); | |
| 5924 | |
| 5925 return retval; | |
| 5926 } | |
| 5927 | |
| 5928 cholmod_sparse *X; | |
| 5929 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5930 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 5931 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5932 | |
| 5933 retval = SparseComplexMatrix | |
| 5934 (static_cast<octave_idx_type>(X->nrow), | |
| 5935 static_cast<octave_idx_type>(X->ncol), | |
| 5936 static_cast<octave_idx_type>(X->nzmax)); | |
| 5937 for (octave_idx_type j = 0; | |
| 5938 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 5939 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 5940 for (octave_idx_type j = 0; | |
| 5941 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 5942 { | |
| 5943 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 5944 retval.xdata(j) = static_cast<Complex *>(X->x)[j]; | |
| 5945 } | |
| 5946 | |
| 5947 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 5948 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 5949 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 5950 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 5951 static char tmp[] = " "; |
| 5952 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 5953 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 5954 } | |
| 5955 #else | |
| 5164 | 5956 (*current_liboctave_warning_handler) |
| 5506 | 5957 ("CHOLMOD not installed"); |
| 5164 | 5958 |
| 5959 mattype.mark_as_unsymmetric (); | |
| 5785 | 5960 typ = MatrixType::Full; |
| 5506 | 5961 #endif |
| 5164 | 5962 } |
| 5963 | |
| 5785 | 5964 if (typ == MatrixType::Full) |
| 5164 | 5965 { |
| 5203 | 5966 #ifdef HAVE_UMFPACK |
| 5164 | 5967 Matrix Control, Info; |
| 5681 | 5968 void *Numeric = factorize (err, rcond, Control, Info, |
| 5969 sing_handler, calc_cond); | |
| 5164 | 5970 |
| 5971 if (err == 0) | |
| 5972 { | |
| 5275 | 5973 octave_idx_type b_nr = b.rows (); |
| 5974 octave_idx_type b_nc = b.cols (); | |
| 5164 | 5975 int status = 0; |
| 5976 double *control = Control.fortran_vec (); | |
| 5977 double *info = Info.fortran_vec (); | |
| 5275 | 5978 const octave_idx_type *Ap = cidx (); |
| 5979 const octave_idx_type *Ai = ridx (); | |
| 5164 | 5980 const Complex *Ax = data (); |
| 5981 | |
| 5203 | 5982 #ifdef UMFPACK_SEPARATE_SPLIT |
| 5164 | 5983 OCTAVE_LOCAL_BUFFER (double, Bx, b_nr); |
| 5984 OCTAVE_LOCAL_BUFFER (double, Bz, b_nr); | |
| 5275 | 5985 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 5986 Bz[i] = 0.; |
| 5203 | 5987 #else |
| 5988 OCTAVE_LOCAL_BUFFER (Complex, Bz, b_nr); | |
| 5989 #endif | |
| 5164 | 5990 |
| 5991 // Take a first guess that the number of non-zero terms | |
| 5992 // will be as many as in b | |
| 5681 | 5993 octave_idx_type x_nz = b.nnz (); |
| 5275 | 5994 octave_idx_type ii = 0; |
| 5164 | 5995 retval = SparseComplexMatrix (b_nr, b_nc, x_nz); |
| 5996 | |
| 5997 OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); | |
| 5998 | |
| 5999 retval.xcidx(0) = 0; | |
| 5275 | 6000 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6001 { |
| 6002 | |
| 5203 | 6003 #ifdef UMFPACK_SEPARATE_SPLIT |
| 5275 | 6004 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6005 Bx[i] = b.elem (i, j); |
| 6006 | |
| 5322 | 6007 status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, |
| 5760 | 6008 Ai, |
| 6009 reinterpret_cast<const double *> (Ax), | |
| 5164 | 6010 NULL, |
| 5760 | 6011 reinterpret_cast<double *> (Xx), |
| 6012 NULL, | |
| 5164 | 6013 Bx, Bz, Numeric, control, |
| 6014 info); | |
| 5203 | 6015 #else |
| 5275 | 6016 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5203 | 6017 Bz[i] = b.elem (i, j); |
| 6018 | |
| 5322 | 6019 status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, Ai, |
| 5760 | 6020 reinterpret_cast<const double *> (Ax), |
| 5203 | 6021 NULL, |
| 5760 | 6022 reinterpret_cast<double *> (Xx), |
| 6023 NULL, | |
| 6024 reinterpret_cast<double *> (Bz), | |
| 6025 NULL, | |
| 5203 | 6026 Numeric, control, |
| 6027 info); | |
| 6028 #endif | |
| 5164 | 6029 if (status < 0) |
| 6030 { | |
| 6031 (*current_liboctave_error_handler) | |
| 6032 ("SparseComplexMatrix::solve solve failed"); | |
| 6033 | |
| 5322 | 6034 UMFPACK_ZNAME (report_status) (control, status); |
| 5164 | 6035 |
| 6036 err = -1; | |
| 6037 | |
| 6038 break; | |
| 6039 } | |
| 6040 | |
| 5275 | 6041 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6042 { |
| 6043 Complex tmp = Xx[i]; | |
| 6044 if (tmp != 0.0) | |
| 6045 { | |
| 6046 if (ii == x_nz) | |
| 6047 { | |
| 6048 // Resize the sparse matrix | |
| 5275 | 6049 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6050 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6051 retval.change_capacity (sz); | |
| 6052 x_nz = sz; | |
| 6053 } | |
| 6054 retval.xdata(ii) = tmp; | |
| 6055 retval.xridx(ii++) = i; | |
| 6056 } | |
| 6057 } | |
| 6058 retval.xcidx(j+1) = ii; | |
| 6059 } | |
| 6060 | |
| 6061 retval.maybe_compress (); | |
| 6062 | |
| 5322 | 6063 UMFPACK_ZNAME (report_info) (control, info); |
| 6064 | |
| 6065 UMFPACK_ZNAME (free_numeric) (&Numeric); | |
| 5164 | 6066 } |
| 5681 | 6067 else |
| 6068 mattype.mark_as_rectangular (); | |
| 6069 | |
| 5203 | 6070 #else |
| 6071 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6072 #endif | |
| 5164 | 6073 } |
| 5785 | 6074 else if (typ != MatrixType::Hermitian) |
| 5164 | 6075 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6076 } | |
| 6077 | |
| 6078 return retval; | |
| 6079 } | |
| 6080 | |
| 6081 ComplexMatrix | |
| 5785 | 6082 SparseComplexMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6083 octave_idx_type& err, double& rcond, |
| 5681 | 6084 solve_singularity_handler sing_handler, |
| 6085 bool calc_cond) const | |
| 5164 | 6086 { |
| 6087 ComplexMatrix retval; | |
| 6088 | |
| 5275 | 6089 octave_idx_type nr = rows (); |
| 6090 octave_idx_type nc = cols (); | |
| 5164 | 6091 err = 0; |
| 6092 | |
| 6924 | 6093 if (nr != nc || nr != b.rows ()) |
| 5164 | 6094 (*current_liboctave_error_handler) |
| 6095 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6096 else if (nr == 0 || b.cols () == 0) |
| 6097 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
| 5164 | 6098 else |
| 6099 { | |
| 6100 // Print spparms("spumoni") info if requested | |
| 5506 | 6101 volatile int typ = mattype.type (); |
| 5164 | 6102 mattype.info (); |
| 6103 | |
| 5785 | 6104 if (typ == MatrixType::Hermitian) |
| 5164 | 6105 { |
| 5506 | 6106 #ifdef HAVE_CHOLMOD |
| 6107 cholmod_common Common; | |
| 6108 cholmod_common *cm = &Common; | |
| 6109 | |
| 6110 // Setup initial parameters | |
| 6111 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6112 cm->prefer_zomplex = false; |
| 5506 | 6113 |
| 5893 | 6114 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6115 if (spu == 0.) |
| 6116 { | |
| 6117 cm->print = -1; | |
| 6118 cm->print_function = NULL; | |
| 6119 } | |
| 6120 else | |
| 6121 { | |
| 5760 | 6122 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6123 cm->print_function =&SparseCholPrint; |
| 6124 } | |
| 6125 | |
| 6126 cm->error_handler = &SparseCholError; | |
| 6127 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6128 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6129 | |
| 5526 | 6130 cm->final_ll = true; |
| 5506 | 6131 |
| 6132 cholmod_sparse Astore; | |
| 6133 cholmod_sparse *A = &Astore; | |
| 6134 double dummy; | |
| 6135 A->nrow = nr; | |
| 6136 A->ncol = nc; | |
| 6137 | |
| 6138 A->p = cidx(); | |
| 6139 A->i = ridx(); | |
| 5604 | 6140 A->nzmax = nnz(); |
| 5526 | 6141 A->packed = true; |
| 6142 A->sorted = true; | |
| 5506 | 6143 A->nz = NULL; |
| 6144 #ifdef IDX_TYPE_LONG | |
| 6145 A->itype = CHOLMOD_LONG; | |
| 6146 #else | |
| 6147 A->itype = CHOLMOD_INT; | |
| 6148 #endif | |
| 6149 A->dtype = CHOLMOD_DOUBLE; | |
| 6150 A->stype = 1; | |
| 6151 A->xtype = CHOLMOD_COMPLEX; | |
| 6152 | |
| 6153 if (nr < 1) | |
| 6154 A->x = &dummy; | |
| 6155 else | |
| 6156 A->x = data(); | |
| 6157 | |
| 6158 cholmod_dense Bstore; | |
| 6159 cholmod_dense *B = &Bstore; | |
| 6160 B->nrow = b.rows(); | |
| 6161 B->ncol = b.cols(); | |
| 6162 B->d = B->nrow; | |
| 6163 B->nzmax = B->nrow * B->ncol; | |
| 6164 B->dtype = CHOLMOD_DOUBLE; | |
| 6165 B->xtype = CHOLMOD_COMPLEX; | |
| 6166 if (nc < 1 || b.cols() < 1) | |
| 6167 B->x = &dummy; | |
| 6168 else | |
| 6169 // We won't alter it, honest :-) | |
| 6170 B->x = const_cast<Complex *>(b.fortran_vec()); | |
| 6171 | |
| 6172 cholmod_factor *L; | |
| 6173 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6174 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6175 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6176 if (calc_cond) |
| 6177 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6178 else | |
| 6179 rcond = 1.; | |
| 5506 | 6180 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6181 | |
| 6182 if (rcond == 0.0) | |
| 6183 { | |
| 6184 // Either its indefinite or singular. Try UMFPACK | |
| 6185 mattype.mark_as_unsymmetric (); | |
| 5785 | 6186 typ = MatrixType::Full; |
| 5506 | 6187 } |
| 6188 else | |
| 6189 { | |
| 6190 volatile double rcond_plus_one = rcond + 1.0; | |
| 6191 | |
| 6192 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6193 { | |
| 6194 err = -2; | |
| 6195 | |
| 6196 if (sing_handler) | |
| 5681 | 6197 { |
| 6198 sing_handler (rcond); | |
| 6199 mattype.mark_as_rectangular (); | |
| 6200 } | |
| 5506 | 6201 else |
| 6202 (*current_liboctave_error_handler) | |
| 6203 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6204 rcond); | |
| 6205 | |
| 6206 return retval; | |
| 6207 } | |
| 6208 | |
| 6209 cholmod_dense *X; | |
| 6210 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6211 X = CHOLMOD_NAME(solve) (CHOLMOD_A, L, B, cm); | |
| 6212 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6213 | |
| 6214 retval.resize (b.rows (), b.cols()); | |
| 6215 for (octave_idx_type j = 0; j < b.cols(); j++) | |
| 6216 { | |
| 6217 octave_idx_type jr = j * b.rows(); | |
| 6218 for (octave_idx_type i = 0; i < b.rows(); i++) | |
| 6219 retval.xelem(i,j) = static_cast<Complex *>(X->x)[jr + i]; | |
| 6220 } | |
| 6221 | |
| 6222 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6223 CHOLMOD_NAME(free_dense) (&X, cm); | |
| 6224 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6225 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6226 static char tmp[] = " "; |
| 6227 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6228 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6229 } | |
| 6230 #else | |
| 5164 | 6231 (*current_liboctave_warning_handler) |
| 5506 | 6232 ("CHOLMOD not installed"); |
| 5164 | 6233 |
| 6234 mattype.mark_as_unsymmetric (); | |
| 5785 | 6235 typ = MatrixType::Full; |
| 5506 | 6236 #endif |
| 5164 | 6237 } |
| 6238 | |
| 5785 | 6239 if (typ == MatrixType::Full) |
| 5164 | 6240 { |
| 5203 | 6241 #ifdef HAVE_UMFPACK |
| 5164 | 6242 Matrix Control, Info; |
| 5681 | 6243 void *Numeric = factorize (err, rcond, Control, Info, |
| 6244 sing_handler, calc_cond); | |
| 5164 | 6245 |
| 6246 if (err == 0) | |
| 6247 { | |
| 5275 | 6248 octave_idx_type b_nr = b.rows (); |
| 6249 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6250 int status = 0; |
| 6251 double *control = Control.fortran_vec (); | |
| 6252 double *info = Info.fortran_vec (); | |
| 5275 | 6253 const octave_idx_type *Ap = cidx (); |
| 6254 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6255 const Complex *Ax = data (); |
| 6256 const Complex *Bx = b.fortran_vec (); | |
| 6257 | |
| 6258 retval.resize (b_nr, b_nc); | |
| 6259 Complex *Xx = retval.fortran_vec (); | |
| 6260 | |
| 5275 | 6261 for (octave_idx_type j = 0, iidx = 0; j < b_nc; j++, iidx += b_nr) |
| 5164 | 6262 { |
| 6263 status = | |
| 5322 | 6264 UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, Ai, |
| 5760 | 6265 reinterpret_cast<const double *> (Ax), |
| 6266 NULL, | |
| 6267 reinterpret_cast<double *> (&Xx[iidx]), | |
| 6268 NULL, | |
| 6269 reinterpret_cast<const double *> (&Bx[iidx]), | |
| 5164 | 6270 NULL, Numeric, control, info); |
| 6271 | |
| 6272 if (status < 0) | |
| 6273 { | |
| 6274 (*current_liboctave_error_handler) | |
| 6275 ("SparseComplexMatrix::solve solve failed"); | |
| 6276 | |
| 5322 | 6277 UMFPACK_ZNAME (report_status) (control, status); |
| 5164 | 6278 |
| 6279 err = -1; | |
| 6280 | |
| 6281 break; | |
| 6282 } | |
| 6283 } | |
| 6284 | |
| 5322 | 6285 UMFPACK_ZNAME (report_info) (control, info); |
| 6286 | |
| 6287 UMFPACK_ZNAME (free_numeric) (&Numeric); | |
| 5164 | 6288 } |
| 5681 | 6289 else |
| 6290 mattype.mark_as_rectangular (); | |
| 6291 | |
| 5203 | 6292 #else |
| 6293 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6294 #endif | |
| 5164 | 6295 } |
| 5785 | 6296 else if (typ != MatrixType::Hermitian) |
| 5164 | 6297 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6298 } | |
| 6299 | |
| 6300 return retval; | |
| 6301 } | |
| 6302 | |
| 6303 SparseComplexMatrix | |
| 5785 | 6304 SparseComplexMatrix::fsolve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6305 octave_idx_type& err, double& rcond, |
| 5681 | 6306 solve_singularity_handler sing_handler, |
| 6307 bool calc_cond) const | |
| 5164 | 6308 { |
| 6309 SparseComplexMatrix retval; | |
| 6310 | |
| 5275 | 6311 octave_idx_type nr = rows (); |
| 6312 octave_idx_type nc = cols (); | |
| 5164 | 6313 err = 0; |
| 6314 | |
| 6924 | 6315 if (nr != nc || nr != b.rows ()) |
| 5164 | 6316 (*current_liboctave_error_handler) |
| 6317 ("matrix dimension mismatch solution of linear equations"); | |
| 6924 | 6318 else if (nr == 0 || b.cols () == 0) |
| 6319 retval = SparseComplexMatrix (nc, b.cols ()); | |
| 5164 | 6320 else |
| 6321 { | |
| 6322 // Print spparms("spumoni") info if requested | |
| 5506 | 6323 volatile int typ = mattype.type (); |
| 5164 | 6324 mattype.info (); |
| 6325 | |
| 5785 | 6326 if (typ == MatrixType::Hermitian) |
| 5164 | 6327 { |
| 5506 | 6328 #ifdef HAVE_CHOLMOD |
| 6329 cholmod_common Common; | |
| 6330 cholmod_common *cm = &Common; | |
| 6331 | |
| 6332 // Setup initial parameters | |
| 6333 CHOLMOD_NAME(start) (cm); | |
| 5526 | 6334 cm->prefer_zomplex = false; |
| 5506 | 6335 |
| 5893 | 6336 double spu = octave_sparse_params::get_key ("spumoni"); |
| 5506 | 6337 if (spu == 0.) |
| 6338 { | |
| 6339 cm->print = -1; | |
| 6340 cm->print_function = NULL; | |
| 6341 } | |
| 6342 else | |
| 6343 { | |
| 5760 | 6344 cm->print = static_cast<int> (spu) + 2; |
| 5506 | 6345 cm->print_function =&SparseCholPrint; |
| 6346 } | |
| 6347 | |
| 6348 cm->error_handler = &SparseCholError; | |
| 6349 cm->complex_divide = CHOLMOD_NAME(divcomplex); | |
| 6350 cm->hypotenuse = CHOLMOD_NAME(hypot); | |
| 6351 | |
| 5526 | 6352 cm->final_ll = true; |
| 5506 | 6353 |
| 6354 cholmod_sparse Astore; | |
| 6355 cholmod_sparse *A = &Astore; | |
| 6356 double dummy; | |
| 6357 A->nrow = nr; | |
| 6358 A->ncol = nc; | |
| 6359 | |
| 6360 A->p = cidx(); | |
| 6361 A->i = ridx(); | |
| 5604 | 6362 A->nzmax = nnz(); |
| 5526 | 6363 A->packed = true; |
| 6364 A->sorted = true; | |
| 5506 | 6365 A->nz = NULL; |
| 6366 #ifdef IDX_TYPE_LONG | |
| 6367 A->itype = CHOLMOD_LONG; | |
| 6368 #else | |
| 6369 A->itype = CHOLMOD_INT; | |
| 6370 #endif | |
| 6371 A->dtype = CHOLMOD_DOUBLE; | |
| 6372 A->stype = 1; | |
| 6373 A->xtype = CHOLMOD_COMPLEX; | |
| 6374 | |
| 6375 if (nr < 1) | |
| 6376 A->x = &dummy; | |
| 6377 else | |
| 6378 A->x = data(); | |
| 6379 | |
| 6380 cholmod_sparse Bstore; | |
| 6381 cholmod_sparse *B = &Bstore; | |
| 6382 B->nrow = b.rows(); | |
| 6383 B->ncol = b.cols(); | |
| 6384 B->p = b.cidx(); | |
| 6385 B->i = b.ridx(); | |
| 5604 | 6386 B->nzmax = b.nnz(); |
| 5526 | 6387 B->packed = true; |
| 6388 B->sorted = true; | |
| 5506 | 6389 B->nz = NULL; |
| 6390 #ifdef IDX_TYPE_LONG | |
| 6391 B->itype = CHOLMOD_LONG; | |
| 6392 #else | |
| 6393 B->itype = CHOLMOD_INT; | |
| 6394 #endif | |
| 6395 B->dtype = CHOLMOD_DOUBLE; | |
| 6396 B->stype = 0; | |
| 6397 B->xtype = CHOLMOD_COMPLEX; | |
| 6398 | |
| 6399 if (b.rows() < 1 || b.cols() < 1) | |
| 6400 B->x = &dummy; | |
| 6401 else | |
| 6402 B->x = b.data(); | |
| 6403 | |
| 6404 cholmod_factor *L; | |
| 6405 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6406 L = CHOLMOD_NAME(analyze) (A, cm); | |
| 6407 CHOLMOD_NAME(factorize) (A, L, cm); | |
| 5681 | 6408 if (calc_cond) |
| 6409 rcond = CHOLMOD_NAME(rcond)(L, cm); | |
| 6410 else | |
| 6411 rcond = 1.; | |
| 5506 | 6412 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6413 | |
| 6414 if (rcond == 0.0) | |
| 6415 { | |
| 6416 // Either its indefinite or singular. Try UMFPACK | |
| 6417 mattype.mark_as_unsymmetric (); | |
| 5785 | 6418 typ = MatrixType::Full; |
| 5506 | 6419 } |
| 6420 else | |
| 6421 { | |
| 6422 volatile double rcond_plus_one = rcond + 1.0; | |
| 6423 | |
| 6424 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6425 { | |
| 6426 err = -2; | |
| 6427 | |
| 6428 if (sing_handler) | |
| 5681 | 6429 { |
| 6430 sing_handler (rcond); | |
| 6431 mattype.mark_as_rectangular (); | |
| 6432 } | |
| 5506 | 6433 else |
| 6434 (*current_liboctave_error_handler) | |
| 6435 ("SparseMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6436 rcond); | |
| 6437 | |
| 6438 return retval; | |
| 6439 } | |
| 6440 | |
| 6441 cholmod_sparse *X; | |
| 6442 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6443 X = CHOLMOD_NAME(spsolve) (CHOLMOD_A, L, B, cm); | |
| 6444 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6445 | |
| 6446 retval = SparseComplexMatrix | |
| 6447 (static_cast<octave_idx_type>(X->nrow), | |
| 6448 static_cast<octave_idx_type>(X->ncol), | |
| 6449 static_cast<octave_idx_type>(X->nzmax)); | |
| 6450 for (octave_idx_type j = 0; | |
| 6451 j <= static_cast<octave_idx_type>(X->ncol); j++) | |
| 6452 retval.xcidx(j) = static_cast<octave_idx_type *>(X->p)[j]; | |
| 6453 for (octave_idx_type j = 0; | |
| 6454 j < static_cast<octave_idx_type>(X->nzmax); j++) | |
| 6455 { | |
| 6456 retval.xridx(j) = static_cast<octave_idx_type *>(X->i)[j]; | |
| 6457 retval.xdata(j) = static_cast<Complex *>(X->x)[j]; | |
| 6458 } | |
| 6459 | |
| 6460 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; | |
| 6461 CHOLMOD_NAME(free_sparse) (&X, cm); | |
| 6462 CHOLMOD_NAME(free_factor) (&L, cm); | |
| 6463 CHOLMOD_NAME(finish) (cm); | |
| 6482 | 6464 static char tmp[] = " "; |
| 6465 CHOLMOD_NAME(print_common) (tmp, cm); | |
| 5506 | 6466 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
| 6467 } | |
| 6468 #else | |
| 5164 | 6469 (*current_liboctave_warning_handler) |
| 5506 | 6470 ("CHOLMOD not installed"); |
| 5164 | 6471 |
| 6472 mattype.mark_as_unsymmetric (); | |
| 5785 | 6473 typ = MatrixType::Full; |
| 5506 | 6474 #endif |
| 5164 | 6475 } |
| 6476 | |
| 5785 | 6477 if (typ == MatrixType::Full) |
| 5164 | 6478 { |
| 5203 | 6479 #ifdef HAVE_UMFPACK |
| 5164 | 6480 Matrix Control, Info; |
| 5681 | 6481 void *Numeric = factorize (err, rcond, Control, Info, |
| 6482 sing_handler, calc_cond); | |
| 5164 | 6483 |
| 6484 if (err == 0) | |
| 6485 { | |
| 5275 | 6486 octave_idx_type b_nr = b.rows (); |
| 6487 octave_idx_type b_nc = b.cols (); | |
| 5164 | 6488 int status = 0; |
| 6489 double *control = Control.fortran_vec (); | |
| 6490 double *info = Info.fortran_vec (); | |
| 5275 | 6491 const octave_idx_type *Ap = cidx (); |
| 6492 const octave_idx_type *Ai = ridx (); | |
| 5164 | 6493 const Complex *Ax = data (); |
| 6494 | |
| 6495 OCTAVE_LOCAL_BUFFER (Complex, Bx, b_nr); | |
| 6496 | |
| 6497 // Take a first guess that the number of non-zero terms | |
| 6498 // will be as many as in b | |
| 5681 | 6499 octave_idx_type x_nz = b.nnz (); |
| 5275 | 6500 octave_idx_type ii = 0; |
| 5164 | 6501 retval = SparseComplexMatrix (b_nr, b_nc, x_nz); |
| 6502 | |
| 6503 OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); | |
| 6504 | |
| 6505 retval.xcidx(0) = 0; | |
| 5275 | 6506 for (octave_idx_type j = 0; j < b_nc; j++) |
| 5164 | 6507 { |
| 5275 | 6508 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6509 Bx[i] = b (i,j); |
| 6510 | |
| 5322 | 6511 status = UMFPACK_ZNAME (solve) (UMFPACK_A, Ap, |
| 5760 | 6512 Ai, |
| 6513 reinterpret_cast<const double *> (Ax), | |
| 6514 NULL, | |
| 6515 reinterpret_cast<double *> (Xx), | |
| 6516 NULL, | |
| 6517 reinterpret_cast<double *> (Bx), | |
| 5164 | 6518 NULL, Numeric, control, info); |
| 6519 | |
| 6520 if (status < 0) | |
| 6521 { | |
| 6522 (*current_liboctave_error_handler) | |
| 6523 ("SparseComplexMatrix::solve solve failed"); | |
| 6524 | |
| 5322 | 6525 UMFPACK_ZNAME (report_status) (control, status); |
| 5164 | 6526 |
| 6527 err = -1; | |
| 6528 | |
| 6529 break; | |
| 6530 } | |
| 6531 | |
| 5275 | 6532 for (octave_idx_type i = 0; i < b_nr; i++) |
| 5164 | 6533 { |
| 6534 Complex tmp = Xx[i]; | |
| 6535 if (tmp != 0.0) | |
| 6536 { | |
| 6537 if (ii == x_nz) | |
| 6538 { | |
| 6539 // Resize the sparse matrix | |
| 5275 | 6540 octave_idx_type sz = x_nz * (b_nc - j) / b_nc; |
| 5164 | 6541 sz = (sz > 10 ? sz : 10) + x_nz; |
| 6542 retval.change_capacity (sz); | |
| 6543 x_nz = sz; | |
| 6544 } | |
| 6545 retval.xdata(ii) = tmp; | |
| 6546 retval.xridx(ii++) = i; | |
| 6547 } | |
| 6548 } | |
| 6549 retval.xcidx(j+1) = ii; | |
| 6550 } | |
| 6551 | |
| 6552 retval.maybe_compress (); | |
| 6553 | |
| 6554 rcond = Info (UMFPACK_RCOND); | |
| 6555 volatile double rcond_plus_one = rcond + 1.0; | |
| 6556 | |
| 6557 if (status == UMFPACK_WARNING_singular_matrix || | |
| 6558 rcond_plus_one == 1.0 || xisnan (rcond)) | |
| 6559 { | |
| 6560 err = -2; | |
| 6561 | |
| 6562 if (sing_handler) | |
| 6563 sing_handler (rcond); | |
| 6564 else | |
| 6565 (*current_liboctave_error_handler) | |
| 6566 ("SparseComplexMatrix::solve matrix singular to machine precision, rcond = %g", | |
| 6567 rcond); | |
| 6568 | |
| 6569 } | |
| 6570 | |
| 5322 | 6571 UMFPACK_ZNAME (report_info) (control, info); |
| 6572 | |
| 6573 UMFPACK_ZNAME (free_numeric) (&Numeric); | |
| 5164 | 6574 } |
| 5681 | 6575 else |
| 6576 mattype.mark_as_rectangular (); | |
| 6577 | |
| 5203 | 6578 #else |
| 6579 (*current_liboctave_error_handler) ("UMFPACK not installed"); | |
| 6580 #endif | |
| 5164 | 6581 } |
| 5785 | 6582 else if (typ != MatrixType::Hermitian) |
| 5164 | 6583 (*current_liboctave_error_handler) ("incorrect matrix type"); |
| 6584 } | |
| 6585 | |
| 6586 return retval; | |
| 6587 } | |
| 6588 | |
| 6589 ComplexMatrix | |
| 5785 | 6590 SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b) const |
| 5164 | 6591 { |
| 5275 | 6592 octave_idx_type info; |
| 5164 | 6593 double rcond; |
| 6594 return solve (mattype, b, info, rcond, 0); | |
| 6595 } | |
| 6596 | |
| 6597 ComplexMatrix | |
| 5785 | 6598 SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, |
| 5275 | 6599 octave_idx_type& info) const |
| 5164 | 6600 { |
| 6601 double rcond; | |
| 6602 return solve (mattype, b, info, rcond, 0); | |
| 6603 } | |
| 6604 | |
| 6605 ComplexMatrix | |
| 5785 | 6606 SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, |
| 5697 | 6607 octave_idx_type& info, double& rcond) const |
| 5164 | 6608 { |
| 6609 return solve (mattype, b, info, rcond, 0); | |
| 6610 } | |
| 6611 | |
| 6612 ComplexMatrix | |
| 5785 | 6613 SparseComplexMatrix::solve (MatrixType &mattype, const Matrix& b, |
| 5697 | 6614 octave_idx_type& err, double& rcond, |
| 6615 solve_singularity_handler sing_handler, | |
| 6616 bool singular_fallback) const | |
| 5164 | 6617 { |
| 5681 | 6618 ComplexMatrix retval; |
| 5322 | 6619 int typ = mattype.type (false); |
| 5164 | 6620 |
| 5785 | 6621 if (typ == MatrixType::Unknown) |
| 5164 | 6622 typ = mattype.type (*this); |
| 6623 | |
| 5785 | 6624 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6625 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6626 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6627 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6628 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6629 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6630 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6631 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6632 else if (typ == MatrixType::Tridiagonal || |
| 6633 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6634 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6635 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6636 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6637 else if (typ != MatrixType::Rectangular) |
| 5164 | 6638 { |
| 5681 | 6639 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6640 return ComplexMatrix (); |
| 6641 } | |
| 5681 | 6642 |
| 5785 | 6643 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6644 { |
| 6645 rcond = 1.; | |
| 6646 #ifdef USE_QRSOLVE | |
| 6647 retval = qrsolve (*this, b, err); | |
| 6648 #else | |
| 6649 retval = dmsolve<ComplexMatrix, SparseComplexMatrix, | |
| 6650 Matrix> (*this, b, err); | |
| 6651 #endif | |
| 6652 } | |
| 6653 | |
| 6654 return retval; | |
| 5164 | 6655 } |
| 6656 | |
| 6657 SparseComplexMatrix | |
| 5785 | 6658 SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b) const |
| 5164 | 6659 { |
| 5275 | 6660 octave_idx_type info; |
| 5164 | 6661 double rcond; |
| 6662 return solve (mattype, b, info, rcond, 0); | |
| 6663 } | |
| 6664 | |
| 6665 SparseComplexMatrix | |
| 5785 | 6666 SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6667 octave_idx_type& info) const |
| 5164 | 6668 { |
| 6669 double rcond; | |
| 6670 return solve (mattype, b, info, rcond, 0); | |
| 6671 } | |
| 6672 | |
| 6673 SparseComplexMatrix | |
| 5785 | 6674 SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6675 octave_idx_type& info, double& rcond) const |
| 5164 | 6676 { |
| 6677 return solve (mattype, b, info, rcond, 0); | |
| 6678 } | |
| 6679 | |
| 6680 SparseComplexMatrix | |
| 5785 | 6681 SparseComplexMatrix::solve (MatrixType &mattype, const SparseMatrix& b, |
| 5275 | 6682 octave_idx_type& err, double& rcond, |
| 5697 | 6683 solve_singularity_handler sing_handler, |
| 6684 bool singular_fallback) const | |
| 5164 | 6685 { |
| 5681 | 6686 SparseComplexMatrix retval; |
| 5322 | 6687 int typ = mattype.type (false); |
| 5164 | 6688 |
| 5785 | 6689 if (typ == MatrixType::Unknown) |
| 5164 | 6690 typ = mattype.type (*this); |
| 6691 | |
| 5785 | 6692 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6693 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6694 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6695 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6696 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6697 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6698 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6699 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6700 else if (typ == MatrixType::Tridiagonal || |
| 6701 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6702 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6703 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6704 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6705 else if (typ != MatrixType::Rectangular) |
| 5164 | 6706 { |
| 5681 | 6707 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6708 return SparseComplexMatrix (); |
| 6709 } | |
| 5681 | 6710 |
| 5785 | 6711 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6712 { |
| 6713 rcond = 1.; | |
| 6714 #ifdef USE_QRSOLVE | |
| 6715 retval = qrsolve (*this, b, err); | |
| 6716 #else | |
| 6717 retval = dmsolve<SparseComplexMatrix, SparseComplexMatrix, | |
| 6718 SparseMatrix> (*this, b, err); | |
| 6719 #endif | |
| 6720 } | |
| 6721 | |
| 6722 return retval; | |
| 5164 | 6723 } |
| 6724 | |
| 6725 ComplexMatrix | |
| 5785 | 6726 SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b) const |
| 5164 | 6727 { |
| 5275 | 6728 octave_idx_type info; |
| 5164 | 6729 double rcond; |
| 6730 return solve (mattype, b, info, rcond, 0); | |
| 6731 } | |
| 6732 | |
| 6733 ComplexMatrix | |
| 5785 | 6734 SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5275 | 6735 octave_idx_type& info) const |
| 5164 | 6736 { |
| 6737 double rcond; | |
| 6738 return solve (mattype, b, info, rcond, 0); | |
| 6739 } | |
| 6740 | |
| 6741 ComplexMatrix | |
| 5785 | 6742 SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5697 | 6743 octave_idx_type& info, double& rcond) const |
| 5164 | 6744 { |
| 6745 return solve (mattype, b, info, rcond, 0); | |
| 6746 } | |
| 6747 | |
| 6748 ComplexMatrix | |
| 5785 | 6749 SparseComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, |
| 5697 | 6750 octave_idx_type& err, double& rcond, |
| 6751 solve_singularity_handler sing_handler, | |
| 6752 bool singular_fallback) const | |
| 5164 | 6753 { |
| 5681 | 6754 ComplexMatrix retval; |
| 5322 | 6755 int typ = mattype.type (false); |
| 5164 | 6756 |
| 5785 | 6757 if (typ == MatrixType::Unknown) |
| 5164 | 6758 typ = mattype.type (*this); |
| 6759 | |
| 5785 | 6760 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6761 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6762 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6763 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6764 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6765 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6766 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6767 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6768 else if (typ == MatrixType::Tridiagonal || |
| 6769 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6770 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6771 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6772 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6773 else if (typ != MatrixType::Rectangular) |
| 5164 | 6774 { |
| 5681 | 6775 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6776 return ComplexMatrix (); |
| 6777 } | |
| 5681 | 6778 |
| 5785 | 6779 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6780 { |
| 6781 rcond = 1.; | |
| 6782 #ifdef USE_QRSOLVE | |
| 6783 retval = qrsolve (*this, b, err); | |
| 6784 #else | |
| 6785 retval = dmsolve<ComplexMatrix, SparseComplexMatrix, | |
| 6786 ComplexMatrix> (*this, b, err); | |
| 6787 #endif | |
| 6788 } | |
| 6789 | |
| 6790 return retval; | |
| 5164 | 6791 } |
| 6792 | |
| 6793 SparseComplexMatrix | |
| 5785 | 6794 SparseComplexMatrix::solve (MatrixType &mattype, |
| 5164 | 6795 const SparseComplexMatrix& b) const |
| 6796 { | |
| 5275 | 6797 octave_idx_type info; |
| 5164 | 6798 double rcond; |
| 6799 return solve (mattype, b, info, rcond, 0); | |
| 6800 } | |
| 6801 | |
| 6802 SparseComplexMatrix | |
| 5785 | 6803 SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5697 | 6804 octave_idx_type& info) const |
| 5164 | 6805 { |
| 6806 double rcond; | |
| 6807 return solve (mattype, b, info, rcond, 0); | |
| 6808 } | |
| 6809 | |
| 6810 SparseComplexMatrix | |
| 5785 | 6811 SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5697 | 6812 octave_idx_type& info, double& rcond) const |
| 5164 | 6813 { |
| 6814 return solve (mattype, b, info, rcond, 0); | |
| 6815 } | |
| 6816 | |
| 6817 SparseComplexMatrix | |
| 5785 | 6818 SparseComplexMatrix::solve (MatrixType &mattype, const SparseComplexMatrix& b, |
| 5275 | 6819 octave_idx_type& err, double& rcond, |
| 5697 | 6820 solve_singularity_handler sing_handler, |
| 6821 bool singular_fallback) const | |
| 5164 | 6822 { |
| 5681 | 6823 SparseComplexMatrix retval; |
| 5322 | 6824 int typ = mattype.type (false); |
| 5164 | 6825 |
| 5785 | 6826 if (typ == MatrixType::Unknown) |
| 5164 | 6827 typ = mattype.type (*this); |
| 6828 | |
| 5785 | 6829 if (typ == MatrixType::Diagonal || typ == MatrixType::Permuted_Diagonal) |
| 5681 | 6830 retval = dsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6831 else if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) |
| 5681 | 6832 retval = utsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6833 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
| 5681 | 6834 retval = ltsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6835 else if (typ == MatrixType::Banded || typ == MatrixType::Banded_Hermitian) |
| 5681 | 6836 retval = bsolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6837 else if (typ == MatrixType::Tridiagonal || |
| 6838 typ == MatrixType::Tridiagonal_Hermitian) | |
| 5681 | 6839 retval = trisolve (mattype, b, err, rcond, sing_handler, false); |
| 5785 | 6840 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
| 5681 | 6841 retval = fsolve (mattype, b, err, rcond, sing_handler, true); |
| 5785 | 6842 else if (typ != MatrixType::Rectangular) |
| 5164 | 6843 { |
| 5681 | 6844 (*current_liboctave_error_handler) ("unknown matrix type"); |
| 5164 | 6845 return SparseComplexMatrix (); |
| 6846 } | |
| 5681 | 6847 |
| 5785 | 6848 if (singular_fallback && mattype.type(false) == MatrixType::Rectangular) |
| 5681 | 6849 { |
| 6850 rcond = 1.; | |
| 6851 #ifdef USE_QRSOLVE | |
| 6852 retval = qrsolve (*this, b, err); | |
| 6853 #else | |
| 6854 retval = dmsolve<SparseComplexMatrix, SparseComplexMatrix, | |
| 6855 SparseComplexMatrix> (*this, b, err); | |
| 6856 #endif | |
| 6857 } | |
| 6858 | |
| 6859 return retval; | |
| 5164 | 6860 } |
| 6861 | |
| 6862 ComplexColumnVector | |
| 5785 | 6863 SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b) const |
| 5164 | 6864 { |
| 5275 | 6865 octave_idx_type info; double rcond; |
| 5164 | 6866 return solve (mattype, b, info, rcond); |
| 6867 } | |
| 6868 | |
| 6869 ComplexColumnVector | |
| 5785 | 6870 SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, |
| 5275 | 6871 octave_idx_type& info) const |
| 5164 | 6872 { |
| 6873 double rcond; | |
| 6874 return solve (mattype, b, info, rcond); | |
| 6875 } | |
| 6876 | |
| 6877 ComplexColumnVector | |
| 5785 | 6878 SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, |
| 5275 | 6879 octave_idx_type& info, double& rcond) const |
| 5164 | 6880 { |
| 6881 return solve (mattype, b, info, rcond, 0); | |
| 6882 } | |
| 6883 | |
| 6884 ComplexColumnVector | |
| 5785 | 6885 SparseComplexMatrix::solve (MatrixType &mattype, const ColumnVector& b, |
| 5275 | 6886 octave_idx_type& info, double& rcond, |
| 5164 | 6887 solve_singularity_handler sing_handler) const |
| 6888 { | |
| 6889 Matrix tmp (b); | |
| 5275 | 6890 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 6891 } |
| 6892 | |
| 6893 ComplexColumnVector | |
| 5785 | 6894 SparseComplexMatrix::solve (MatrixType &mattype, |
| 5164 | 6895 const ComplexColumnVector& b) const |
| 6896 { | |
| 5275 | 6897 octave_idx_type info; |
| 5164 | 6898 double rcond; |
| 6899 return solve (mattype, b, info, rcond, 0); | |
| 6900 } | |
| 6901 | |
| 6902 ComplexColumnVector | |
| 5785 | 6903 SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, |
| 5275 | 6904 octave_idx_type& info) const |
| 5164 | 6905 { |
| 6906 double rcond; | |
| 6907 return solve (mattype, b, info, rcond, 0); | |
| 6908 } | |
| 6909 | |
| 6910 ComplexColumnVector | |
| 5785 | 6911 SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, |
| 5275 | 6912 octave_idx_type& info, double& rcond) const |
| 5164 | 6913 { |
| 6914 return solve (mattype, b, info, rcond, 0); | |
| 6915 } | |
| 6916 | |
| 6917 ComplexColumnVector | |
| 5785 | 6918 SparseComplexMatrix::solve (MatrixType &mattype, const ComplexColumnVector& b, |
| 5275 | 6919 octave_idx_type& info, double& rcond, |
| 5164 | 6920 solve_singularity_handler sing_handler) const |
| 6921 { | |
| 6922 ComplexMatrix tmp (b); | |
| 5275 | 6923 return solve (mattype, tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 6924 } |
| 6925 | |
| 6926 ComplexMatrix | |
| 6927 SparseComplexMatrix::solve (const Matrix& b) const | |
| 6928 { | |
| 5275 | 6929 octave_idx_type info; |
| 5164 | 6930 double rcond; |
| 6931 return solve (b, info, rcond, 0); | |
| 6932 } | |
| 6933 | |
| 6934 ComplexMatrix | |
| 5275 | 6935 SparseComplexMatrix::solve (const Matrix& b, octave_idx_type& info) const |
| 5164 | 6936 { |
| 6937 double rcond; | |
| 6938 return solve (b, info, rcond, 0); | |
| 6939 } | |
| 6940 | |
| 6941 ComplexMatrix | |
| 5275 | 6942 SparseComplexMatrix::solve (const Matrix& b, octave_idx_type& info, |
| 5164 | 6943 double& rcond) const |
| 6944 { | |
| 6945 return solve (b, info, rcond, 0); | |
| 6946 } | |
| 6947 | |
| 6948 ComplexMatrix | |
| 5275 | 6949 SparseComplexMatrix::solve (const Matrix& b, octave_idx_type& err, |
| 5164 | 6950 double& rcond, |
| 6951 solve_singularity_handler sing_handler) const | |
| 6952 { | |
| 5785 | 6953 MatrixType mattype (*this); |
| 5164 | 6954 return solve (mattype, b, err, rcond, sing_handler); |
| 6955 } | |
| 6956 | |
| 6957 SparseComplexMatrix | |
| 6958 SparseComplexMatrix::solve (const SparseMatrix& b) const | |
| 6959 { | |
| 5275 | 6960 octave_idx_type info; |
| 5164 | 6961 double rcond; |
| 6962 return solve (b, info, rcond, 0); | |
| 6963 } | |
| 6964 | |
| 6965 SparseComplexMatrix | |
| 6966 SparseComplexMatrix::solve (const SparseMatrix& b, | |
| 5275 | 6967 octave_idx_type& info) const |
| 5164 | 6968 { |
| 6969 double rcond; | |
| 6970 return solve (b, info, rcond, 0); | |
| 6971 } | |
| 6972 | |
| 6973 SparseComplexMatrix | |
| 6974 SparseComplexMatrix::solve (const SparseMatrix& b, | |
| 5275 | 6975 octave_idx_type& info, double& rcond) const |
| 5164 | 6976 { |
| 6977 return solve (b, info, rcond, 0); | |
| 6978 } | |
| 6979 | |
| 6980 SparseComplexMatrix | |
| 6981 SparseComplexMatrix::solve (const SparseMatrix& b, | |
| 5275 | 6982 octave_idx_type& err, double& rcond, |
| 5164 | 6983 solve_singularity_handler sing_handler) const |
| 6984 { | |
| 5785 | 6985 MatrixType mattype (*this); |
| 5164 | 6986 return solve (mattype, b, err, rcond, sing_handler); |
| 6987 } | |
| 6988 | |
| 6989 ComplexMatrix | |
| 6990 SparseComplexMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 6991 octave_idx_type& info) const |
| 5164 | 6992 { |
| 6993 double rcond; | |
| 6994 return solve (b, info, rcond, 0); | |
| 6995 } | |
| 6996 | |
| 6997 ComplexMatrix | |
| 6998 SparseComplexMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 6999 octave_idx_type& info, double& rcond) const |
| 5164 | 7000 { |
| 7001 return solve (b, info, rcond, 0); | |
| 7002 } | |
| 7003 | |
| 7004 ComplexMatrix | |
| 7005 SparseComplexMatrix::solve (const ComplexMatrix& b, | |
| 5275 | 7006 octave_idx_type& err, double& rcond, |
| 5164 | 7007 solve_singularity_handler sing_handler) const |
| 7008 { | |
| 5785 | 7009 MatrixType mattype (*this); |
| 5164 | 7010 return solve (mattype, b, err, rcond, sing_handler); |
| 7011 } | |
| 7012 | |
| 7013 SparseComplexMatrix | |
| 7014 SparseComplexMatrix::solve (const SparseComplexMatrix& b) const | |
| 7015 { | |
| 5275 | 7016 octave_idx_type info; |
| 5164 | 7017 double rcond; |
| 7018 return solve (b, info, rcond, 0); | |
| 7019 } | |
| 7020 | |
| 7021 SparseComplexMatrix | |
| 7022 SparseComplexMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7023 octave_idx_type& info) const |
| 5164 | 7024 { |
| 7025 double rcond; | |
| 7026 return solve (b, info, rcond, 0); | |
| 7027 } | |
| 7028 | |
| 7029 SparseComplexMatrix | |
| 7030 SparseComplexMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7031 octave_idx_type& info, double& rcond) const |
| 5164 | 7032 { |
| 7033 return solve (b, info, rcond, 0); | |
| 7034 } | |
| 7035 | |
| 7036 SparseComplexMatrix | |
| 7037 SparseComplexMatrix::solve (const SparseComplexMatrix& b, | |
| 5275 | 7038 octave_idx_type& err, double& rcond, |
| 5164 | 7039 solve_singularity_handler sing_handler) const |
| 7040 { | |
| 5785 | 7041 MatrixType mattype (*this); |
| 5164 | 7042 return solve (mattype, b, err, rcond, sing_handler); |
| 7043 } | |
| 7044 | |
| 7045 ComplexColumnVector | |
| 7046 SparseComplexMatrix::solve (const ColumnVector& b) const | |
| 7047 { | |
| 5275 | 7048 octave_idx_type info; double rcond; |
| 5164 | 7049 return solve (b, info, rcond); |
| 7050 } | |
| 7051 | |
| 7052 ComplexColumnVector | |
| 5275 | 7053 SparseComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info) const |
| 5164 | 7054 { |
| 7055 double rcond; | |
| 7056 return solve (b, info, rcond); | |
| 7057 } | |
| 7058 | |
| 7059 ComplexColumnVector | |
| 5275 | 7060 SparseComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, |
| 5164 | 7061 double& rcond) const |
| 7062 { | |
| 7063 return solve (b, info, rcond, 0); | |
| 7064 } | |
| 7065 | |
| 7066 ComplexColumnVector | |
| 5275 | 7067 SparseComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, double& rcond, |
| 5164 | 7068 solve_singularity_handler sing_handler) const |
| 7069 { | |
| 7070 Matrix tmp (b); | |
| 5275 | 7071 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7072 } |
| 7073 | |
| 7074 ComplexColumnVector | |
| 7075 SparseComplexMatrix::solve (const ComplexColumnVector& b) const | |
| 7076 { | |
| 5275 | 7077 octave_idx_type info; |
| 5164 | 7078 double rcond; |
| 7079 return solve (b, info, rcond, 0); | |
| 7080 } | |
| 7081 | |
| 7082 ComplexColumnVector | |
| 5275 | 7083 SparseComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const |
| 5164 | 7084 { |
| 7085 double rcond; | |
| 7086 return solve (b, info, rcond, 0); | |
| 7087 } | |
| 7088 | |
| 7089 ComplexColumnVector | |
| 5275 | 7090 SparseComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7091 double& rcond) const |
| 7092 { | |
| 7093 return solve (b, info, rcond, 0); | |
| 7094 } | |
| 7095 | |
| 7096 ComplexColumnVector | |
| 5275 | 7097 SparseComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, |
| 5164 | 7098 double& rcond, |
| 7099 solve_singularity_handler sing_handler) const | |
| 7100 { | |
| 7101 ComplexMatrix tmp (b); | |
| 5275 | 7102 return solve (tmp, info, rcond, sing_handler).column (static_cast<octave_idx_type> (0)); |
| 5164 | 7103 } |
| 7104 | |
| 7105 // unary operations | |
| 7106 SparseBoolMatrix | |
| 7107 SparseComplexMatrix::operator ! (void) const | |
| 7108 { | |
| 5275 | 7109 octave_idx_type nr = rows (); |
| 7110 octave_idx_type nc = cols (); | |
| 5681 | 7111 octave_idx_type nz1 = nnz (); |
| 5275 | 7112 octave_idx_type nz2 = nr*nc - nz1; |
| 5164 | 7113 |
| 7114 SparseBoolMatrix r (nr, nc, nz2); | |
| 7115 | |
| 5275 | 7116 octave_idx_type ii = 0; |
| 7117 octave_idx_type jj = 0; | |
| 5164 | 7118 r.cidx (0) = 0; |
| 5275 | 7119 for (octave_idx_type i = 0; i < nc; i++) |
| 5164 | 7120 { |
| 5275 | 7121 for (octave_idx_type j = 0; j < nr; j++) |
| 5164 | 7122 { |
| 7123 if (jj < cidx(i+1) && ridx(jj) == j) | |
| 7124 jj++; | |
| 7125 else | |
| 7126 { | |
| 7127 r.data(ii) = true; | |
| 7128 r.ridx(ii++) = j; | |
| 7129 } | |
| 7130 } | |
| 7131 r.cidx (i+1) = ii; | |
| 7132 } | |
| 7133 | |
| 7134 return r; | |
| 7135 } | |
| 7136 | |
| 7137 SparseComplexMatrix | |
| 7138 SparseComplexMatrix::squeeze (void) const | |
| 7139 { | |
| 7140 return MSparse<Complex>::squeeze (); | |
| 7141 } | |
| 7142 | |
| 7143 SparseComplexMatrix | |
| 7144 SparseComplexMatrix::index (idx_vector& i, int resize_ok) const | |
| 7145 { | |
| 7146 return MSparse<Complex>::index (i, resize_ok); | |
| 7147 } | |
| 7148 | |
| 7149 SparseComplexMatrix | |
| 7150 SparseComplexMatrix::index (idx_vector& i, idx_vector& j, int resize_ok) const | |
| 7151 { | |
| 7152 return MSparse<Complex>::index (i, j, resize_ok); | |
| 7153 } | |
| 7154 | |
| 7155 SparseComplexMatrix | |
| 7156 SparseComplexMatrix::index (Array<idx_vector>& ra_idx, int resize_ok) const | |
| 7157 { | |
| 7158 return MSparse<Complex>::index (ra_idx, resize_ok); | |
| 7159 } | |
| 7160 SparseComplexMatrix | |
| 7161 SparseComplexMatrix::reshape (const dim_vector& new_dims) const | |
| 7162 { | |
| 7163 return MSparse<Complex>::reshape (new_dims); | |
| 7164 } | |
| 7165 | |
| 7166 SparseComplexMatrix | |
| 5275 | 7167 SparseComplexMatrix::permute (const Array<octave_idx_type>& vec, bool inv) const |
| 5164 | 7168 { |
| 7169 return MSparse<Complex>::permute (vec, inv); | |
| 7170 } | |
| 7171 | |
| 7172 SparseComplexMatrix | |
| 5275 | 7173 SparseComplexMatrix::ipermute (const Array<octave_idx_type>& vec) const |
| 5164 | 7174 { |
| 7175 return MSparse<Complex>::ipermute (vec); | |
| 7176 } | |
| 7177 | |
| 7178 // other operations | |
| 7179 | |
| 7180 bool | |
| 7181 SparseComplexMatrix::any_element_is_inf_or_nan (void) const | |
| 7182 { | |
| 5681 | 7183 octave_idx_type nel = nnz (); |
| 5275 | 7184 |
| 7185 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7186 { |
| 7187 Complex val = data (i); | |
| 7188 if (xisinf (val) || xisnan (val)) | |
| 7189 return true; | |
| 7190 } | |
| 7191 | |
| 7192 return false; | |
| 7193 } | |
| 7194 | |
| 7195 // Return true if no elements have imaginary components. | |
| 7196 | |
| 7197 bool | |
| 7198 SparseComplexMatrix::all_elements_are_real (void) const | |
| 7199 { | |
| 5681 | 7200 octave_idx_type nel = nnz (); |
| 5275 | 7201 |
| 7202 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7203 { |
| 5261 | 7204 double ip = std::imag (data (i)); |
| 5164 | 7205 |
| 7206 if (ip != 0.0 || lo_ieee_signbit (ip)) | |
| 7207 return false; | |
| 7208 } | |
| 7209 | |
| 7210 return true; | |
| 7211 } | |
| 7212 | |
| 7213 // Return nonzero if any element of CM has a non-integer real or | |
| 7214 // imaginary part. Also extract the largest and smallest (real or | |
| 7215 // imaginary) values and return them in MAX_VAL and MIN_VAL. | |
| 7216 | |
| 7217 bool | |
| 7218 SparseComplexMatrix::all_integers (double& max_val, double& min_val) const | |
| 7219 { | |
| 5681 | 7220 octave_idx_type nel = nnz (); |
| 5164 | 7221 |
| 7222 if (nel == 0) | |
| 7223 return false; | |
| 7224 | |
| 5261 | 7225 max_val = std::real(data (0)); |
| 7226 min_val = std::real(data (0)); | |
| 5164 | 7227 |
| 5275 | 7228 for (octave_idx_type i = 0; i < nel; i++) |
| 5164 | 7229 { |
| 7230 Complex val = data (i); | |
| 7231 | |
| 5261 | 7232 double r_val = std::real (val); |
| 7233 double i_val = std::imag (val); | |
| 5164 | 7234 |
| 7235 if (r_val > max_val) | |
| 7236 max_val = r_val; | |
| 7237 | |
| 7238 if (i_val > max_val) | |
| 7239 max_val = i_val; | |
| 7240 | |
| 7241 if (r_val < min_val) | |
| 7242 min_val = r_val; | |
| 7243 | |
| 7244 if (i_val < min_val) | |
| 7245 min_val = i_val; | |
| 7246 | |
| 7247 if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val) | |
| 7248 return false; | |
| 7249 } | |
| 7250 | |
| 7251 return true; | |
| 7252 } | |
| 7253 | |
| 7254 bool | |
| 7255 SparseComplexMatrix::too_large_for_float (void) const | |
| 7256 { | |
| 5681 | 7257 octave_idx_type nel = nnz (); |
| 5275 | 7258 |
| 7259 for (octave_idx_type i = 0; i < nel; i++) | |
| 5164 | 7260 { |
| 7261 Complex val = data (i); | |
| 7262 | |
| 5261 | 7263 double r_val = std::real (val); |
| 7264 double i_val = std::imag (val); | |
| 5164 | 7265 |
| 7266 if (r_val > FLT_MAX | |
| 7267 || i_val > FLT_MAX | |
| 7268 || r_val < FLT_MIN | |
| 7269 || i_val < FLT_MIN) | |
| 7270 return true; | |
| 7271 } | |
| 7272 | |
| 7273 return false; | |
| 7274 } | |
| 7275 | |
| 5775 | 7276 // FIXME Do these really belong here? Maybe they should be |
| 5164 | 7277 // in a base class? |
| 7278 | |
| 7279 SparseBoolMatrix | |
| 7280 SparseComplexMatrix::all (int dim) const | |
| 7281 { | |
| 7282 SPARSE_ALL_OP (dim); | |
| 7283 } | |
| 7284 | |
| 7285 SparseBoolMatrix | |
| 7286 SparseComplexMatrix::any (int dim) const | |
| 7287 { | |
| 7288 SPARSE_ANY_OP (dim); | |
| 7289 } | |
| 7290 | |
| 7291 SparseComplexMatrix | |
| 7292 SparseComplexMatrix::cumprod (int dim) const | |
| 7293 { | |
| 7294 SPARSE_CUMPROD (SparseComplexMatrix, Complex, cumprod); | |
| 7295 } | |
| 7296 | |
| 7297 SparseComplexMatrix | |
| 7298 SparseComplexMatrix::cumsum (int dim) const | |
| 7299 { | |
| 7300 SPARSE_CUMSUM (SparseComplexMatrix, Complex, cumsum); | |
| 7301 } | |
| 7302 | |
| 7303 SparseComplexMatrix | |
| 7304 SparseComplexMatrix::prod (int dim) const | |
| 7305 { | |
| 7269 | 7306 if ((rows() == 1 && dim == -1) || dim == 1) |
| 7307 return transpose (). prod (0). transpose(); | |
| 7308 else | |
| 7309 { | |
| 7310 SPARSE_REDUCTION_OP (SparseComplexMatrix, Complex, *=, | |
| 7311 (cidx(j+1) - cidx(j) < nc ? 0.0 : 1.0), 1.0); | |
| 7312 } | |
| 5164 | 7313 } |
| 7314 | |
| 7315 SparseComplexMatrix | |
| 7316 SparseComplexMatrix::sum (int dim) const | |
| 7317 { | |
| 7318 SPARSE_REDUCTION_OP (SparseComplexMatrix, Complex, +=, 0.0, 0.0); | |
| 7319 } | |
| 7320 | |
| 7321 SparseComplexMatrix | |
| 7322 SparseComplexMatrix::sumsq (int dim) const | |
| 7323 { | |
| 7324 #define ROW_EXPR \ | |
| 7269 | 7325 Complex d = data (i); \ |
| 7326 tmp [ridx(i)] += d * conj (d) | |
| 5164 | 7327 |
| 7328 #define COL_EXPR \ | |
| 7269 | 7329 Complex d = data (i); \ |
| 5164 | 7330 tmp [j] += d * conj (d) |
| 7331 | |
| 7332 SPARSE_BASE_REDUCTION_OP (SparseComplexMatrix, Complex, ROW_EXPR, | |
| 7333 COL_EXPR, 0.0, 0.0); | |
| 7334 | |
| 7335 #undef ROW_EXPR | |
| 7336 #undef COL_EXPR | |
| 7337 } | |
| 7338 | |
| 7339 SparseMatrix SparseComplexMatrix::abs (void) const | |
| 7340 { | |
| 5681 | 7341 octave_idx_type nz = nnz (); |
| 5275 | 7342 octave_idx_type nc = cols (); |
| 5164 | 7343 |
| 7344 SparseMatrix retval (rows(), nc, nz); | |
| 7345 | |
| 5275 | 7346 for (octave_idx_type i = 0; i < nc + 1; i++) |
| 5164 | 7347 retval.cidx (i) = cidx (i); |
| 7348 | |
| 5275 | 7349 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7350 { |
| 5261 | 7351 retval.data (i) = std::abs (data (i)); |
| 5164 | 7352 retval.ridx (i) = ridx (i); |
| 7353 } | |
| 7354 | |
| 7355 return retval; | |
| 7356 } | |
| 7357 | |
| 7358 SparseComplexMatrix | |
| 5275 | 7359 SparseComplexMatrix::diag (octave_idx_type k) const |
| 5164 | 7360 { |
| 5275 | 7361 octave_idx_type nnr = rows (); |
| 7362 octave_idx_type nnc = cols (); | |
| 5164 | 7363 |
| 7364 if (k > 0) | |
| 7365 nnc -= k; | |
| 7366 else if (k < 0) | |
| 7367 nnr += k; | |
| 7368 | |
| 7369 SparseComplexMatrix d; | |
| 7370 | |
| 7371 if (nnr > 0 && nnc > 0) | |
| 7372 { | |
| 5275 | 7373 octave_idx_type ndiag = (nnr < nnc) ? nnr : nnc; |
| 5164 | 7374 |
| 7375 // Count the number of non-zero elements | |
| 5275 | 7376 octave_idx_type nel = 0; |
| 5164 | 7377 if (k > 0) |
| 7378 { | |
| 5275 | 7379 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7380 if (elem (i, i+k) != 0.) |
| 7381 nel++; | |
| 7382 } | |
| 7383 else if ( k < 0) | |
| 7384 { | |
| 5275 | 7385 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7386 if (elem (i-k, i) != 0.) |
| 7387 nel++; | |
| 7388 } | |
| 7389 else | |
| 7390 { | |
| 5275 | 7391 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7392 if (elem (i, i) != 0.) |
| 7393 nel++; | |
| 7394 } | |
| 7395 | |
| 7396 d = SparseComplexMatrix (ndiag, 1, nel); | |
| 7397 d.xcidx (0) = 0; | |
| 7398 d.xcidx (1) = nel; | |
| 7399 | |
| 5275 | 7400 octave_idx_type ii = 0; |
| 5164 | 7401 if (k > 0) |
| 7402 { | |
| 5275 | 7403 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7404 { |
| 7405 Complex tmp = elem (i, i+k); | |
| 7406 if (tmp != 0.) | |
| 7407 { | |
| 7408 d.xdata (ii) = tmp; | |
| 7409 d.xridx (ii++) = i; | |
| 7410 } | |
| 7411 } | |
| 7412 } | |
| 7413 else if ( k < 0) | |
| 7414 { | |
| 5275 | 7415 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7416 { |
| 7417 Complex tmp = elem (i-k, i); | |
| 7418 if (tmp != 0.) | |
| 7419 { | |
| 7420 d.xdata (ii) = tmp; | |
| 7421 d.xridx (ii++) = i; | |
| 7422 } | |
| 7423 } | |
| 7424 } | |
| 7425 else | |
| 7426 { | |
| 5275 | 7427 for (octave_idx_type i = 0; i < ndiag; i++) |
| 5164 | 7428 { |
| 7429 Complex tmp = elem (i, i); | |
| 7430 if (tmp != 0.) | |
| 7431 { | |
| 7432 d.xdata (ii) = tmp; | |
| 7433 d.xridx (ii++) = i; | |
| 7434 } | |
| 7435 } | |
| 7436 } | |
| 7437 } | |
| 7438 else | |
| 7439 (*current_liboctave_error_handler) | |
| 7440 ("diag: requested diagonal out of range"); | |
| 7441 | |
| 7442 return d; | |
| 7443 } | |
| 7444 | |
|
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7445 SparseMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7446 SparseComplexMatrix::map (dmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7447 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7448 SparseMatrix result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7449 double f_zero = fcn (0.); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7450 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7451 if (f_zero != 0.) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7452 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7453 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7454 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7455 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7456 result = SparseMatrix (nr, nc, f_zero); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7457 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7458 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7459 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7460 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7461 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7462 /* Use data instead of elem for better performance. */ |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7463 result.data (ridx (i) + j * nr) = fcn (data(i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7464 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7465 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7466 result.maybe_compress (true); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7467 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7468 else |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7469 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7470 octave_idx_type nz = nnz (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7471 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7472 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7473 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7474 result = SparseMatrix (nr, nc, nz); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7475 octave_idx_type ii = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7476 result.cidx (ii) = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7477 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7478 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7479 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7480 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7481 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7482 double val = fcn (data (i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7483 if (val != 0.0) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7484 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7485 result.data (ii) = val; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7486 result.ridx (ii++) = ridx (i); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7487 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7488 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7489 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7490 result.cidx (j+1) = ii; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7491 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7492 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7493 result.maybe_compress (false); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7494 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7495 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7496 return result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7497 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7498 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7499 SparseComplexMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7500 SparseComplexMatrix::map (cmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7501 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7502 SparseComplexMatrix result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7503 Complex f_zero = fcn (0.); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7504 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7505 if (f_zero != 0.) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7506 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7507 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7508 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7509 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7510 result = SparseComplexMatrix (nr, nc, f_zero); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7511 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7512 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7513 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7514 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7515 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7516 /* Use data instead of elem for better performance. */ |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7517 result.data (ridx (i) + j * nr) = fcn (data(i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7518 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7519 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7520 result.maybe_compress (true); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7521 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7522 else |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7523 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7524 octave_idx_type nz = nnz (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7525 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7526 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7527 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7528 result = SparseComplexMatrix (nr, nc, nz); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7529 Complex zero = Complex (0.0, 0.0); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7530 octave_idx_type ii = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7531 result.cidx (ii) = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7532 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7533 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7534 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7535 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7536 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7537 Complex val = fcn (data (i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7538 if (val != zero) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7539 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7540 result.data (ii) = val; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7541 result.ridx (ii++) = ridx (i); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7542 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7543 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7544 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7545 result.cidx (j+1) = ii; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7546 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7547 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7548 result.maybe_compress (false); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7549 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7550 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7551 return result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7552 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7553 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7554 SparseBoolMatrix |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7555 SparseComplexMatrix::map (bmapper fcn) const |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7556 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7557 SparseBoolMatrix result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7558 bool f_zero = fcn (0.); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7559 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7560 if (f_zero) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7561 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7562 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7563 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7564 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7565 result = SparseBoolMatrix (nr, nc, f_zero); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7566 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7567 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7568 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7569 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7570 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7571 /* Use data instead of elem for better performance. */ |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7572 result.data (ridx (i) + j * nr) = fcn (data(i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7573 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7574 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7575 result.maybe_compress (true); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7576 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7577 else |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7578 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7579 octave_idx_type nz = nnz (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7580 octave_idx_type nr = rows (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7581 octave_idx_type nc = cols (); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7582 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7583 result = SparseBoolMatrix (nr, nc, nz); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7584 octave_idx_type ii = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7585 result.cidx (ii) = 0; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7586 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7587 for (octave_idx_type j = 0; j < nc; j++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7588 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7589 for (octave_idx_type i = cidx(j); i < cidx (j+1); i++) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7590 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7591 bool val = fcn (data (i)); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7592 if (val) |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7593 { |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7594 result.data (ii) = val; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7595 result.ridx (ii++) = ridx (i); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7596 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7597 OCTAVE_QUIT; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7598 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7599 result.cidx (j+1) = ii; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7600 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7601 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7602 result.maybe_compress (false); |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7603 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7604 |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7605 return result; |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7606 } |
|
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7482
diff
changeset
|
7607 |
| 5164 | 7608 std::ostream& |
| 7609 operator << (std::ostream& os, const SparseComplexMatrix& a) | |
| 7610 { | |
| 5275 | 7611 octave_idx_type nc = a.cols (); |
| 5164 | 7612 |
| 7613 // add one to the printed indices to go from | |
| 7614 // zero-based to one-based arrays | |
| 5275 | 7615 for (octave_idx_type j = 0; j < nc; j++) { |
| 5164 | 7616 OCTAVE_QUIT; |
| 5275 | 7617 for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) { |
| 5164 | 7618 os << a.ridx(i) + 1 << " " << j + 1 << " "; |
| 7619 octave_write_complex (os, a.data(i)); | |
| 7620 os << "\n"; | |
| 7621 } | |
| 7622 } | |
| 7623 | |
| 7624 return os; | |
| 7625 } | |
| 7626 | |
| 7627 std::istream& | |
| 7628 operator >> (std::istream& is, SparseComplexMatrix& a) | |
| 7629 { | |
| 5275 | 7630 octave_idx_type nr = a.rows (); |
| 7631 octave_idx_type nc = a.cols (); | |
| 5604 | 7632 octave_idx_type nz = a.nzmax (); |
| 5164 | 7633 |
| 7634 if (nr < 1 || nc < 1) | |
| 7635 is.clear (std::ios::badbit); | |
| 7636 else | |
| 7637 { | |
| 5275 | 7638 octave_idx_type itmp, jtmp, jold = 0; |
| 5164 | 7639 Complex tmp; |
| 5275 | 7640 octave_idx_type ii = 0; |
| 5164 | 7641 |
| 7642 a.cidx (0) = 0; | |
| 5275 | 7643 for (octave_idx_type i = 0; i < nz; i++) |
| 5164 | 7644 { |
| 7645 is >> itmp; | |
| 7646 itmp--; | |
| 7647 is >> jtmp; | |
| 7648 jtmp--; | |
| 7649 tmp = octave_read_complex (is); | |
| 7650 | |
| 7651 if (is) | |
| 7652 { | |
| 7653 if (jold != jtmp) | |
| 7654 { | |
| 5275 | 7655 for (octave_idx_type j = jold; j < jtmp; j++) |
| 5164 | 7656 a.cidx(j+1) = ii; |
| 7657 | |
| 7658 jold = jtmp; | |
| 7659 } | |
| 7660 a.data (ii) = tmp; | |
| 7661 a.ridx (ii++) = itmp; | |
| 7662 } | |
| 7663 else | |
| 7664 goto done; | |
| 7665 } | |
| 7666 | |
| 5275 | 7667 for (octave_idx_type j = jold; j < nc; j++) |
| 5164 | 7668 a.cidx(j+1) = ii; |
| 7669 } | |
| 7670 | |
| 7671 done: | |
| 7672 | |
| 7673 return is; | |
| 7674 } | |
| 7675 | |
| 7676 SparseComplexMatrix | |
| 7677 operator * (const SparseComplexMatrix& m, const SparseMatrix& a) | |
| 7678 { | |
| 5681 | 7679 SPARSE_SPARSE_MUL (SparseComplexMatrix, Complex, double); |
| 5164 | 7680 } |
| 7681 | |
| 7682 SparseComplexMatrix | |
| 7683 operator * (const SparseMatrix& m, const SparseComplexMatrix& a) | |
| 7684 { | |
| 5681 | 7685 SPARSE_SPARSE_MUL (SparseComplexMatrix, Complex, Complex); |
| 5164 | 7686 } |
| 7687 | |
| 7688 SparseComplexMatrix | |
| 7689 operator * (const SparseComplexMatrix& m, const SparseComplexMatrix& a) | |
| 7690 { | |
| 5681 | 7691 SPARSE_SPARSE_MUL (SparseComplexMatrix, Complex, Complex); |
| 5164 | 7692 } |
| 7693 | |
| 5429 | 7694 ComplexMatrix |
| 7695 operator * (const ComplexMatrix& m, const SparseMatrix& a) | |
| 7696 { | |
| 5681 | 7697 FULL_SPARSE_MUL (ComplexMatrix, double, Complex (0.,0.)); |
| 5429 | 7698 } |
| 7699 | |
| 7700 ComplexMatrix | |
| 7701 operator * (const Matrix& m, const SparseComplexMatrix& a) | |
| 7702 { | |
| 5681 | 7703 FULL_SPARSE_MUL (ComplexMatrix, Complex, Complex (0.,0.)); |
| 5429 | 7704 } |
| 7705 | |
| 7706 ComplexMatrix | |
| 7707 operator * (const ComplexMatrix& m, const SparseComplexMatrix& a) | |
| 7708 { | |
| 5681 | 7709 FULL_SPARSE_MUL (ComplexMatrix, Complex, Complex (0.,0.)); |
| 5429 | 7710 } |
| 7711 | |
| 7712 ComplexMatrix | |
| 7713 operator * (const SparseComplexMatrix& m, const Matrix& a) | |
| 7714 { | |
| 5681 | 7715 SPARSE_FULL_MUL (ComplexMatrix, double, Complex (0.,0.)); |
| 5429 | 7716 } |
| 7717 | |
| 7718 ComplexMatrix | |
| 7719 operator * (const SparseMatrix& m, const ComplexMatrix& a) | |
| 7720 { | |
| 5681 | 7721 SPARSE_FULL_MUL (ComplexMatrix, Complex, Complex (0.,0.)); |
| 5429 | 7722 } |
| 7723 | |
| 7724 ComplexMatrix | |
| 7725 operator * (const SparseComplexMatrix& m, const ComplexMatrix& a) | |
| 7726 { | |
| 5681 | 7727 SPARSE_FULL_MUL (ComplexMatrix, Complex, Complex (0.,0.)); |
| 5429 | 7728 } |
| 7729 | |
| 5775 | 7730 // FIXME -- it would be nice to share code among the min/max |
| 5164 | 7731 // functions below. |
| 7732 | |
| 7733 #define EMPTY_RETURN_CHECK(T) \ | |
| 7734 if (nr == 0 || nc == 0) \ | |
| 7735 return T (nr, nc); | |
| 7736 | |
| 7737 SparseComplexMatrix | |
| 7738 min (const Complex& c, const SparseComplexMatrix& m) | |
| 7739 { | |
| 7740 SparseComplexMatrix result; | |
| 7741 | |
| 5275 | 7742 octave_idx_type nr = m.rows (); |
| 7743 octave_idx_type nc = m.columns (); | |
| 5164 | 7744 |
| 7745 EMPTY_RETURN_CHECK (SparseComplexMatrix); | |
| 7746 | |
| 7747 if (abs(c) == 0.) | |
| 7748 return SparseComplexMatrix (nr, nc); | |
| 7749 else | |
| 7750 { | |
| 7751 result = SparseComplexMatrix (m); | |
| 7752 | |
| 5275 | 7753 for (octave_idx_type j = 0; j < nc; j++) |
| 7754 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7755 result.data(i) = xmin(c, m.data(i)); |
| 7756 } | |
| 7757 | |
| 7758 return result; | |
| 7759 } | |
| 7760 | |
| 7761 SparseComplexMatrix | |
| 7762 min (const SparseComplexMatrix& m, const Complex& c) | |
| 7763 { | |
| 7764 return min (c, m); | |
| 7765 } | |
| 7766 | |
| 7767 SparseComplexMatrix | |
| 7768 min (const SparseComplexMatrix& a, const SparseComplexMatrix& b) | |
| 7769 { | |
| 7770 SparseComplexMatrix r; | |
| 7771 | |
| 7772 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 7773 { | |
| 5275 | 7774 octave_idx_type a_nr = a.rows (); |
| 7775 octave_idx_type a_nc = a.cols (); | |
| 7776 | |
| 7777 octave_idx_type b_nr = b.rows (); | |
| 7778 octave_idx_type b_nc = b.cols (); | |
| 5164 | 7779 |
| 5681 | 7780 if (a_nr == 0 || b_nc == 0 || a.nnz () == 0 || b.nnz () == 0) |
| 5164 | 7781 return SparseComplexMatrix (a_nr, a_nc); |
| 7782 | |
| 7783 if (a_nr != b_nr || a_nc != b_nc) | |
| 7784 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 7785 else | |
| 7786 { | |
| 5681 | 7787 r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 7788 |
| 5275 | 7789 octave_idx_type jx = 0; |
| 5164 | 7790 r.cidx (0) = 0; |
| 5275 | 7791 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 7792 { |
| 5275 | 7793 octave_idx_type ja = a.cidx(i); |
| 7794 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 7795 bool ja_lt_max= ja < ja_max; |
| 7796 | |
| 5275 | 7797 octave_idx_type jb = b.cidx(i); |
| 7798 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 7799 bool jb_lt_max = jb < jb_max; |
| 7800 | |
| 7801 while (ja_lt_max || jb_lt_max ) | |
| 7802 { | |
| 7803 OCTAVE_QUIT; | |
| 7804 if ((! jb_lt_max) || | |
| 7805 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 7806 { | |
| 7807 Complex tmp = xmin (a.data(ja), 0.); | |
| 7808 if (tmp != 0.) | |
| 7809 { | |
| 7810 r.ridx(jx) = a.ridx(ja); | |
| 7811 r.data(jx) = tmp; | |
| 7812 jx++; | |
| 7813 } | |
| 7814 ja++; | |
| 7815 ja_lt_max= ja < ja_max; | |
| 7816 } | |
| 7817 else if (( !ja_lt_max ) || | |
| 7818 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 7819 { | |
| 7820 Complex tmp = xmin (0., b.data(jb)); | |
| 7821 if (tmp != 0.) | |
| 7822 { | |
| 7823 r.ridx(jx) = b.ridx(jb); | |
| 7824 r.data(jx) = tmp; | |
| 7825 jx++; | |
| 7826 } | |
| 7827 jb++; | |
| 7828 jb_lt_max= jb < jb_max; | |
| 7829 } | |
| 7830 else | |
| 7831 { | |
| 7832 Complex tmp = xmin (a.data(ja), b.data(jb)); | |
| 7833 if (tmp != 0.) | |
| 7834 { | |
| 7835 r.data(jx) = tmp; | |
| 7836 r.ridx(jx) = a.ridx(ja); | |
| 7837 jx++; | |
| 7838 } | |
| 7839 ja++; | |
| 7840 ja_lt_max= ja < ja_max; | |
| 7841 jb++; | |
| 7842 jb_lt_max= jb < jb_max; | |
| 7843 } | |
| 7844 } | |
| 7845 r.cidx(i+1) = jx; | |
| 7846 } | |
| 7847 | |
| 7848 r.maybe_compress (); | |
| 7849 } | |
| 7850 } | |
| 7851 else | |
| 7852 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 7853 | |
| 7854 return r; | |
| 7855 } | |
| 7856 | |
| 7857 SparseComplexMatrix | |
| 7858 max (const Complex& c, const SparseComplexMatrix& m) | |
| 7859 { | |
| 7860 SparseComplexMatrix result; | |
| 7861 | |
| 5275 | 7862 octave_idx_type nr = m.rows (); |
| 7863 octave_idx_type nc = m.columns (); | |
| 5164 | 7864 |
| 7865 EMPTY_RETURN_CHECK (SparseComplexMatrix); | |
| 7866 | |
| 7867 // Count the number of non-zero elements | |
| 7868 if (xmax(c, 0.) != 0.) | |
| 7869 { | |
| 7870 result = SparseComplexMatrix (nr, nc, c); | |
| 5275 | 7871 for (octave_idx_type j = 0; j < nc; j++) |
| 7872 for (octave_idx_type i = m.cidx(j); i < m.cidx(j+1); i++) | |
| 5164 | 7873 result.xdata(m.ridx(i) + j * nr) = xmax (c, m.data(i)); |
| 7874 } | |
| 7875 else | |
| 7876 result = SparseComplexMatrix (m); | |
| 7877 | |
| 7878 return result; | |
| 7879 } | |
| 7880 | |
| 7881 SparseComplexMatrix | |
| 7882 max (const SparseComplexMatrix& m, const Complex& c) | |
| 7883 { | |
| 7884 return max (c, m); | |
| 7885 } | |
| 7886 | |
| 7887 SparseComplexMatrix | |
| 7888 max (const SparseComplexMatrix& a, const SparseComplexMatrix& b) | |
| 7889 { | |
| 7890 SparseComplexMatrix r; | |
| 7891 | |
| 7892 if ((a.rows() == b.rows()) && (a.cols() == b.cols())) | |
| 7893 { | |
| 5275 | 7894 octave_idx_type a_nr = a.rows (); |
| 7895 octave_idx_type a_nc = a.cols (); | |
| 7896 | |
| 7897 octave_idx_type b_nr = b.rows (); | |
| 7898 octave_idx_type b_nc = b.cols (); | |
| 5164 | 7899 |
| 7900 if (a_nr == 0 || b_nc == 0) | |
| 7901 return SparseComplexMatrix (a_nr, a_nc); | |
| 5681 | 7902 if (a.nnz () == 0) |
| 5164 | 7903 return SparseComplexMatrix (b); |
| 5681 | 7904 if (b.nnz () == 0) |
| 5164 | 7905 return SparseComplexMatrix (a); |
| 7906 | |
| 7907 if (a_nr != b_nr || a_nc != b_nc) | |
| 7908 gripe_nonconformant ("min", a_nr, a_nc, b_nr, b_nc); | |
| 7909 else | |
| 7910 { | |
| 5681 | 7911 r = SparseComplexMatrix (a_nr, a_nc, (a.nnz () + b.nnz ())); |
| 5164 | 7912 |
| 5275 | 7913 octave_idx_type jx = 0; |
| 5164 | 7914 r.cidx (0) = 0; |
| 5275 | 7915 for (octave_idx_type i = 0 ; i < a_nc ; i++) |
| 5164 | 7916 { |
| 5275 | 7917 octave_idx_type ja = a.cidx(i); |
| 7918 octave_idx_type ja_max = a.cidx(i+1); | |
| 5164 | 7919 bool ja_lt_max= ja < ja_max; |
| 7920 | |
| 5275 | 7921 octave_idx_type jb = b.cidx(i); |
| 7922 octave_idx_type jb_max = b.cidx(i+1); | |
| 5164 | 7923 bool jb_lt_max = jb < jb_max; |
| 7924 | |
| 7925 while (ja_lt_max || jb_lt_max ) | |
| 7926 { | |
| 7927 OCTAVE_QUIT; | |
| 7928 if ((! jb_lt_max) || | |
| 7929 (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) | |
| 7930 { | |
| 7931 Complex tmp = xmax (a.data(ja), 0.); | |
| 7932 if (tmp != 0.) | |
| 7933 { | |
| 7934 r.ridx(jx) = a.ridx(ja); | |
| 7935 r.data(jx) = tmp; | |
| 7936 jx++; | |
| 7937 } | |
| 7938 ja++; | |
| 7939 ja_lt_max= ja < ja_max; | |
| 7940 } | |
| 7941 else if (( !ja_lt_max ) || | |
| 7942 (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) | |
| 7943 { | |
| 7944 Complex tmp = xmax (0., b.data(jb)); | |
| 7945 if (tmp != 0.) | |
| 7946 { | |
| 7947 r.ridx(jx) = b.ridx(jb); | |
| 7948 r.data(jx) = tmp; | |
| 7949 jx++; | |
| 7950 } | |
| 7951 jb++; | |
| 7952 jb_lt_max= jb < jb_max; | |
| 7953 } | |
| 7954 else | |
| 7955 { | |
| 7956 Complex tmp = xmax (a.data(ja), b.data(jb)); | |
| 7957 if (tmp != 0.) | |
| 7958 { | |
| 7959 r.data(jx) = tmp; | |
| 7960 r.ridx(jx) = a.ridx(ja); | |
| 7961 jx++; | |
| 7962 } | |
| 7963 ja++; | |
| 7964 ja_lt_max= ja < ja_max; | |
| 7965 jb++; | |
| 7966 jb_lt_max= jb < jb_max; | |
| 7967 } | |
| 7968 } | |
| 7969 r.cidx(i+1) = jx; | |
| 7970 } | |
| 7971 | |
| 7972 r.maybe_compress (); | |
| 7973 } | |
| 7974 } | |
| 7975 else | |
| 7976 (*current_liboctave_error_handler) ("matrix size mismatch"); | |
| 7977 | |
| 7978 return r; | |
| 7979 } | |
| 7980 | |
| 7981 SPARSE_SMS_CMP_OPS (SparseComplexMatrix, 0.0, real, Complex, | |
| 7982 0.0, real) | |
| 7983 SPARSE_SMS_BOOL_OPS (SparseComplexMatrix, Complex, 0.0) | |
| 7984 | |
| 7985 SPARSE_SSM_CMP_OPS (Complex, 0.0, real, SparseComplexMatrix, | |
| 7986 0.0, real) | |
| 7987 SPARSE_SSM_BOOL_OPS (Complex, SparseComplexMatrix, 0.0) | |
| 7988 | |
| 7989 SPARSE_SMSM_CMP_OPS (SparseComplexMatrix, 0.0, real, SparseComplexMatrix, | |
| 7990 0.0, real) | |
| 7991 SPARSE_SMSM_BOOL_OPS (SparseComplexMatrix, SparseComplexMatrix, 0.0) | |
| 7992 | |
| 7993 /* | |
| 7994 ;;; Local Variables: *** | |
| 7995 ;;; mode: C++ *** | |
| 7996 ;;; End: *** | |
| 7997 */ |