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