00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026 #ifdef HAVE_CONFIG_H
00027 #include <config.h>
00028 #endif
00029
00030 #include <cfloat>
00031
00032 #include <iostream>
00033 #include <vector>
00034
00035
00036 #include <sys/types.h>
00037
00038 #include "Array-util.h"
00039 #include "CMatrix.h"
00040 #include "CmplxAEPBAL.h"
00041 #include "CmplxCHOL.h"
00042 #include "CmplxSCHUR.h"
00043 #include "CmplxSVD.h"
00044 #include "DET.h"
00045 #include "f77-fcn.h"
00046 #include "functor.h"
00047 #include "lo-error.h"
00048 #include "lo-ieee.h"
00049 #include "lo-mappers.h"
00050 #include "lo-utils.h"
00051 #include "mx-base.h"
00052 #include "mx-cm-dm.h"
00053 #include "mx-cm-s.h"
00054 #include "mx-dm-cm.h"
00055 #include "mx-inlines.cc"
00056 #include "mx-op-defs.h"
00057 #include "oct-cmplx.h"
00058 #include "oct-fftw.h"
00059 #include "oct-locbuf.h"
00060 #include "oct-norm.h"
00061
00062
00063
00064 extern "C"
00065 {
00066 F77_RET_T
00067 F77_FUNC (xilaenv, XILAENV) (const octave_idx_type&,
00068 F77_CONST_CHAR_ARG_DECL,
00069 F77_CONST_CHAR_ARG_DECL,
00070 const octave_idx_type&, const octave_idx_type&,
00071 const octave_idx_type&, const octave_idx_type&,
00072 octave_idx_type&
00073 F77_CHAR_ARG_LEN_DECL
00074 F77_CHAR_ARG_LEN_DECL);
00075
00076 F77_RET_T
00077 F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL,
00078 const octave_idx_type&, Complex*,
00079 const octave_idx_type&, octave_idx_type&,
00080 octave_idx_type&, double*, octave_idx_type&
00081 F77_CHAR_ARG_LEN_DECL);
00082
00083 F77_RET_T
00084 F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL,
00085 F77_CONST_CHAR_ARG_DECL,
00086 const octave_idx_type&, const octave_idx_type&,
00087 const octave_idx_type&, double*,
00088 const octave_idx_type&, double*,
00089 const octave_idx_type&, octave_idx_type&
00090 F77_CHAR_ARG_LEN_DECL
00091 F77_CHAR_ARG_LEN_DECL);
00092
00093 F77_RET_T
00094 F77_FUNC (zgemm, ZGEMM) (F77_CONST_CHAR_ARG_DECL,
00095 F77_CONST_CHAR_ARG_DECL,
00096 const octave_idx_type&, const octave_idx_type&,
00097 const octave_idx_type&, const Complex&,
00098 const Complex*, const octave_idx_type&,
00099 const Complex*, const octave_idx_type&,
00100 const Complex&, Complex*, const octave_idx_type&
00101 F77_CHAR_ARG_LEN_DECL
00102 F77_CHAR_ARG_LEN_DECL);
00103
00104 F77_RET_T
00105 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL,
00106 const octave_idx_type&, const octave_idx_type&,
00107 const Complex&, const Complex*,
00108 const octave_idx_type&, const Complex*,
00109 const octave_idx_type&, const Complex&,
00110 Complex*, const octave_idx_type&
00111 F77_CHAR_ARG_LEN_DECL);
00112
00113 F77_RET_T
00114 F77_FUNC (xzdotu, XZDOTU) (const octave_idx_type&, const Complex*,
00115 const octave_idx_type&, const Complex*,
00116 const octave_idx_type&, Complex&);
00117
00118 F77_RET_T
00119 F77_FUNC (xzdotc, XZDOTC) (const octave_idx_type&, const Complex*,
00120 const octave_idx_type&, const Complex*,
00121 const octave_idx_type&, Complex&);
00122
00123 F77_RET_T
00124 F77_FUNC (zsyrk, ZSYRK) (F77_CONST_CHAR_ARG_DECL,
00125 F77_CONST_CHAR_ARG_DECL,
00126 const octave_idx_type&, const octave_idx_type&,
00127 const Complex&, const Complex*,
00128 const octave_idx_type&, const Complex&,
00129 Complex*, const octave_idx_type&
00130 F77_CHAR_ARG_LEN_DECL
00131 F77_CHAR_ARG_LEN_DECL);
00132
00133 F77_RET_T
00134 F77_FUNC (zherk, ZHERK) (F77_CONST_CHAR_ARG_DECL,
00135 F77_CONST_CHAR_ARG_DECL,
00136 const octave_idx_type&, const octave_idx_type&,
00137 const double&, const Complex*,
00138 const octave_idx_type&, const double&, Complex*,
00139 const octave_idx_type&
00140 F77_CHAR_ARG_LEN_DECL
00141 F77_CHAR_ARG_LEN_DECL);
00142
00143 F77_RET_T
00144 F77_FUNC (zgetrf, ZGETRF) (const octave_idx_type&, const octave_idx_type&,
00145 Complex*, const octave_idx_type&,
00146 octave_idx_type*, octave_idx_type&);
00147
00148 F77_RET_T
00149 F77_FUNC (zgetrs, ZGETRS) (F77_CONST_CHAR_ARG_DECL,
00150 const octave_idx_type&, const octave_idx_type&,
00151 Complex*, const octave_idx_type&,
00152 const octave_idx_type*, Complex*,
00153 const octave_idx_type&, octave_idx_type&
00154 F77_CHAR_ARG_LEN_DECL);
00155
00156 F77_RET_T
00157 F77_FUNC (zgetri, ZGETRI) (const octave_idx_type&, Complex*,
00158 const octave_idx_type&, const octave_idx_type*,
00159 Complex*, const octave_idx_type&,
00160 octave_idx_type&);
00161
00162 F77_RET_T
00163 F77_FUNC (zgecon, ZGECON) (F77_CONST_CHAR_ARG_DECL,
00164 const octave_idx_type&, Complex*,
00165 const octave_idx_type&, const double&, double&,
00166 Complex*, double*, octave_idx_type&
00167 F77_CHAR_ARG_LEN_DECL);
00168
00169 F77_RET_T
00170 F77_FUNC (zgelsy, ZGELSY) (const octave_idx_type&, const octave_idx_type&,
00171 const octave_idx_type&, Complex*,
00172 const octave_idx_type&, Complex*,
00173 const octave_idx_type&, octave_idx_type*,
00174 double&, octave_idx_type&, Complex*,
00175 const octave_idx_type&, double*,
00176 octave_idx_type&);
00177
00178 F77_RET_T
00179 F77_FUNC (zgelsd, ZGELSD) (const octave_idx_type&, const octave_idx_type&,
00180 const octave_idx_type&, Complex*,
00181 const octave_idx_type&, Complex*,
00182 const octave_idx_type&, double*, double&,
00183 octave_idx_type&, Complex*,
00184 const octave_idx_type&, double*,
00185 octave_idx_type*, octave_idx_type&);
00186
00187 F77_RET_T
00188 F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL,
00189 const octave_idx_type&, Complex*,
00190 const octave_idx_type&, octave_idx_type&
00191 F77_CHAR_ARG_LEN_DECL);
00192
00193 F77_RET_T
00194 F77_FUNC (zpocon, ZPOCON) (F77_CONST_CHAR_ARG_DECL,
00195 const octave_idx_type&, Complex*,
00196 const octave_idx_type&, const double&,
00197 double&, Complex*, double*, octave_idx_type&
00198 F77_CHAR_ARG_LEN_DECL);
00199
00200 F77_RET_T
00201 F77_FUNC (zpotrs, ZPOTRS) (F77_CONST_CHAR_ARG_DECL,
00202 const octave_idx_type&, const octave_idx_type&,
00203 const Complex*, const octave_idx_type&, Complex*,
00204 const octave_idx_type&, octave_idx_type&
00205 F77_CHAR_ARG_LEN_DECL);
00206
00207 F77_RET_T
00208 F77_FUNC (ztrtri, ZTRTRI) (F77_CONST_CHAR_ARG_DECL,
00209 F77_CONST_CHAR_ARG_DECL,
00210 const octave_idx_type&, const Complex*,
00211 const octave_idx_type&, octave_idx_type&
00212 F77_CHAR_ARG_LEN_DECL
00213 F77_CHAR_ARG_LEN_DECL);
00214
00215 F77_RET_T
00216 F77_FUNC (ztrcon, ZTRCON) (F77_CONST_CHAR_ARG_DECL,
00217 F77_CONST_CHAR_ARG_DECL,
00218 F77_CONST_CHAR_ARG_DECL,
00219 const octave_idx_type&, const Complex*,
00220 const octave_idx_type&, double&,
00221 Complex*, double*, octave_idx_type&
00222 F77_CHAR_ARG_LEN_DECL
00223 F77_CHAR_ARG_LEN_DECL
00224 F77_CHAR_ARG_LEN_DECL);
00225
00226 F77_RET_T
00227 F77_FUNC (ztrtrs, ZTRTRS) (F77_CONST_CHAR_ARG_DECL,
00228 F77_CONST_CHAR_ARG_DECL,
00229 F77_CONST_CHAR_ARG_DECL,
00230 const octave_idx_type&, const octave_idx_type&,
00231 const Complex*, const octave_idx_type&, Complex*,
00232 const octave_idx_type&, octave_idx_type&
00233 F77_CHAR_ARG_LEN_DECL
00234 F77_CHAR_ARG_LEN_DECL
00235 F77_CHAR_ARG_LEN_DECL);
00236
00237 F77_RET_T
00238 F77_FUNC (zlartg, ZLARTG) (const Complex&, const Complex&, double&,
00239 Complex&, Complex&);
00240
00241 F77_RET_T
00242 F77_FUNC (ztrsyl, ZTRSYL) (F77_CONST_CHAR_ARG_DECL,
00243 F77_CONST_CHAR_ARG_DECL,
00244 const octave_idx_type&, const octave_idx_type&,
00245 const octave_idx_type&, const Complex*,
00246 const octave_idx_type&, const Complex*,
00247 const octave_idx_type&, const Complex*,
00248 const octave_idx_type&, double&, octave_idx_type&
00249 F77_CHAR_ARG_LEN_DECL
00250 F77_CHAR_ARG_LEN_DECL);
00251
00252 F77_RET_T
00253 F77_FUNC (xzlange, XZLANGE) (F77_CONST_CHAR_ARG_DECL,
00254 const octave_idx_type&, const octave_idx_type&,
00255 const Complex*, const octave_idx_type&,
00256 double*, double&
00257 F77_CHAR_ARG_LEN_DECL);
00258 }
00259
00260 static const Complex Complex_NaN_result (octave_NaN, octave_NaN);
00261
00262
00263
00264 ComplexMatrix::ComplexMatrix (const Matrix& a)
00265 : MArray<Complex> (a)
00266 {
00267 }
00268
00269 ComplexMatrix::ComplexMatrix (const RowVector& rv)
00270 : MArray<Complex> (rv)
00271 {
00272 }
00273
00274 ComplexMatrix::ComplexMatrix (const ColumnVector& cv)
00275 : MArray<Complex> (cv)
00276 {
00277 }
00278
00279 ComplexMatrix::ComplexMatrix (const DiagMatrix& a)
00280 : MArray<Complex> (a.dims (), 0.0)
00281 {
00282 for (octave_idx_type i = 0; i < a.length (); i++)
00283 elem (i, i) = a.elem (i, i);
00284 }
00285
00286 ComplexMatrix::ComplexMatrix (const ComplexRowVector& rv)
00287 : MArray<Complex> (rv)
00288 {
00289 }
00290
00291 ComplexMatrix::ComplexMatrix (const ComplexColumnVector& cv)
00292 : MArray<Complex> (cv)
00293 {
00294 }
00295
00296 ComplexMatrix::ComplexMatrix (const ComplexDiagMatrix& a)
00297 : MArray<Complex> (a.dims (), 0.0)
00298 {
00299 for (octave_idx_type i = 0; i < a.length (); i++)
00300 elem (i, i) = a.elem (i, i);
00301 }
00302
00303
00304
00305
00306 ComplexMatrix::ComplexMatrix (const boolMatrix& a)
00307 : MArray<Complex> (a)
00308 {
00309 }
00310
00311 ComplexMatrix::ComplexMatrix (const charMatrix& a)
00312 : MArray<Complex> (a.dims (), 0.0)
00313 {
00314 for (octave_idx_type i = 0; i < a.rows (); i++)
00315 for (octave_idx_type j = 0; j < a.cols (); j++)
00316 elem (i, j) = static_cast<unsigned char> (a.elem (i, j));
00317 }
00318
00319 ComplexMatrix::ComplexMatrix (const Matrix& re, const Matrix& im)
00320 : MArray<Complex> (re.dims ())
00321 {
00322 if (im.rows () != rows () || im.cols () != cols ())
00323 (*current_liboctave_error_handler) ("complex: internal error");
00324
00325 octave_idx_type nel = numel ();
00326 for (octave_idx_type i = 0; i < nel; i++)
00327 xelem (i) = Complex (re(i), im(i));
00328 }
00329
00330 bool
00331 ComplexMatrix::operator == (const ComplexMatrix& a) const
00332 {
00333 if (rows () != a.rows () || cols () != a.cols ())
00334 return false;
00335
00336 return mx_inline_equal (length (), data (), a.data ());
00337 }
00338
00339 bool
00340 ComplexMatrix::operator != (const ComplexMatrix& a) const
00341 {
00342 return !(*this == a);
00343 }
00344
00345 bool
00346 ComplexMatrix::is_hermitian (void) const
00347 {
00348 octave_idx_type nr = rows ();
00349 octave_idx_type nc = cols ();
00350
00351 if (is_square () && nr > 0)
00352 {
00353 for (octave_idx_type i = 0; i < nr; i++)
00354 for (octave_idx_type j = i; j < nc; j++)
00355 if (elem (i, j) != conj (elem (j, i)))
00356 return false;
00357
00358 return true;
00359 }
00360
00361 return false;
00362 }
00363
00364
00365
00366 ComplexMatrix&
00367 ComplexMatrix::insert (const Matrix& a, octave_idx_type r, octave_idx_type c)
00368 {
00369 octave_idx_type a_nr = a.rows ();
00370 octave_idx_type a_nc = a.cols ();
00371
00372 if (r < 0 || r + a_nr > rows () || c < 0 || c + a_nc > cols ())
00373 {
00374 (*current_liboctave_error_handler) ("range error for insert");
00375 return *this;
00376 }
00377
00378 if (a_nr >0 && a_nc > 0)
00379 {
00380 make_unique ();
00381
00382 for (octave_idx_type j = 0; j < a_nc; j++)
00383 for (octave_idx_type i = 0; i < a_nr; i++)
00384 xelem (r+i, c+j) = a.elem (i, j);
00385 }
00386
00387 return *this;
00388 }
00389
00390 ComplexMatrix&
00391 ComplexMatrix::insert (const RowVector& a, octave_idx_type r, octave_idx_type c)
00392 {
00393 octave_idx_type a_len = a.length ();
00394
00395 if (r < 0 || r >= rows () || c < 0 || c + a_len > cols ())
00396 {
00397 (*current_liboctave_error_handler) ("range error for insert");
00398 return *this;
00399 }
00400
00401 if (a_len > 0)
00402 {
00403 make_unique ();
00404
00405 for (octave_idx_type i = 0; i < a_len; i++)
00406 xelem (r, c+i) = a.elem (i);
00407 }
00408
00409 return *this;
00410 }
00411
00412 ComplexMatrix&
00413 ComplexMatrix::insert (const ColumnVector& a, octave_idx_type r, octave_idx_type c)
00414 {
00415 octave_idx_type a_len = a.length ();
00416
00417 if (r < 0 || r + a_len > rows () || c < 0 || c >= cols ())
00418 {
00419 (*current_liboctave_error_handler) ("range error for insert");
00420 return *this;
00421 }
00422
00423 if (a_len > 0)
00424 {
00425 make_unique ();
00426
00427 for (octave_idx_type i = 0; i < a_len; i++)
00428 xelem (r+i, c) = a.elem (i);
00429 }
00430
00431 return *this;
00432 }
00433
00434 ComplexMatrix&
00435 ComplexMatrix::insert (const DiagMatrix& a, octave_idx_type r, octave_idx_type c)
00436 {
00437 octave_idx_type a_nr = a.rows ();
00438 octave_idx_type a_nc = a.cols ();
00439
00440 if (r < 0 || r + a_nr > rows () || c < 0 || c + a_nc > cols ())
00441 {
00442 (*current_liboctave_error_handler) ("range error for insert");
00443 return *this;
00444 }
00445
00446 fill (0.0, r, c, r + a_nr - 1, c + a_nc - 1);
00447
00448 octave_idx_type a_len = a.length ();
00449
00450 if (a_len > 0)
00451 {
00452 make_unique ();
00453
00454 for (octave_idx_type i = 0; i < a_len; i++)
00455 xelem (r+i, c+i) = a.elem (i, i);
00456 }
00457
00458 return *this;
00459 }
00460
00461 ComplexMatrix&
00462 ComplexMatrix::insert (const ComplexMatrix& a, octave_idx_type r, octave_idx_type c)
00463 {
00464 Array<Complex>::insert (a, r, c);
00465 return *this;
00466 }
00467
00468 ComplexMatrix&
00469 ComplexMatrix::insert (const ComplexRowVector& a, octave_idx_type r, octave_idx_type c)
00470 {
00471 octave_idx_type a_len = a.length ();
00472 if (r < 0 || r >= rows () || c < 0 || c + a_len > cols ())
00473 {
00474 (*current_liboctave_error_handler) ("range error for insert");
00475 return *this;
00476 }
00477
00478 for (octave_idx_type i = 0; i < a_len; i++)
00479 elem (r, c+i) = a.elem (i);
00480
00481 return *this;
00482 }
00483
00484 ComplexMatrix&
00485 ComplexMatrix::insert (const ComplexColumnVector& a, octave_idx_type r, octave_idx_type c)
00486 {
00487 octave_idx_type a_len = a.length ();
00488
00489 if (r < 0 || r + a_len > rows () || c < 0 || c >= cols ())
00490 {
00491 (*current_liboctave_error_handler) ("range error for insert");
00492 return *this;
00493 }
00494
00495 if (a_len > 0)
00496 {
00497 make_unique ();
00498
00499 for (octave_idx_type i = 0; i < a_len; i++)
00500 xelem (r+i, c) = a.elem (i);
00501 }
00502
00503 return *this;
00504 }
00505
00506 ComplexMatrix&
00507 ComplexMatrix::insert (const ComplexDiagMatrix& a, octave_idx_type r, octave_idx_type c)
00508 {
00509 octave_idx_type a_nr = a.rows ();
00510 octave_idx_type a_nc = a.cols ();
00511
00512 if (r < 0 || r + a_nr > rows () || c < 0 || c + a_nc > cols ())
00513 {
00514 (*current_liboctave_error_handler) ("range error for insert");
00515 return *this;
00516 }
00517
00518 fill (0.0, r, c, r + a_nr - 1, c + a_nc - 1);
00519
00520 octave_idx_type a_len = a.length ();
00521
00522 if (a_len > 0)
00523 {
00524 make_unique ();
00525
00526 for (octave_idx_type i = 0; i < a_len; i++)
00527 xelem (r+i, c+i) = a.elem (i, i);
00528 }
00529
00530 return *this;
00531 }
00532
00533 ComplexMatrix&
00534 ComplexMatrix::fill (double val)
00535 {
00536 octave_idx_type nr = rows ();
00537 octave_idx_type nc = cols ();
00538
00539 if (nr > 0 && nc > 0)
00540 {
00541 make_unique ();
00542
00543 for (octave_idx_type j = 0; j < nc; j++)
00544 for (octave_idx_type i = 0; i < nr; i++)
00545 xelem (i, j) = val;
00546 }
00547
00548 return *this;
00549 }
00550
00551 ComplexMatrix&
00552 ComplexMatrix::fill (const Complex& val)
00553 {
00554 octave_idx_type nr = rows ();
00555 octave_idx_type nc = cols ();
00556
00557 if (nr > 0 && nc > 0)
00558 {
00559 make_unique ();
00560
00561 for (octave_idx_type j = 0; j < nc; j++)
00562 for (octave_idx_type i = 0; i < nr; i++)
00563 xelem (i, j) = val;
00564 }
00565
00566 return *this;
00567 }
00568
00569 ComplexMatrix&
00570 ComplexMatrix::fill (double val, octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2)
00571 {
00572 octave_idx_type nr = rows ();
00573 octave_idx_type nc = cols ();
00574
00575 if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0
00576 || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc)
00577 {
00578 (*current_liboctave_error_handler) ("range error for fill");
00579 return *this;
00580 }
00581
00582 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; }
00583 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; }
00584
00585 if (r2 >= r1 && c2 >= c1)
00586 {
00587 make_unique ();
00588
00589 for (octave_idx_type j = c1; j <= c2; j++)
00590 for (octave_idx_type i = r1; i <= r2; i++)
00591 xelem (i, j) = val;
00592 }
00593
00594 return *this;
00595 }
00596
00597 ComplexMatrix&
00598 ComplexMatrix::fill (const Complex& val, octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2)
00599 {
00600 octave_idx_type nr = rows ();
00601 octave_idx_type nc = cols ();
00602
00603 if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0
00604 || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc)
00605 {
00606 (*current_liboctave_error_handler) ("range error for fill");
00607 return *this;
00608 }
00609
00610 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; }
00611 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; }
00612
00613 if (r2 >= r1 && c2 >=c1)
00614 {
00615 make_unique ();
00616
00617 for (octave_idx_type j = c1; j <= c2; j++)
00618 for (octave_idx_type i = r1; i <= r2; i++)
00619 xelem (i, j) = val;
00620 }
00621
00622 return *this;
00623 }
00624
00625 ComplexMatrix
00626 ComplexMatrix::append (const Matrix& a) const
00627 {
00628 octave_idx_type nr = rows ();
00629 octave_idx_type nc = cols ();
00630 if (nr != a.rows ())
00631 {
00632 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00633 return *this;
00634 }
00635
00636 octave_idx_type nc_insert = nc;
00637 ComplexMatrix retval (nr, nc + a.cols ());
00638 retval.insert (*this, 0, 0);
00639 retval.insert (a, 0, nc_insert);
00640 return retval;
00641 }
00642
00643 ComplexMatrix
00644 ComplexMatrix::append (const RowVector& a) const
00645 {
00646 octave_idx_type nr = rows ();
00647 octave_idx_type nc = cols ();
00648 if (nr != 1)
00649 {
00650 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00651 return *this;
00652 }
00653
00654 octave_idx_type nc_insert = nc;
00655 ComplexMatrix retval (nr, nc + a.length ());
00656 retval.insert (*this, 0, 0);
00657 retval.insert (a, 0, nc_insert);
00658 return retval;
00659 }
00660
00661 ComplexMatrix
00662 ComplexMatrix::append (const ColumnVector& a) const
00663 {
00664 octave_idx_type nr = rows ();
00665 octave_idx_type nc = cols ();
00666 if (nr != a.length ())
00667 {
00668 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00669 return *this;
00670 }
00671
00672 octave_idx_type nc_insert = nc;
00673 ComplexMatrix retval (nr, nc + 1);
00674 retval.insert (*this, 0, 0);
00675 retval.insert (a, 0, nc_insert);
00676 return retval;
00677 }
00678
00679 ComplexMatrix
00680 ComplexMatrix::append (const DiagMatrix& a) const
00681 {
00682 octave_idx_type nr = rows ();
00683 octave_idx_type nc = cols ();
00684 if (nr != a.rows ())
00685 {
00686 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00687 return *this;
00688 }
00689
00690 octave_idx_type nc_insert = nc;
00691 ComplexMatrix retval (nr, nc + a.cols ());
00692 retval.insert (*this, 0, 0);
00693 retval.insert (a, 0, nc_insert);
00694 return retval;
00695 }
00696
00697 ComplexMatrix
00698 ComplexMatrix::append (const ComplexMatrix& a) const
00699 {
00700 octave_idx_type nr = rows ();
00701 octave_idx_type nc = cols ();
00702 if (nr != a.rows ())
00703 {
00704 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00705 return *this;
00706 }
00707
00708 octave_idx_type nc_insert = nc;
00709 ComplexMatrix retval (nr, nc + a.cols ());
00710 retval.insert (*this, 0, 0);
00711 retval.insert (a, 0, nc_insert);
00712 return retval;
00713 }
00714
00715 ComplexMatrix
00716 ComplexMatrix::append (const ComplexRowVector& a) const
00717 {
00718 octave_idx_type nr = rows ();
00719 octave_idx_type nc = cols ();
00720 if (nr != 1)
00721 {
00722 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00723 return *this;
00724 }
00725
00726 octave_idx_type nc_insert = nc;
00727 ComplexMatrix retval (nr, nc + a.length ());
00728 retval.insert (*this, 0, 0);
00729 retval.insert (a, 0, nc_insert);
00730 return retval;
00731 }
00732
00733 ComplexMatrix
00734 ComplexMatrix::append (const ComplexColumnVector& a) const
00735 {
00736 octave_idx_type nr = rows ();
00737 octave_idx_type nc = cols ();
00738 if (nr != a.length ())
00739 {
00740 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00741 return *this;
00742 }
00743
00744 octave_idx_type nc_insert = nc;
00745 ComplexMatrix retval (nr, nc + 1);
00746 retval.insert (*this, 0, 0);
00747 retval.insert (a, 0, nc_insert);
00748 return retval;
00749 }
00750
00751 ComplexMatrix
00752 ComplexMatrix::append (const ComplexDiagMatrix& a) const
00753 {
00754 octave_idx_type nr = rows ();
00755 octave_idx_type nc = cols ();
00756 if (nr != a.rows ())
00757 {
00758 (*current_liboctave_error_handler) ("row dimension mismatch for append");
00759 return *this;
00760 }
00761
00762 octave_idx_type nc_insert = nc;
00763 ComplexMatrix retval (nr, nc + a.cols ());
00764 retval.insert (*this, 0, 0);
00765 retval.insert (a, 0, nc_insert);
00766 return retval;
00767 }
00768
00769 ComplexMatrix
00770 ComplexMatrix::stack (const Matrix& a) const
00771 {
00772 octave_idx_type nr = rows ();
00773 octave_idx_type nc = cols ();
00774 if (nc != a.cols ())
00775 {
00776 (*current_liboctave_error_handler)
00777 ("column dimension mismatch for stack");
00778 return *this;
00779 }
00780
00781 octave_idx_type nr_insert = nr;
00782 ComplexMatrix retval (nr + a.rows (), nc);
00783 retval.insert (*this, 0, 0);
00784 retval.insert (a, nr_insert, 0);
00785 return retval;
00786 }
00787
00788 ComplexMatrix
00789 ComplexMatrix::stack (const RowVector& a) const
00790 {
00791 octave_idx_type nr = rows ();
00792 octave_idx_type nc = cols ();
00793 if (nc != a.length ())
00794 {
00795 (*current_liboctave_error_handler)
00796 ("column dimension mismatch for stack");
00797 return *this;
00798 }
00799
00800 octave_idx_type nr_insert = nr;
00801 ComplexMatrix retval (nr + 1, nc);
00802 retval.insert (*this, 0, 0);
00803 retval.insert (a, nr_insert, 0);
00804 return retval;
00805 }
00806
00807 ComplexMatrix
00808 ComplexMatrix::stack (const ColumnVector& a) const
00809 {
00810 octave_idx_type nr = rows ();
00811 octave_idx_type nc = cols ();
00812 if (nc != 1)
00813 {
00814 (*current_liboctave_error_handler)
00815 ("column dimension mismatch for stack");
00816 return *this;
00817 }
00818
00819 octave_idx_type nr_insert = nr;
00820 ComplexMatrix retval (nr + a.length (), nc);
00821 retval.insert (*this, 0, 0);
00822 retval.insert (a, nr_insert, 0);
00823 return retval;
00824 }
00825
00826 ComplexMatrix
00827 ComplexMatrix::stack (const DiagMatrix& a) const
00828 {
00829 octave_idx_type nr = rows ();
00830 octave_idx_type nc = cols ();
00831 if (nc != a.cols ())
00832 {
00833 (*current_liboctave_error_handler)
00834 ("column dimension mismatch for stack");
00835 return *this;
00836 }
00837
00838 octave_idx_type nr_insert = nr;
00839 ComplexMatrix retval (nr + a.rows (), nc);
00840 retval.insert (*this, 0, 0);
00841 retval.insert (a, nr_insert, 0);
00842 return retval;
00843 }
00844
00845 ComplexMatrix
00846 ComplexMatrix::stack (const ComplexMatrix& a) const
00847 {
00848 octave_idx_type nr = rows ();
00849 octave_idx_type nc = cols ();
00850 if (nc != a.cols ())
00851 {
00852 (*current_liboctave_error_handler)
00853 ("column dimension mismatch for stack");
00854 return *this;
00855 }
00856
00857 octave_idx_type nr_insert = nr;
00858 ComplexMatrix retval (nr + a.rows (), nc);
00859 retval.insert (*this, 0, 0);
00860 retval.insert (a, nr_insert, 0);
00861 return retval;
00862 }
00863
00864 ComplexMatrix
00865 ComplexMatrix::stack (const ComplexRowVector& a) const
00866 {
00867 octave_idx_type nr = rows ();
00868 octave_idx_type nc = cols ();
00869 if (nc != a.length ())
00870 {
00871 (*current_liboctave_error_handler)
00872 ("column dimension mismatch for stack");
00873 return *this;
00874 }
00875
00876 octave_idx_type nr_insert = nr;
00877 ComplexMatrix retval (nr + 1, nc);
00878 retval.insert (*this, 0, 0);
00879 retval.insert (a, nr_insert, 0);
00880 return retval;
00881 }
00882
00883 ComplexMatrix
00884 ComplexMatrix::stack (const ComplexColumnVector& a) const
00885 {
00886 octave_idx_type nr = rows ();
00887 octave_idx_type nc = cols ();
00888 if (nc != 1)
00889 {
00890 (*current_liboctave_error_handler)
00891 ("column dimension mismatch for stack");
00892 return *this;
00893 }
00894
00895 octave_idx_type nr_insert = nr;
00896 ComplexMatrix retval (nr + a.length (), nc);
00897 retval.insert (*this, 0, 0);
00898 retval.insert (a, nr_insert, 0);
00899 return retval;
00900 }
00901
00902 ComplexMatrix
00903 ComplexMatrix::stack (const ComplexDiagMatrix& a) const
00904 {
00905 octave_idx_type nr = rows ();
00906 octave_idx_type nc = cols ();
00907 if (nc != a.cols ())
00908 {
00909 (*current_liboctave_error_handler)
00910 ("column dimension mismatch for stack");
00911 return *this;
00912 }
00913
00914 octave_idx_type nr_insert = nr;
00915 ComplexMatrix retval (nr + a.rows (), nc);
00916 retval.insert (*this, 0, 0);
00917 retval.insert (a, nr_insert, 0);
00918 return retval;
00919 }
00920
00921 ComplexMatrix
00922 conj (const ComplexMatrix& a)
00923 {
00924 return do_mx_unary_map<Complex, Complex, std::conj<double> > (a);
00925 }
00926
00927
00928
00929 ComplexMatrix
00930 ComplexMatrix::extract (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) const
00931 {
00932 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; }
00933 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; }
00934
00935 return index (idx_vector (r1, r2+1), idx_vector (c1, c2+1));
00936 }
00937
00938 ComplexMatrix
00939 ComplexMatrix::extract_n (octave_idx_type r1, octave_idx_type c1, octave_idx_type nr, octave_idx_type nc) const
00940 {
00941 return index (idx_vector (r1, r1 + nr), idx_vector (c1, c1 + nc));
00942 }
00943
00944
00945
00946 ComplexRowVector
00947 ComplexMatrix::row (octave_idx_type i) const
00948 {
00949 return index (idx_vector (i), idx_vector::colon);
00950 }
00951
00952 ComplexColumnVector
00953 ComplexMatrix::column (octave_idx_type i) const
00954 {
00955 return index (idx_vector::colon, idx_vector (i));
00956 }
00957
00958 ComplexMatrix
00959 ComplexMatrix::inverse (void) const
00960 {
00961 octave_idx_type info;
00962 double rcon;
00963 MatrixType mattype (*this);
00964 return inverse (mattype, info, rcon, 0, 0);
00965 }
00966
00967 ComplexMatrix
00968 ComplexMatrix::inverse (octave_idx_type& info) const
00969 {
00970 double rcon;
00971 MatrixType mattype (*this);
00972 return inverse (mattype, info, rcon, 0, 0);
00973 }
00974
00975 ComplexMatrix
00976 ComplexMatrix::inverse (octave_idx_type& info, double& rcon, int force,
00977 int calc_cond) const
00978 {
00979 MatrixType mattype (*this);
00980 return inverse (mattype, info, rcon, force, calc_cond);
00981 }
00982
00983 ComplexMatrix
00984 ComplexMatrix::inverse (MatrixType &mattype) const
00985 {
00986 octave_idx_type info;
00987 double rcon;
00988 return inverse (mattype, info, rcon, 0, 0);
00989 }
00990
00991 ComplexMatrix
00992 ComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info) const
00993 {
00994 double rcon;
00995 return inverse (mattype, info, rcon, 0, 0);
00996 }
00997
00998 ComplexMatrix
00999 ComplexMatrix::tinverse (MatrixType &mattype, octave_idx_type& info,
01000 double& rcon, int force, int calc_cond) const
01001 {
01002 ComplexMatrix retval;
01003
01004 octave_idx_type nr = rows ();
01005 octave_idx_type nc = cols ();
01006
01007 if (nr != nc || nr == 0 || nc == 0)
01008 (*current_liboctave_error_handler) ("inverse requires square matrix");
01009 else
01010 {
01011 int typ = mattype.type ();
01012 char uplo = (typ == MatrixType::Lower ? 'L' : 'U');
01013 char udiag = 'N';
01014 retval = *this;
01015 Complex *tmp_data = retval.fortran_vec ();
01016
01017 F77_XFCN (ztrtri, ZTRTRI, (F77_CONST_CHAR_ARG2 (&uplo, 1),
01018 F77_CONST_CHAR_ARG2 (&udiag, 1),
01019 nr, tmp_data, nr, info
01020 F77_CHAR_ARG_LEN (1)
01021 F77_CHAR_ARG_LEN (1)));
01022
01023
01024 rcon = 0.0;
01025 if (info != 0)
01026 info = -1;
01027 else if (calc_cond)
01028 {
01029 octave_idx_type ztrcon_info = 0;
01030 char job = '1';
01031
01032 OCTAVE_LOCAL_BUFFER (Complex, cwork, 2*nr);
01033 OCTAVE_LOCAL_BUFFER (double, rwork, nr);
01034
01035 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&job, 1),
01036 F77_CONST_CHAR_ARG2 (&uplo, 1),
01037 F77_CONST_CHAR_ARG2 (&udiag, 1),
01038 nr, tmp_data, nr, rcon,
01039 cwork, rwork, ztrcon_info
01040 F77_CHAR_ARG_LEN (1)
01041 F77_CHAR_ARG_LEN (1)
01042 F77_CHAR_ARG_LEN (1)));
01043
01044 if (ztrcon_info != 0)
01045 info = -1;
01046 }
01047
01048 if (info == -1 && ! force)
01049 retval = *this;
01050 }
01051
01052 return retval;
01053 }
01054
01055 ComplexMatrix
01056 ComplexMatrix::finverse (MatrixType &mattype, octave_idx_type& info,
01057 double& rcon, int force, int calc_cond) const
01058 {
01059 ComplexMatrix retval;
01060
01061 octave_idx_type nr = rows ();
01062 octave_idx_type nc = cols ();
01063
01064 if (nr != nc)
01065 (*current_liboctave_error_handler) ("inverse requires square matrix");
01066 else
01067 {
01068 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
01069 octave_idx_type *pipvt = ipvt.fortran_vec ();
01070
01071 retval = *this;
01072 Complex *tmp_data = retval.fortran_vec ();
01073
01074 Array<Complex> z (dim_vector (1, 1));
01075 octave_idx_type lwork = -1;
01076
01077
01078
01079 F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt,
01080 z.fortran_vec (), lwork, info));
01081
01082 lwork = static_cast<octave_idx_type> (std::real(z(0)));
01083 lwork = (lwork < 2 *nc ? 2*nc : lwork);
01084 z.resize (dim_vector (lwork, 1));
01085 Complex *pz = z.fortran_vec ();
01086
01087 info = 0;
01088
01089
01090 double anorm;
01091 if (calc_cond)
01092 anorm = retval.abs().sum().row(static_cast<octave_idx_type>(0)).max();
01093
01094 F77_XFCN (zgetrf, ZGETRF, (nc, nc, tmp_data, nr, pipvt, info));
01095
01096
01097 rcon = 0.0;
01098 if (info != 0)
01099 info = -1;
01100 else if (calc_cond)
01101 {
01102
01103 octave_idx_type zgecon_info = 0;
01104 char job = '1';
01105 Array<double> rz (dim_vector (2 * nc, 1));
01106 double *prz = rz.fortran_vec ();
01107 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1),
01108 nc, tmp_data, nr, anorm,
01109 rcon, pz, prz, zgecon_info
01110 F77_CHAR_ARG_LEN (1)));
01111
01112 if (zgecon_info != 0)
01113 info = -1;
01114 }
01115
01116 if (info == -1 && ! force)
01117 retval = *this;
01118 else
01119 {
01120 octave_idx_type zgetri_info = 0;
01121
01122 F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt,
01123 pz, lwork, zgetri_info));
01124
01125 if (zgetri_info != 0)
01126 info = -1;
01127 }
01128
01129 if (info != 0)
01130 mattype.mark_as_rectangular();
01131 }
01132
01133 return retval;
01134 }
01135
01136 ComplexMatrix
01137 ComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info,
01138 double& rcon, int force, int calc_cond) const
01139 {
01140 int typ = mattype.type (false);
01141 ComplexMatrix ret;
01142
01143 if (typ == MatrixType::Unknown)
01144 typ = mattype.type (*this);
01145
01146 if (typ == MatrixType::Upper || typ == MatrixType::Lower)
01147 ret = tinverse (mattype, info, rcon, force, calc_cond);
01148 else
01149 {
01150 if (mattype.is_hermitian ())
01151 {
01152 ComplexCHOL chol (*this, info, calc_cond);
01153 if (info == 0)
01154 {
01155 if (calc_cond)
01156 rcon = chol.rcond();
01157 else
01158 rcon = 1.0;
01159 ret = chol.inverse ();
01160 }
01161 else
01162 mattype.mark_as_unsymmetric ();
01163 }
01164
01165 if (!mattype.is_hermitian ())
01166 ret = finverse(mattype, info, rcon, force, calc_cond);
01167
01168 if ((mattype.is_hermitian () || calc_cond) && rcon == 0.)
01169 ret = ComplexMatrix (rows (), columns (), Complex (octave_Inf, 0.));
01170 }
01171
01172 return ret;
01173 }
01174
01175 ComplexMatrix
01176 ComplexMatrix::pseudo_inverse (double tol) const
01177 {
01178 ComplexMatrix retval;
01179
01180 ComplexSVD result (*this, SVD::economy);
01181
01182 DiagMatrix S = result.singular_values ();
01183 ComplexMatrix U = result.left_singular_matrix ();
01184 ComplexMatrix V = result.right_singular_matrix ();
01185
01186 ColumnVector sigma = S.diag ();
01187
01188 octave_idx_type r = sigma.length () - 1;
01189 octave_idx_type nr = rows ();
01190 octave_idx_type nc = cols ();
01191
01192 if (tol <= 0.0)
01193 {
01194 if (nr > nc)
01195 tol = nr * sigma.elem (0) * DBL_EPSILON;
01196 else
01197 tol = nc * sigma.elem (0) * DBL_EPSILON;
01198 }
01199
01200 while (r >= 0 && sigma.elem (r) < tol)
01201 r--;
01202
01203 if (r < 0)
01204 retval = ComplexMatrix (nc, nr, 0.0);
01205 else
01206 {
01207 ComplexMatrix Ur = U.extract (0, 0, nr-1, r);
01208 DiagMatrix D = DiagMatrix (sigma.extract (0, r)) . inverse ();
01209 ComplexMatrix Vr = V.extract (0, 0, nc-1, r);
01210 retval = Vr * D * Ur.hermitian ();
01211 }
01212
01213 return retval;
01214 }
01215
01216 #if defined (HAVE_FFTW)
01217
01218 ComplexMatrix
01219 ComplexMatrix::fourier (void) const
01220 {
01221 size_t nr = rows ();
01222 size_t nc = cols ();
01223
01224 ComplexMatrix retval (nr, nc);
01225
01226 size_t npts, nsamples;
01227
01228 if (nr == 1 || nc == 1)
01229 {
01230 npts = nr > nc ? nr : nc;
01231 nsamples = 1;
01232 }
01233 else
01234 {
01235 npts = nr;
01236 nsamples = nc;
01237 }
01238
01239 const Complex *in (data ());
01240 Complex *out (retval.fortran_vec ());
01241
01242 octave_fftw::fft (in, out, npts, nsamples);
01243
01244 return retval;
01245 }
01246
01247 ComplexMatrix
01248 ComplexMatrix::ifourier (void) const
01249 {
01250 size_t nr = rows ();
01251 size_t nc = cols ();
01252
01253 ComplexMatrix retval (nr, nc);
01254
01255 size_t npts, nsamples;
01256
01257 if (nr == 1 || nc == 1)
01258 {
01259 npts = nr > nc ? nr : nc;
01260 nsamples = 1;
01261 }
01262 else
01263 {
01264 npts = nr;
01265 nsamples = nc;
01266 }
01267
01268 const Complex *in (data ());
01269 Complex *out (retval.fortran_vec ());
01270
01271 octave_fftw::ifft (in, out, npts, nsamples);
01272
01273 return retval;
01274 }
01275
01276 ComplexMatrix
01277 ComplexMatrix::fourier2d (void) const
01278 {
01279 dim_vector dv(rows (), cols ());
01280
01281 ComplexMatrix retval (rows (), cols ());
01282 const Complex *in (data ());
01283 Complex *out (retval.fortran_vec ());
01284
01285 octave_fftw::fftNd (in, out, 2, dv);
01286
01287 return retval;
01288 }
01289
01290 ComplexMatrix
01291 ComplexMatrix::ifourier2d (void) const
01292 {
01293 dim_vector dv(rows (), cols ());
01294
01295 ComplexMatrix retval (rows (), cols ());
01296 const Complex *in (data ());
01297 Complex *out (retval.fortran_vec ());
01298
01299 octave_fftw::ifftNd (in, out, 2, dv);
01300
01301 return retval;
01302 }
01303
01304 #else
01305
01306 extern "C"
01307 {
01308
01309
01310
01311
01312
01313 F77_RET_T
01314 F77_FUNC (zffti, ZFFTI) (const octave_idx_type&, Complex*);
01315
01316 F77_RET_T
01317 F77_FUNC (zfftf, ZFFTF) (const octave_idx_type&, Complex*, Complex*);
01318
01319 F77_RET_T
01320 F77_FUNC (zfftb, ZFFTB) (const octave_idx_type&, Complex*, Complex*);
01321 }
01322
01323 ComplexMatrix
01324 ComplexMatrix::fourier (void) const
01325 {
01326 ComplexMatrix retval;
01327
01328 octave_idx_type nr = rows ();
01329 octave_idx_type nc = cols ();
01330
01331 octave_idx_type npts, nsamples;
01332
01333 if (nr == 1 || nc == 1)
01334 {
01335 npts = nr > nc ? nr : nc;
01336 nsamples = 1;
01337 }
01338 else
01339 {
01340 npts = nr;
01341 nsamples = nc;
01342 }
01343
01344 octave_idx_type nn = 4*npts+15;
01345
01346 Array<Complex> wsave (nn, 1);
01347 Complex *pwsave = wsave.fortran_vec ();
01348
01349 retval = *this;
01350 Complex *tmp_data = retval.fortran_vec ();
01351
01352 F77_FUNC (zffti, ZFFTI) (npts, pwsave);
01353
01354 for (octave_idx_type j = 0; j < nsamples; j++)
01355 {
01356 octave_quit ();
01357
01358 F77_FUNC (zfftf, ZFFTF) (npts, &tmp_data[npts*j], pwsave);
01359 }
01360
01361 return retval;
01362 }
01363
01364 ComplexMatrix
01365 ComplexMatrix::ifourier (void) const
01366 {
01367 ComplexMatrix retval;
01368
01369 octave_idx_type nr = rows ();
01370 octave_idx_type nc = cols ();
01371
01372 octave_idx_type npts, nsamples;
01373
01374 if (nr == 1 || nc == 1)
01375 {
01376 npts = nr > nc ? nr : nc;
01377 nsamples = 1;
01378 }
01379 else
01380 {
01381 npts = nr;
01382 nsamples = nc;
01383 }
01384
01385 octave_idx_type nn = 4*npts+15;
01386
01387 Array<Complex> wsave (nn, 1);
01388 Complex *pwsave = wsave.fortran_vec ();
01389
01390 retval = *this;
01391 Complex *tmp_data = retval.fortran_vec ();
01392
01393 F77_FUNC (zffti, ZFFTI) (npts, pwsave);
01394
01395 for (octave_idx_type j = 0; j < nsamples; j++)
01396 {
01397 octave_quit ();
01398
01399 F77_FUNC (zfftb, ZFFTB) (npts, &tmp_data[npts*j], pwsave);
01400 }
01401
01402 for (octave_idx_type j = 0; j < npts*nsamples; j++)
01403 tmp_data[j] = tmp_data[j] / static_cast<double> (npts);
01404
01405 return retval;
01406 }
01407
01408 ComplexMatrix
01409 ComplexMatrix::fourier2d (void) const
01410 {
01411 ComplexMatrix retval;
01412
01413 octave_idx_type nr = rows ();
01414 octave_idx_type nc = cols ();
01415
01416 octave_idx_type npts, nsamples;
01417
01418 if (nr == 1 || nc == 1)
01419 {
01420 npts = nr > nc ? nr : nc;
01421 nsamples = 1;
01422 }
01423 else
01424 {
01425 npts = nr;
01426 nsamples = nc;
01427 }
01428
01429 octave_idx_type nn = 4*npts+15;
01430
01431 Array<Complex> wsave (nn, 1);
01432 Complex *pwsave = wsave.fortran_vec ();
01433
01434 retval = *this;
01435 Complex *tmp_data = retval.fortran_vec ();
01436
01437 F77_FUNC (zffti, ZFFTI) (npts, pwsave);
01438
01439 for (octave_idx_type j = 0; j < nsamples; j++)
01440 {
01441 octave_quit ();
01442
01443 F77_FUNC (zfftf, ZFFTF) (npts, &tmp_data[npts*j], pwsave);
01444 }
01445
01446 npts = nc;
01447 nsamples = nr;
01448 nn = 4*npts+15;
01449
01450 wsave.resize (dim_vector (nn, 1));
01451 pwsave = wsave.fortran_vec ();
01452
01453 Array<Complex> tmp (npts, 1);
01454 Complex *prow = tmp.fortran_vec ();
01455
01456 F77_FUNC (zffti, ZFFTI) (npts, pwsave);
01457
01458 for (octave_idx_type j = 0; j < nsamples; j++)
01459 {
01460 octave_quit ();
01461
01462 for (octave_idx_type i = 0; i < npts; i++)
01463 prow[i] = tmp_data[i*nr + j];
01464
01465 F77_FUNC (zfftf, ZFFTF) (npts, prow, pwsave);
01466
01467 for (octave_idx_type i = 0; i < npts; i++)
01468 tmp_data[i*nr + j] = prow[i];
01469 }
01470
01471 return retval;
01472 }
01473
01474 ComplexMatrix
01475 ComplexMatrix::ifourier2d (void) const
01476 {
01477 ComplexMatrix retval;
01478
01479 octave_idx_type nr = rows ();
01480 octave_idx_type nc = cols ();
01481
01482 octave_idx_type npts, nsamples;
01483
01484 if (nr == 1 || nc == 1)
01485 {
01486 npts = nr > nc ? nr : nc;
01487 nsamples = 1;
01488 }
01489 else
01490 {
01491 npts = nr;
01492 nsamples = nc;
01493 }
01494
01495 octave_idx_type nn = 4*npts+15;
01496
01497 Array<Complex> wsave (nn, 1);
01498 Complex *pwsave = wsave.fortran_vec ();
01499
01500 retval = *this;
01501 Complex *tmp_data = retval.fortran_vec ();
01502
01503 F77_FUNC (zffti, ZFFTI) (npts, pwsave);
01504
01505 for (octave_idx_type j = 0; j < nsamples; j++)
01506 {
01507 octave_quit ();
01508
01509 F77_FUNC (zfftb, ZFFTB) (npts, &tmp_data[npts*j], pwsave);
01510 }
01511
01512 for (octave_idx_type j = 0; j < npts*nsamples; j++)
01513 tmp_data[j] = tmp_data[j] / static_cast<double> (npts);
01514
01515 npts = nc;
01516 nsamples = nr;
01517 nn = 4*npts+15;
01518
01519 wsave.resize (dim_vector (nn, 1));
01520 pwsave = wsave.fortran_vec ();
01521
01522 Array<Complex> tmp (npts, 1);
01523 Complex *prow = tmp.fortran_vec ();
01524
01525 F77_FUNC (zffti, ZFFTI) (npts, pwsave);
01526
01527 for (octave_idx_type j = 0; j < nsamples; j++)
01528 {
01529 octave_quit ();
01530
01531 for (octave_idx_type i = 0; i < npts; i++)
01532 prow[i] = tmp_data[i*nr + j];
01533
01534 F77_FUNC (zfftb, ZFFTB) (npts, prow, pwsave);
01535
01536 for (octave_idx_type i = 0; i < npts; i++)
01537 tmp_data[i*nr + j] = prow[i] / static_cast<double> (npts);
01538 }
01539
01540 return retval;
01541 }
01542
01543 #endif
01544
01545 ComplexDET
01546 ComplexMatrix::determinant (void) const
01547 {
01548 octave_idx_type info;
01549 double rcon;
01550 return determinant (info, rcon, 0);
01551 }
01552
01553 ComplexDET
01554 ComplexMatrix::determinant (octave_idx_type& info) const
01555 {
01556 double rcon;
01557 return determinant (info, rcon, 0);
01558 }
01559
01560 ComplexDET
01561 ComplexMatrix::determinant (octave_idx_type& info, double& rcon, int calc_cond) const
01562 {
01563 MatrixType mattype (*this);
01564 return determinant (mattype, info, rcon, calc_cond);
01565 }
01566
01567 ComplexDET
01568 ComplexMatrix::determinant (MatrixType& mattype,
01569 octave_idx_type& info, double& rcon,
01570 int calc_cond) const
01571 {
01572 ComplexDET retval (1.0);
01573
01574 info = 0;
01575 rcon = 0.0;
01576
01577 octave_idx_type nr = rows ();
01578 octave_idx_type nc = cols ();
01579
01580 if (nr != nc)
01581 (*current_liboctave_error_handler) ("matrix must be square");
01582 else
01583 {
01584 volatile int typ = mattype.type ();
01585
01586
01587
01588
01589
01590 if (typ == MatrixType::Unknown)
01591 typ = mattype.type (*this);
01592 else if (typ == MatrixType::Rectangular)
01593 typ = MatrixType::Full;
01594
01595 if (typ == MatrixType::Lower || typ == MatrixType::Upper)
01596 {
01597 for (octave_idx_type i = 0; i < nc; i++)
01598 retval *= elem (i,i);
01599 }
01600 else if (typ == MatrixType::Hermitian)
01601 {
01602 ComplexMatrix atmp = *this;
01603 Complex *tmp_data = atmp.fortran_vec ();
01604
01605 double anorm = 0;
01606 if (calc_cond) anorm = xnorm (*this, 1);
01607
01608
01609 char job = 'L';
01610 F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr,
01611 tmp_data, nr, info
01612 F77_CHAR_ARG_LEN (1)));
01613
01614 if (info != 0)
01615 {
01616 rcon = 0.0;
01617 mattype.mark_as_unsymmetric ();
01618 typ = MatrixType::Full;
01619 }
01620 else
01621 {
01622 Array<Complex> z (dim_vector (2 * nc, 1));
01623 Complex *pz = z.fortran_vec ();
01624 Array<double> rz (dim_vector (nc, 1));
01625 double *prz = rz.fortran_vec ();
01626
01627 F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1),
01628 nr, tmp_data, nr, anorm,
01629 rcon, pz, prz, info
01630 F77_CHAR_ARG_LEN (1)));
01631
01632 if (info != 0)
01633 rcon = 0.0;
01634
01635 for (octave_idx_type i = 0; i < nc; i++)
01636 retval *= atmp (i,i);
01637
01638 retval = retval.square ();
01639 }
01640 }
01641 else if (typ != MatrixType::Full)
01642 (*current_liboctave_error_handler) ("det: invalid dense matrix type");
01643
01644 if (typ == MatrixType::Full)
01645 {
01646 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
01647 octave_idx_type *pipvt = ipvt.fortran_vec ();
01648
01649 ComplexMatrix atmp = *this;
01650 Complex *tmp_data = atmp.fortran_vec ();
01651
01652 info = 0;
01653
01654
01655 double anorm = 0;
01656 if (calc_cond) anorm = xnorm (*this, 1);
01657
01658 F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info));
01659
01660
01661 rcon = 0.0;
01662 if (info != 0)
01663 {
01664 info = -1;
01665 retval = ComplexDET ();
01666 }
01667 else
01668 {
01669 if (calc_cond)
01670 {
01671
01672 char job = '1';
01673 Array<Complex> z (dim_vector (2 * nc, 1));
01674 Complex *pz = z.fortran_vec ();
01675 Array<double> rz (dim_vector (2 * nc, 1));
01676 double *prz = rz.fortran_vec ();
01677
01678 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1),
01679 nc, tmp_data, nr, anorm,
01680 rcon, pz, prz, info
01681 F77_CHAR_ARG_LEN (1)));
01682 }
01683
01684 if (info != 0)
01685 {
01686 info = -1;
01687 retval = ComplexDET ();
01688 }
01689 else
01690 {
01691 for (octave_idx_type i = 0; i < nc; i++)
01692 {
01693 Complex c = atmp(i,i);
01694 retval *= (ipvt(i) != (i+1)) ? -c : c;
01695 }
01696 }
01697 }
01698 }
01699 }
01700
01701 return retval;
01702 }
01703
01704 double
01705 ComplexMatrix::rcond (void) const
01706 {
01707 MatrixType mattype (*this);
01708 return rcond (mattype);
01709 }
01710
01711 double
01712 ComplexMatrix::rcond (MatrixType &mattype) const
01713 {
01714 double rcon;
01715 octave_idx_type nr = rows ();
01716 octave_idx_type nc = cols ();
01717
01718 if (nr != nc)
01719 (*current_liboctave_error_handler) ("matrix must be square");
01720 else if (nr == 0 || nc == 0)
01721 rcon = octave_Inf;
01722 else
01723 {
01724 int typ = mattype.type ();
01725
01726 if (typ == MatrixType::Unknown)
01727 typ = mattype.type (*this);
01728
01729
01730 if (typ == MatrixType::Upper)
01731 {
01732 const Complex *tmp_data = fortran_vec ();
01733 octave_idx_type info = 0;
01734 char norm = '1';
01735 char uplo = 'U';
01736 char dia = 'N';
01737
01738 Array<Complex> z (dim_vector (2 * nc, 1));
01739 Complex *pz = z.fortran_vec ();
01740 Array<double> rz (dim_vector (nc, 1));
01741 double *prz = rz.fortran_vec ();
01742
01743 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1),
01744 F77_CONST_CHAR_ARG2 (&uplo, 1),
01745 F77_CONST_CHAR_ARG2 (&dia, 1),
01746 nr, tmp_data, nr, rcon,
01747 pz, prz, info
01748 F77_CHAR_ARG_LEN (1)
01749 F77_CHAR_ARG_LEN (1)
01750 F77_CHAR_ARG_LEN (1)));
01751
01752 if (info != 0)
01753 rcon = 0;
01754 }
01755 else if (typ == MatrixType::Permuted_Upper)
01756 (*current_liboctave_error_handler)
01757 ("permuted triangular matrix not implemented");
01758 else if (typ == MatrixType::Lower)
01759 {
01760 const Complex *tmp_data = fortran_vec ();
01761 octave_idx_type info = 0;
01762 char norm = '1';
01763 char uplo = 'L';
01764 char dia = 'N';
01765
01766 Array<Complex> z (dim_vector (2 * nc, 1));
01767 Complex *pz = z.fortran_vec ();
01768 Array<double> rz (dim_vector (nc, 1));
01769 double *prz = rz.fortran_vec ();
01770
01771 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1),
01772 F77_CONST_CHAR_ARG2 (&uplo, 1),
01773 F77_CONST_CHAR_ARG2 (&dia, 1),
01774 nr, tmp_data, nr, rcon,
01775 pz, prz, info
01776 F77_CHAR_ARG_LEN (1)
01777 F77_CHAR_ARG_LEN (1)
01778 F77_CHAR_ARG_LEN (1)));
01779
01780 if (info != 0)
01781 rcon = 0.0;
01782 }
01783 else if (typ == MatrixType::Permuted_Lower)
01784 (*current_liboctave_error_handler)
01785 ("permuted triangular matrix not implemented");
01786 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
01787 {
01788 double anorm = -1.0;
01789
01790 if (typ == MatrixType::Hermitian)
01791 {
01792 octave_idx_type info = 0;
01793 char job = 'L';
01794
01795 ComplexMatrix atmp = *this;
01796 Complex *tmp_data = atmp.fortran_vec ();
01797
01798 anorm = atmp.abs().sum().
01799 row(static_cast<octave_idx_type>(0)).max();
01800
01801 F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr,
01802 tmp_data, nr, info
01803 F77_CHAR_ARG_LEN (1)));
01804
01805 if (info != 0)
01806 {
01807 rcon = 0.0;
01808
01809 mattype.mark_as_unsymmetric ();
01810 typ = MatrixType::Full;
01811 }
01812 else
01813 {
01814 Array<Complex> z (dim_vector (2 * nc, 1));
01815 Complex *pz = z.fortran_vec ();
01816 Array<double> rz (dim_vector (nc, 1));
01817 double *prz = rz.fortran_vec ();
01818
01819 F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1),
01820 nr, tmp_data, nr, anorm,
01821 rcon, pz, prz, info
01822 F77_CHAR_ARG_LEN (1)));
01823
01824 if (info != 0)
01825 rcon = 0.0;
01826 }
01827 }
01828
01829
01830 if (typ == MatrixType::Full)
01831 {
01832 octave_idx_type info = 0;
01833
01834 ComplexMatrix atmp = *this;
01835 Complex *tmp_data = atmp.fortran_vec ();
01836
01837 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
01838 octave_idx_type *pipvt = ipvt.fortran_vec ();
01839
01840 if(anorm < 0.)
01841 anorm = atmp.abs().sum().
01842 row(static_cast<octave_idx_type>(0)).max();
01843
01844 Array<Complex> z (dim_vector (2 * nc, 1));
01845 Complex *pz = z.fortran_vec ();
01846 Array<double> rz (dim_vector (2 * nc, 1));
01847 double *prz = rz.fortran_vec ();
01848
01849 F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info));
01850
01851 if (info != 0)
01852 {
01853 rcon = 0.0;
01854 mattype.mark_as_rectangular ();
01855 }
01856 else
01857 {
01858 char job = '1';
01859 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1),
01860 nc, tmp_data, nr, anorm,
01861 rcon, pz, prz, info
01862 F77_CHAR_ARG_LEN (1)));
01863
01864 if (info != 0)
01865 rcon = 0.0;
01866 }
01867 }
01868 }
01869 else
01870 rcon = 0.0;
01871 }
01872
01873 return rcon;
01874 }
01875
01876 ComplexMatrix
01877 ComplexMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b,
01878 octave_idx_type& info, double& rcon,
01879 solve_singularity_handler sing_handler,
01880 bool calc_cond, blas_trans_type transt) const
01881 {
01882 ComplexMatrix retval;
01883
01884 octave_idx_type nr = rows ();
01885 octave_idx_type nc = cols ();
01886
01887 if (nr != b.rows ())
01888 (*current_liboctave_error_handler)
01889 ("matrix dimension mismatch solution of linear equations");
01890 else if (nr == 0 || nc == 0 || b.cols () == 0)
01891 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
01892 else
01893 {
01894 volatile int typ = mattype.type ();
01895
01896 if (typ == MatrixType::Permuted_Upper ||
01897 typ == MatrixType::Upper)
01898 {
01899 octave_idx_type b_nc = b.cols ();
01900 rcon = 1.;
01901 info = 0;
01902
01903 if (typ == MatrixType::Permuted_Upper)
01904 {
01905 (*current_liboctave_error_handler)
01906 ("permuted triangular matrix not implemented");
01907 }
01908 else
01909 {
01910 const Complex *tmp_data = fortran_vec ();
01911
01912 if (calc_cond)
01913 {
01914 char norm = '1';
01915 char uplo = 'U';
01916 char dia = 'N';
01917
01918 Array<Complex> z (dim_vector (2 * nc, 1));
01919 Complex *pz = z.fortran_vec ();
01920 Array<double> rz (dim_vector (nc, 1));
01921 double *prz = rz.fortran_vec ();
01922
01923 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1),
01924 F77_CONST_CHAR_ARG2 (&uplo, 1),
01925 F77_CONST_CHAR_ARG2 (&dia, 1),
01926 nr, tmp_data, nr, rcon,
01927 pz, prz, info
01928 F77_CHAR_ARG_LEN (1)
01929 F77_CHAR_ARG_LEN (1)
01930 F77_CHAR_ARG_LEN (1)));
01931
01932 if (info != 0)
01933 info = -2;
01934
01935 volatile double rcond_plus_one = rcon + 1.0;
01936
01937 if (rcond_plus_one == 1.0 || xisnan (rcon))
01938 {
01939 info = -2;
01940
01941 if (sing_handler)
01942 sing_handler (rcon);
01943 else
01944 (*current_liboctave_error_handler)
01945 ("matrix singular to machine precision, rcond = %g",
01946 rcon);
01947 }
01948 }
01949
01950 if (info == 0)
01951 {
01952 retval = b;
01953 Complex *result = retval.fortran_vec ();
01954
01955 char uplo = 'U';
01956 char trans = get_blas_char (transt);
01957 char dia = 'N';
01958
01959 F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1),
01960 F77_CONST_CHAR_ARG2 (&trans, 1),
01961 F77_CONST_CHAR_ARG2 (&dia, 1),
01962 nr, b_nc, tmp_data, nr,
01963 result, nr, info
01964 F77_CHAR_ARG_LEN (1)
01965 F77_CHAR_ARG_LEN (1)
01966 F77_CHAR_ARG_LEN (1)));
01967 }
01968 }
01969 }
01970 else
01971 (*current_liboctave_error_handler) ("incorrect matrix type");
01972 }
01973
01974 return retval;
01975 }
01976
01977 ComplexMatrix
01978 ComplexMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b,
01979 octave_idx_type& info, double& rcon,
01980 solve_singularity_handler sing_handler,
01981 bool calc_cond, blas_trans_type transt) const
01982 {
01983 ComplexMatrix retval;
01984
01985 octave_idx_type nr = rows ();
01986 octave_idx_type nc = cols ();
01987
01988 if (nr != b.rows ())
01989 (*current_liboctave_error_handler)
01990 ("matrix dimension mismatch solution of linear equations");
01991 else if (nr == 0 || nc == 0 || b.cols () == 0)
01992 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
01993 else
01994 {
01995 volatile int typ = mattype.type ();
01996
01997 if (typ == MatrixType::Permuted_Lower ||
01998 typ == MatrixType::Lower)
01999 {
02000 octave_idx_type b_nc = b.cols ();
02001 rcon = 1.;
02002 info = 0;
02003
02004 if (typ == MatrixType::Permuted_Lower)
02005 {
02006 (*current_liboctave_error_handler)
02007 ("permuted triangular matrix not implemented");
02008 }
02009 else
02010 {
02011 const Complex *tmp_data = fortran_vec ();
02012
02013 if (calc_cond)
02014 {
02015 char norm = '1';
02016 char uplo = 'L';
02017 char dia = 'N';
02018
02019 Array<Complex> z (dim_vector (2 * nc, 1));
02020 Complex *pz = z.fortran_vec ();
02021 Array<double> rz (dim_vector (nc, 1));
02022 double *prz = rz.fortran_vec ();
02023
02024 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1),
02025 F77_CONST_CHAR_ARG2 (&uplo, 1),
02026 F77_CONST_CHAR_ARG2 (&dia, 1),
02027 nr, tmp_data, nr, rcon,
02028 pz, prz, info
02029 F77_CHAR_ARG_LEN (1)
02030 F77_CHAR_ARG_LEN (1)
02031 F77_CHAR_ARG_LEN (1)));
02032
02033 if (info != 0)
02034 info = -2;
02035
02036 volatile double rcond_plus_one = rcon + 1.0;
02037
02038 if (rcond_plus_one == 1.0 || xisnan (rcon))
02039 {
02040 info = -2;
02041
02042 if (sing_handler)
02043 sing_handler (rcon);
02044 else
02045 (*current_liboctave_error_handler)
02046 ("matrix singular to machine precision, rcond = %g",
02047 rcon);
02048 }
02049 }
02050
02051 if (info == 0)
02052 {
02053 retval = b;
02054 Complex *result = retval.fortran_vec ();
02055
02056 char uplo = 'L';
02057 char trans = get_blas_char (transt);
02058 char dia = 'N';
02059
02060 F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1),
02061 F77_CONST_CHAR_ARG2 (&trans, 1),
02062 F77_CONST_CHAR_ARG2 (&dia, 1),
02063 nr, b_nc, tmp_data, nr,
02064 result, nr, info
02065 F77_CHAR_ARG_LEN (1)
02066 F77_CHAR_ARG_LEN (1)
02067 F77_CHAR_ARG_LEN (1)));
02068 }
02069 }
02070 }
02071 else
02072 (*current_liboctave_error_handler) ("incorrect matrix type");
02073 }
02074
02075 return retval;
02076 }
02077
02078 ComplexMatrix
02079 ComplexMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b,
02080 octave_idx_type& info, double& rcon,
02081 solve_singularity_handler sing_handler,
02082 bool calc_cond) const
02083 {
02084 ComplexMatrix retval;
02085
02086 octave_idx_type nr = rows ();
02087 octave_idx_type nc = cols ();
02088
02089
02090 if (nr != nc || nr != b.rows ())
02091 (*current_liboctave_error_handler)
02092 ("matrix dimension mismatch solution of linear equations");
02093 else if (nr == 0 || b.cols () == 0)
02094 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0));
02095 else
02096 {
02097 volatile int typ = mattype.type ();
02098
02099
02100 double anorm = -1.;
02101
02102 if (typ == MatrixType::Hermitian)
02103 {
02104 info = 0;
02105 char job = 'L';
02106
02107 ComplexMatrix atmp = *this;
02108 Complex *tmp_data = atmp.fortran_vec ();
02109
02110 anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max();
02111
02112 F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr,
02113 tmp_data, nr, info
02114 F77_CHAR_ARG_LEN (1)));
02115
02116
02117 rcon = 0.0;
02118 if (info != 0)
02119 {
02120 info = -2;
02121
02122 mattype.mark_as_unsymmetric ();
02123 typ = MatrixType::Full;
02124 }
02125 else
02126 {
02127 if (calc_cond)
02128 {
02129 Array<Complex> z (dim_vector (2 * nc, 1));
02130 Complex *pz = z.fortran_vec ();
02131 Array<double> rz (dim_vector (nc, 1));
02132 double *prz = rz.fortran_vec ();
02133
02134 F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1),
02135 nr, tmp_data, nr, anorm,
02136 rcon, pz, prz, info
02137 F77_CHAR_ARG_LEN (1)));
02138
02139 if (info != 0)
02140 info = -2;
02141
02142 volatile double rcond_plus_one = rcon + 1.0;
02143
02144 if (rcond_plus_one == 1.0 || xisnan (rcon))
02145 {
02146 info = -2;
02147
02148 if (sing_handler)
02149 sing_handler (rcon);
02150 else
02151 (*current_liboctave_error_handler)
02152 ("matrix singular to machine precision, rcond = %g",
02153 rcon);
02154 }
02155 }
02156
02157 if (info == 0)
02158 {
02159 retval = b;
02160 Complex *result = retval.fortran_vec ();
02161
02162 octave_idx_type b_nc = b.cols ();
02163
02164 F77_XFCN (zpotrs, ZPOTRS, (F77_CONST_CHAR_ARG2 (&job, 1),
02165 nr, b_nc, tmp_data, nr,
02166 result, b.rows(), info
02167 F77_CHAR_ARG_LEN (1)));
02168 }
02169 else
02170 {
02171 mattype.mark_as_unsymmetric ();
02172 typ = MatrixType::Full;
02173 }
02174 }
02175 }
02176
02177 if (typ == MatrixType::Full)
02178 {
02179 info = 0;
02180
02181 Array<octave_idx_type> ipvt (dim_vector (nr, 1));
02182 octave_idx_type *pipvt = ipvt.fortran_vec ();
02183
02184 ComplexMatrix atmp = *this;
02185 Complex *tmp_data = atmp.fortran_vec ();
02186
02187 Array<Complex> z (dim_vector (2 * nc, 1));
02188 Complex *pz = z.fortran_vec ();
02189 Array<double> rz (dim_vector (2 * nc, 1));
02190 double *prz = rz.fortran_vec ();
02191
02192
02193 if (anorm < 0.)
02194 anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max();
02195
02196 F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info));
02197
02198
02199 rcon = 0.0;
02200 if (info != 0)
02201 {
02202 info = -2;
02203
02204 if (sing_handler)
02205 sing_handler (rcon);
02206 else
02207 (*current_liboctave_error_handler)
02208 ("matrix singular to machine precision");
02209
02210 mattype.mark_as_rectangular ();
02211 }
02212 else
02213 {
02214 if (calc_cond)
02215 {
02216
02217
02218 char job = '1';
02219 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1),
02220 nc, tmp_data, nr, anorm,
02221 rcon, pz, prz, info
02222 F77_CHAR_ARG_LEN (1)));
02223
02224 if (info != 0)
02225 info = -2;
02226
02227 volatile double rcond_plus_one = rcon + 1.0;
02228
02229 if (rcond_plus_one == 1.0 || xisnan (rcon))
02230 {
02231 info = -2;
02232
02233 if (sing_handler)
02234 sing_handler (rcon);
02235 else
02236 (*current_liboctave_error_handler)
02237 ("matrix singular to machine precision, rcond = %g",
02238 rcon);
02239 }
02240 }
02241
02242 if (info == 0)
02243 {
02244 retval = b;
02245 Complex *result = retval.fortran_vec ();
02246
02247 octave_idx_type b_nc = b.cols ();
02248
02249 char job = 'N';
02250 F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1),
02251 nr, b_nc, tmp_data, nr,
02252 pipvt, result, b.rows(), info
02253 F77_CHAR_ARG_LEN (1)));
02254 }
02255 else
02256 mattype.mark_as_rectangular ();
02257 }
02258 }
02259 }
02260
02261 return retval;
02262 }
02263
02264 ComplexMatrix
02265 ComplexMatrix::solve (MatrixType &typ, const Matrix& b) const
02266 {
02267 octave_idx_type info;
02268 double rcon;
02269 return solve (typ, b, info, rcon, 0);
02270 }
02271
02272 ComplexMatrix
02273 ComplexMatrix::solve (MatrixType &typ, const Matrix& b,
02274 octave_idx_type& info) const
02275 {
02276 double rcon;
02277 return solve (typ, b, info, rcon, 0);
02278 }
02279
02280 ComplexMatrix
02281 ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info,
02282 double& rcon) const
02283 {
02284 return solve (typ, b, info, rcon, 0);
02285 }
02286
02287 ComplexMatrix
02288 ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info,
02289 double& rcon, solve_singularity_handler sing_handler,
02290 bool singular_fallback, blas_trans_type transt) const
02291 {
02292 ComplexMatrix tmp (b);
02293 return solve (typ, tmp, info, rcon, sing_handler, singular_fallback, transt);
02294 }
02295
02296 ComplexMatrix
02297 ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b) const
02298 {
02299 octave_idx_type info;
02300 double rcon;
02301 return solve (typ, b, info, rcon, 0);
02302 }
02303
02304 ComplexMatrix
02305 ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b,
02306 octave_idx_type& info) const
02307 {
02308 double rcon;
02309 return solve (typ, b, info, rcon, 0);
02310 }
02311
02312 ComplexMatrix
02313 ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b,
02314 octave_idx_type& info, double& rcon) const
02315 {
02316 return solve (typ, b, info, rcon, 0);
02317 }
02318
02319 ComplexMatrix
02320 ComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b,
02321 octave_idx_type& info, double& rcon,
02322 solve_singularity_handler sing_handler,
02323 bool singular_fallback, blas_trans_type transt) const
02324 {
02325 ComplexMatrix retval;
02326 int typ = mattype.type ();
02327
02328 if (typ == MatrixType::Unknown)
02329 typ = mattype.type (*this);
02330
02331
02332 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper)
02333 retval = utsolve (mattype, b, info, rcon, sing_handler, false, transt);
02334 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower)
02335 retval = ltsolve (mattype, b, info, rcon, sing_handler, false, transt);
02336 else if (transt == blas_trans)
02337 return transpose ().solve (mattype, b, info, rcon, sing_handler, singular_fallback);
02338 else if (transt == blas_conj_trans)
02339 retval = hermitian ().solve (mattype, b, info, rcon, sing_handler, singular_fallback);
02340 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian)
02341 retval = fsolve (mattype, b, info, rcon, sing_handler, true);
02342 else if (typ != MatrixType::Rectangular)
02343 {
02344 (*current_liboctave_error_handler) ("unknown matrix type");
02345 return ComplexMatrix ();
02346 }
02347
02348
02349 if (singular_fallback && mattype.type () == MatrixType::Rectangular)
02350 {
02351 octave_idx_type rank;
02352 retval = lssolve (b, info, rank, rcon);
02353 }
02354
02355 return retval;
02356 }
02357
02358 ComplexColumnVector
02359 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b) const
02360 {
02361 octave_idx_type info;
02362 double rcon;
02363 return solve (typ, ComplexColumnVector (b), info, rcon, 0);
02364 }
02365
02366 ComplexColumnVector
02367 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b,
02368 octave_idx_type& info) const
02369 {
02370 double rcon;
02371 return solve (typ, ComplexColumnVector (b), info, rcon, 0);
02372 }
02373
02374 ComplexColumnVector
02375 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b,
02376 octave_idx_type& info, double& rcon) const
02377 {
02378 return solve (typ, ComplexColumnVector (b), info, rcon, 0);
02379 }
02380
02381 ComplexColumnVector
02382 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b,
02383 octave_idx_type& info, double& rcon,
02384 solve_singularity_handler sing_handler, blas_trans_type transt) const
02385 {
02386 return solve (typ, ComplexColumnVector (b), info, rcon, sing_handler, transt);
02387 }
02388
02389 ComplexColumnVector
02390 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b) const
02391 {
02392 octave_idx_type info;
02393 double rcon;
02394 return solve (typ, b, info, rcon, 0);
02395 }
02396
02397 ComplexColumnVector
02398 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b,
02399 octave_idx_type& info) const
02400 {
02401 double rcon;
02402 return solve (typ, b, info, rcon, 0);
02403 }
02404
02405 ComplexColumnVector
02406 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b,
02407 octave_idx_type& info, double& rcon) const
02408 {
02409 return solve (typ, b, info, rcon, 0);
02410 }
02411
02412 ComplexColumnVector
02413 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b,
02414 octave_idx_type& info, double& rcon,
02415 solve_singularity_handler sing_handler, blas_trans_type transt) const
02416 {
02417
02418 ComplexMatrix tmp (b);
02419 tmp = solve (typ, tmp, info, rcon, sing_handler, true, transt);
02420 return tmp.column(static_cast<octave_idx_type> (0));
02421 }
02422
02423 ComplexMatrix
02424 ComplexMatrix::solve (const Matrix& b) const
02425 {
02426 octave_idx_type info;
02427 double rcon;
02428 return solve (b, info, rcon, 0);
02429 }
02430
02431 ComplexMatrix
02432 ComplexMatrix::solve (const Matrix& b, octave_idx_type& info) const
02433 {
02434 double rcon;
02435 return solve (b, info, rcon, 0);
02436 }
02437
02438 ComplexMatrix
02439 ComplexMatrix::solve (const Matrix& b, octave_idx_type& info, double& rcon) const
02440 {
02441 return solve (b, info, rcon, 0);
02442 }
02443
02444 ComplexMatrix
02445 ComplexMatrix::solve (const Matrix& b, octave_idx_type& info, double& rcon,
02446 solve_singularity_handler sing_handler, blas_trans_type transt) const
02447 {
02448 ComplexMatrix tmp (b);
02449 return solve (tmp, info, rcon, sing_handler, transt);
02450 }
02451
02452 ComplexMatrix
02453 ComplexMatrix::solve (const ComplexMatrix& b) const
02454 {
02455 octave_idx_type info;
02456 double rcon;
02457 return solve (b, info, rcon, 0);
02458 }
02459
02460 ComplexMatrix
02461 ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info) const
02462 {
02463 double rcon;
02464 return solve (b, info, rcon, 0);
02465 }
02466
02467 ComplexMatrix
02468 ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info, double& rcon) const
02469 {
02470 return solve (b, info, rcon, 0);
02471 }
02472
02473 ComplexMatrix
02474 ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info, double& rcon,
02475 solve_singularity_handler sing_handler, blas_trans_type transt) const
02476 {
02477 MatrixType mattype (*this);
02478 return solve (mattype, b, info, rcon, sing_handler, true, transt);
02479 }
02480
02481 ComplexColumnVector
02482 ComplexMatrix::solve (const ColumnVector& b) const
02483 {
02484 octave_idx_type info;
02485 double rcon;
02486 return solve (ComplexColumnVector (b), info, rcon, 0);
02487 }
02488
02489 ComplexColumnVector
02490 ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info) const
02491 {
02492 double rcon;
02493 return solve (ComplexColumnVector (b), info, rcon, 0);
02494 }
02495
02496 ComplexColumnVector
02497 ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info,
02498 double& rcon) const
02499 {
02500 return solve (ComplexColumnVector (b), info, rcon, 0);
02501 }
02502
02503 ComplexColumnVector
02504 ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info,
02505 double& rcon,
02506 solve_singularity_handler sing_handler, blas_trans_type transt) const
02507 {
02508 return solve (ComplexColumnVector (b), info, rcon, sing_handler, transt);
02509 }
02510
02511 ComplexColumnVector
02512 ComplexMatrix::solve (const ComplexColumnVector& b) const
02513 {
02514 octave_idx_type info;
02515 double rcon;
02516 return solve (b, info, rcon, 0);
02517 }
02518
02519 ComplexColumnVector
02520 ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const
02521 {
02522 double rcon;
02523 return solve (b, info, rcon, 0);
02524 }
02525
02526 ComplexColumnVector
02527 ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info,
02528 double& rcon) const
02529 {
02530 return solve (b, info, rcon, 0);
02531 }
02532
02533 ComplexColumnVector
02534 ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info,
02535 double& rcon,
02536 solve_singularity_handler sing_handler, blas_trans_type transt) const
02537 {
02538 MatrixType mattype (*this);
02539 return solve (mattype, b, info, rcon, sing_handler, transt);
02540 }
02541
02542 ComplexMatrix
02543 ComplexMatrix::lssolve (const Matrix& b) const
02544 {
02545 octave_idx_type info;
02546 octave_idx_type rank;
02547 double rcon;
02548 return lssolve (ComplexMatrix (b), info, rank, rcon);
02549 }
02550
02551 ComplexMatrix
02552 ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info) const
02553 {
02554 octave_idx_type rank;
02555 double rcon;
02556 return lssolve (ComplexMatrix (b), info, rank, rcon);
02557 }
02558
02559 ComplexMatrix
02560 ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info,
02561 octave_idx_type& rank) const
02562 {
02563 double rcon;
02564 return lssolve (ComplexMatrix (b), info, rank, rcon);
02565 }
02566
02567 ComplexMatrix
02568 ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info,
02569 octave_idx_type& rank, double& rcon) const
02570 {
02571 return lssolve (ComplexMatrix (b), info, rank, rcon);
02572 }
02573
02574 ComplexMatrix
02575 ComplexMatrix::lssolve (const ComplexMatrix& b) const
02576 {
02577 octave_idx_type info;
02578 octave_idx_type rank;
02579 double rcon;
02580 return lssolve (b, info, rank, rcon);
02581 }
02582
02583 ComplexMatrix
02584 ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info) const
02585 {
02586 octave_idx_type rank;
02587 double rcon;
02588 return lssolve (b, info, rank, rcon);
02589 }
02590
02591 ComplexMatrix
02592 ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info,
02593 octave_idx_type& rank) const
02594 {
02595 double rcon;
02596 return lssolve (b, info, rank, rcon);
02597 }
02598
02599 ComplexMatrix
02600 ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info,
02601 octave_idx_type& rank, double& rcon) const
02602 {
02603 ComplexMatrix retval;
02604
02605 octave_idx_type nrhs = b.cols ();
02606
02607 octave_idx_type m = rows ();
02608 octave_idx_type n = cols ();
02609
02610 if (m != b.rows ())
02611 (*current_liboctave_error_handler)
02612 ("matrix dimension mismatch solution of linear equations");
02613 else if (m== 0 || n == 0 || b.cols () == 0)
02614 retval = ComplexMatrix (n, b.cols (), Complex (0.0, 0.0));
02615 else
02616 {
02617 volatile octave_idx_type minmn = (m < n ? m : n);
02618 octave_idx_type maxmn = m > n ? m : n;
02619 rcon = -1.0;
02620
02621 if (m != n)
02622 {
02623 retval = ComplexMatrix (maxmn, nrhs);
02624
02625 for (octave_idx_type j = 0; j < nrhs; j++)
02626 for (octave_idx_type i = 0; i < m; i++)
02627 retval.elem (i, j) = b.elem (i, j);
02628 }
02629 else
02630 retval = b;
02631
02632 ComplexMatrix atmp = *this;
02633 Complex *tmp_data = atmp.fortran_vec ();
02634
02635 Complex *pretval = retval.fortran_vec ();
02636 Array<double> s (dim_vector (minmn, 1));
02637 double *ps = s.fortran_vec ();
02638
02639
02640 octave_idx_type lwork = -1;
02641
02642 Array<Complex> work (dim_vector (1, 1));
02643
02644 octave_idx_type smlsiz;
02645 F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("ZGELSD", 6),
02646 F77_CONST_CHAR_ARG2 (" ", 1),
02647 0, 0, 0, 0, smlsiz
02648 F77_CHAR_ARG_LEN (6)
02649 F77_CHAR_ARG_LEN (1));
02650
02651 octave_idx_type mnthr;
02652 F77_FUNC (xilaenv, XILAENV) (6, F77_CONST_CHAR_ARG2 ("ZGELSD", 6),
02653 F77_CONST_CHAR_ARG2 (" ", 1),
02654 m, n, nrhs, -1, mnthr
02655 F77_CHAR_ARG_LEN (6)
02656 F77_CHAR_ARG_LEN (1));
02657
02658
02659
02660
02661 double dminmn = static_cast<double> (minmn);
02662 double dsmlsizp1 = static_cast<double> (smlsiz+1);
02663 #if defined (HAVE_LOG2)
02664 double tmp = log2 (dminmn / dsmlsizp1);
02665 #else
02666 double tmp = log (dminmn / dsmlsizp1) / log (2.0);
02667 #endif
02668 octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1;
02669 if (nlvl < 0)
02670 nlvl = 0;
02671
02672 octave_idx_type lrwork = minmn*(10 + 2*smlsiz + 8*nlvl)
02673 + 3*smlsiz*nrhs + std::max ((smlsiz+1)*(smlsiz+1),
02674 n*(1+nrhs) + 2*nrhs);
02675 if (lrwork < 1)
02676 lrwork = 1;
02677 Array<double> rwork (dim_vector (lrwork, 1));
02678 double *prwork = rwork.fortran_vec ();
02679
02680 octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn;
02681 if (liwork < 1)
02682 liwork = 1;
02683 Array<octave_idx_type> iwork (dim_vector (liwork, 1));
02684 octave_idx_type* piwork = iwork.fortran_vec ();
02685
02686 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn,
02687 ps, rcon, rank, work.fortran_vec (),
02688 lwork, prwork, piwork, info));
02689
02690
02691
02692
02693
02694 if (n > m && n >= mnthr)
02695 {
02696 octave_idx_type addend = m;
02697
02698 if (2*m-4 > addend)
02699 addend = 2*m-4;
02700
02701 if (nrhs > addend)
02702 addend = nrhs;
02703
02704 if (n-3*m > addend)
02705 addend = n-3*m;
02706
02707 const octave_idx_type lworkaround = 4*m + m*m + addend;
02708
02709 if (std::real (work(0)) < lworkaround)
02710 work(0) = lworkaround;
02711 }
02712 else if (m >= n)
02713 {
02714 octave_idx_type lworkaround = 2*m + m*nrhs;
02715
02716 if (std::real (work(0)) < lworkaround)
02717 work(0) = lworkaround;
02718 }
02719
02720 lwork = static_cast<octave_idx_type> (std::real (work(0)));
02721 work.resize (dim_vector (lwork, 1));
02722
02723 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval,
02724 maxmn, ps, rcon, rank,
02725 work.fortran_vec (), lwork,
02726 prwork, piwork, info));
02727
02728 if (s.elem (0) == 0.0)
02729 rcon = 0.0;
02730 else
02731 rcon = s.elem (minmn - 1) / s.elem (0);
02732
02733 retval.resize (n, nrhs);
02734 }
02735
02736 return retval;
02737 }
02738
02739 ComplexColumnVector
02740 ComplexMatrix::lssolve (const ColumnVector& b) const
02741 {
02742 octave_idx_type info;
02743 octave_idx_type rank;
02744 double rcon;
02745 return lssolve (ComplexColumnVector (b), info, rank, rcon);
02746 }
02747
02748 ComplexColumnVector
02749 ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info) const
02750 {
02751 octave_idx_type rank;
02752 double rcon;
02753 return lssolve (ComplexColumnVector (b), info, rank, rcon);
02754 }
02755
02756 ComplexColumnVector
02757 ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info,
02758 octave_idx_type& rank) const
02759 {
02760 double rcon;
02761 return lssolve (ComplexColumnVector (b), info, rank, rcon);
02762 }
02763
02764 ComplexColumnVector
02765 ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info,
02766 octave_idx_type& rank, double& rcon) const
02767 {
02768 return lssolve (ComplexColumnVector (b), info, rank, rcon);
02769 }
02770
02771 ComplexColumnVector
02772 ComplexMatrix::lssolve (const ComplexColumnVector& b) const
02773 {
02774 octave_idx_type info;
02775 octave_idx_type rank;
02776 double rcon;
02777 return lssolve (b, info, rank, rcon);
02778 }
02779
02780 ComplexColumnVector
02781 ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info) const
02782 {
02783 octave_idx_type rank;
02784 double rcon;
02785 return lssolve (b, info, rank, rcon);
02786 }
02787
02788 ComplexColumnVector
02789 ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info,
02790 octave_idx_type& rank) const
02791 {
02792 double rcon;
02793 return lssolve (b, info, rank, rcon);
02794
02795 }
02796
02797 ComplexColumnVector
02798 ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info,
02799 octave_idx_type& rank, double& rcon) const
02800 {
02801 ComplexColumnVector retval;
02802
02803 octave_idx_type nrhs = 1;
02804
02805 octave_idx_type m = rows ();
02806 octave_idx_type n = cols ();
02807
02808 if (m != b.length ())
02809 (*current_liboctave_error_handler)
02810 ("matrix dimension mismatch solution of linear equations");
02811 else if (m == 0 || n == 0 || b.cols () == 0)
02812 retval = ComplexColumnVector (n, Complex (0.0, 0.0));
02813 else
02814 {
02815 volatile octave_idx_type minmn = (m < n ? m : n);
02816 octave_idx_type maxmn = m > n ? m : n;
02817 rcon = -1.0;
02818
02819 if (m != n)
02820 {
02821 retval = ComplexColumnVector (maxmn);
02822
02823 for (octave_idx_type i = 0; i < m; i++)
02824 retval.elem (i) = b.elem (i);
02825 }
02826 else
02827 retval = b;
02828
02829 ComplexMatrix atmp = *this;
02830 Complex *tmp_data = atmp.fortran_vec ();
02831
02832 Complex *pretval = retval.fortran_vec ();
02833 Array<double> s (dim_vector (minmn, 1));
02834 double *ps = s.fortran_vec ();
02835
02836
02837 octave_idx_type lwork = -1;
02838
02839 Array<Complex> work (dim_vector (1, 1));
02840
02841 octave_idx_type smlsiz;
02842 F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("ZGELSD", 6),
02843 F77_CONST_CHAR_ARG2 (" ", 1),
02844 0, 0, 0, 0, smlsiz
02845 F77_CHAR_ARG_LEN (6)
02846 F77_CHAR_ARG_LEN (1));
02847
02848
02849
02850
02851 double dminmn = static_cast<double> (minmn);
02852 double dsmlsizp1 = static_cast<double> (smlsiz+1);
02853 #if defined (HAVE_LOG2)
02854 double tmp = log2 (dminmn / dsmlsizp1);
02855 #else
02856 double tmp = log (dminmn / dsmlsizp1) / log (2.0);
02857 #endif
02858 octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1;
02859 if (nlvl < 0)
02860 nlvl = 0;
02861
02862 octave_idx_type lrwork = minmn*(10 + 2*smlsiz + 8*nlvl)
02863 + 3*smlsiz*nrhs + (smlsiz+1)*(smlsiz+1);
02864 if (lrwork < 1)
02865 lrwork = 1;
02866 Array<double> rwork (dim_vector (lrwork, 1));
02867 double *prwork = rwork.fortran_vec ();
02868
02869 octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn;
02870 if (liwork < 1)
02871 liwork = 1;
02872 Array<octave_idx_type> iwork (dim_vector (liwork, 1));
02873 octave_idx_type* piwork = iwork.fortran_vec ();
02874
02875 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn,
02876 ps, rcon, rank, work.fortran_vec (),
02877 lwork, prwork, piwork, info));
02878
02879 lwork = static_cast<octave_idx_type> (std::real (work(0)));
02880 work.resize (dim_vector (lwork, 1));
02881 rwork.resize (dim_vector (static_cast<octave_idx_type> (rwork(0)), 1));
02882 iwork.resize (dim_vector (iwork(0), 1));
02883
02884 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval,
02885 maxmn, ps, rcon, rank,
02886 work.fortran_vec (), lwork,
02887 prwork, piwork, info));
02888
02889 if (rank < minmn)
02890 {
02891 if (s.elem (0) == 0.0)
02892 rcon = 0.0;
02893 else
02894 rcon = s.elem (minmn - 1) / s.elem (0);
02895
02896 retval.resize (n, nrhs);
02897 }
02898 }
02899
02900 return retval;
02901 }
02902
02903
02904
02905 ComplexMatrix
02906 operator * (const ColumnVector& v, const ComplexRowVector& a)
02907 {
02908 ComplexColumnVector tmp (v);
02909 return tmp * a;
02910 }
02911
02912 ComplexMatrix
02913 operator * (const ComplexColumnVector& a, const RowVector& b)
02914 {
02915 ComplexRowVector tmp (b);
02916 return a * tmp;
02917 }
02918
02919 ComplexMatrix
02920 operator * (const ComplexColumnVector& v, const ComplexRowVector& a)
02921 {
02922 ComplexMatrix retval;
02923
02924 octave_idx_type len = v.length ();
02925
02926 if (len != 0)
02927 {
02928 octave_idx_type a_len = a.length ();
02929
02930 retval = ComplexMatrix (len, a_len);
02931 Complex *c = retval.fortran_vec ();
02932
02933 F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 ("N", 1),
02934 F77_CONST_CHAR_ARG2 ("N", 1),
02935 len, a_len, 1, 1.0, v.data (), len,
02936 a.data (), 1, 0.0, c, len
02937 F77_CHAR_ARG_LEN (1)
02938 F77_CHAR_ARG_LEN (1)));
02939 }
02940
02941 return retval;
02942 }
02943
02944
02945
02946 ComplexMatrix&
02947 ComplexMatrix::operator += (const DiagMatrix& a)
02948 {
02949 octave_idx_type nr = rows ();
02950 octave_idx_type nc = cols ();
02951
02952 octave_idx_type a_nr = rows ();
02953 octave_idx_type a_nc = cols ();
02954
02955 if (nr != a_nr || nc != a_nc)
02956 {
02957 gripe_nonconformant ("operator +=", nr, nc, a_nr, a_nc);
02958 return *this;
02959 }
02960
02961 for (octave_idx_type i = 0; i < a.length (); i++)
02962 elem (i, i) += a.elem (i, i);
02963
02964 return *this;
02965 }
02966
02967 ComplexMatrix&
02968 ComplexMatrix::operator -= (const DiagMatrix& a)
02969 {
02970 octave_idx_type nr = rows ();
02971 octave_idx_type nc = cols ();
02972
02973 octave_idx_type a_nr = rows ();
02974 octave_idx_type a_nc = cols ();
02975
02976 if (nr != a_nr || nc != a_nc)
02977 {
02978 gripe_nonconformant ("operator -=", nr, nc, a_nr, a_nc);
02979 return *this;
02980 }
02981
02982 for (octave_idx_type i = 0; i < a.length (); i++)
02983 elem (i, i) -= a.elem (i, i);
02984
02985 return *this;
02986 }
02987
02988 ComplexMatrix&
02989 ComplexMatrix::operator += (const ComplexDiagMatrix& a)
02990 {
02991 octave_idx_type nr = rows ();
02992 octave_idx_type nc = cols ();
02993
02994 octave_idx_type a_nr = rows ();
02995 octave_idx_type a_nc = cols ();
02996
02997 if (nr != a_nr || nc != a_nc)
02998 {
02999 gripe_nonconformant ("operator +=", nr, nc, a_nr, a_nc);
03000 return *this;
03001 }
03002
03003 for (octave_idx_type i = 0; i < a.length (); i++)
03004 elem (i, i) += a.elem (i, i);
03005
03006 return *this;
03007 }
03008
03009 ComplexMatrix&
03010 ComplexMatrix::operator -= (const ComplexDiagMatrix& a)
03011 {
03012 octave_idx_type nr = rows ();
03013 octave_idx_type nc = cols ();
03014
03015 octave_idx_type a_nr = rows ();
03016 octave_idx_type a_nc = cols ();
03017
03018 if (nr != a_nr || nc != a_nc)
03019 {
03020 gripe_nonconformant ("operator -=", nr, nc, a_nr, a_nc);
03021 return *this;
03022 }
03023
03024 for (octave_idx_type i = 0; i < a.length (); i++)
03025 elem (i, i) -= a.elem (i, i);
03026
03027 return *this;
03028 }
03029
03030
03031
03032 ComplexMatrix&
03033 ComplexMatrix::operator += (const Matrix& a)
03034 {
03035 octave_idx_type nr = rows ();
03036 octave_idx_type nc = cols ();
03037
03038 octave_idx_type a_nr = a.rows ();
03039 octave_idx_type a_nc = a.cols ();
03040
03041 if (nr != a_nr || nc != a_nc)
03042 {
03043 gripe_nonconformant ("operator +=", nr, nc, a_nr, a_nc);
03044 return *this;
03045 }
03046
03047 if (nr == 0 || nc == 0)
03048 return *this;
03049
03050 Complex *d = fortran_vec ();
03051
03052 mx_inline_add2 (length (), d, a.data ());
03053 return *this;
03054 }
03055
03056 ComplexMatrix&
03057 ComplexMatrix::operator -= (const Matrix& a)
03058 {
03059 octave_idx_type nr = rows ();
03060 octave_idx_type nc = cols ();
03061
03062 octave_idx_type a_nr = a.rows ();
03063 octave_idx_type a_nc = a.cols ();
03064
03065 if (nr != a_nr || nc != a_nc)
03066 {
03067 gripe_nonconformant ("operator -=", nr, nc, a_nr, a_nc);
03068 return *this;
03069 }
03070
03071 if (nr == 0 || nc == 0)
03072 return *this;
03073
03074 Complex *d = fortran_vec ();
03075
03076 mx_inline_sub2 (length (), d, a.data ());
03077 return *this;
03078 }
03079
03080
03081
03082 boolMatrix
03083 ComplexMatrix::operator ! (void) const
03084 {
03085 if (any_element_is_nan ())
03086 gripe_nan_to_logical_conversion ();
03087
03088 return do_mx_unary_op<bool, Complex> (*this, mx_inline_not);
03089 }
03090
03091
03092
03093 bool
03094 ComplexMatrix::any_element_is_nan (void) const
03095 {
03096 return do_mx_check<Complex> (*this, mx_inline_any_nan);
03097 }
03098
03099 bool
03100 ComplexMatrix::any_element_is_inf_or_nan (void) const
03101 {
03102 return ! do_mx_check<Complex> (*this, mx_inline_all_finite);
03103 }
03104
03105
03106
03107 bool
03108 ComplexMatrix::all_elements_are_real (void) const
03109 {
03110 return do_mx_check<Complex> (*this, mx_inline_all_real);
03111 }
03112
03113
03114
03115
03116
03117 bool
03118 ComplexMatrix::all_integers (double& max_val, double& min_val) const
03119 {
03120 octave_idx_type nr = rows ();
03121 octave_idx_type nc = cols ();
03122
03123 if (nr > 0 && nc > 0)
03124 {
03125 Complex val = elem (0, 0);
03126
03127 double r_val = std::real (val);
03128 double i_val = std::imag (val);
03129
03130 max_val = r_val;
03131 min_val = r_val;
03132
03133 if (i_val > max_val)
03134 max_val = i_val;
03135
03136 if (i_val < max_val)
03137 min_val = i_val;
03138 }
03139 else
03140 return false;
03141
03142 for (octave_idx_type j = 0; j < nc; j++)
03143 for (octave_idx_type i = 0; i < nr; i++)
03144 {
03145 Complex val = elem (i, j);
03146
03147 double r_val = std::real (val);
03148 double i_val = std::imag (val);
03149
03150 if (r_val > max_val)
03151 max_val = r_val;
03152
03153 if (i_val > max_val)
03154 max_val = i_val;
03155
03156 if (r_val < min_val)
03157 min_val = r_val;
03158
03159 if (i_val < min_val)
03160 min_val = i_val;
03161
03162 if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val)
03163 return false;
03164 }
03165
03166 return true;
03167 }
03168
03169 bool
03170 ComplexMatrix::too_large_for_float (void) const
03171 {
03172 octave_idx_type nr = rows ();
03173 octave_idx_type nc = cols ();
03174
03175 for (octave_idx_type j = 0; j < nc; j++)
03176 for (octave_idx_type i = 0; i < nr; i++)
03177 {
03178 Complex val = elem (i, j);
03179
03180 double r_val = std::real (val);
03181 double i_val = std::imag (val);
03182
03183 if ((! (xisnan (r_val) || xisinf (r_val))
03184 && fabs (r_val) > FLT_MAX)
03185 || (! (xisnan (i_val) || xisinf (i_val))
03186 && fabs (i_val) > FLT_MAX))
03187 return true;
03188 }
03189
03190 return false;
03191 }
03192
03193
03194
03195
03196 boolMatrix
03197 ComplexMatrix::all (int dim) const
03198 {
03199 return do_mx_red_op<bool, Complex> (*this, dim, mx_inline_all);
03200 }
03201
03202 boolMatrix
03203 ComplexMatrix::any (int dim) const
03204 {
03205 return do_mx_red_op<bool, Complex> (*this, dim, mx_inline_any);
03206 }
03207
03208 ComplexMatrix
03209 ComplexMatrix::cumprod (int dim) const
03210 {
03211 return do_mx_cum_op<Complex, Complex> (*this, dim, mx_inline_cumprod);
03212 }
03213
03214 ComplexMatrix
03215 ComplexMatrix::cumsum (int dim) const
03216 {
03217 return do_mx_cum_op<Complex, Complex> (*this, dim, mx_inline_cumsum);
03218 }
03219
03220 ComplexMatrix
03221 ComplexMatrix::prod (int dim) const
03222 {
03223 return do_mx_red_op<Complex, Complex> (*this, dim, mx_inline_prod);
03224 }
03225
03226 ComplexMatrix
03227 ComplexMatrix::sum (int dim) const
03228 {
03229 return do_mx_red_op<Complex, Complex> (*this, dim, mx_inline_sum);
03230 }
03231
03232 ComplexMatrix
03233 ComplexMatrix::sumsq (int dim) const
03234 {
03235 return do_mx_red_op<double, Complex> (*this, dim, mx_inline_sumsq);
03236 }
03237
03238 Matrix ComplexMatrix::abs (void) const
03239 {
03240 return do_mx_unary_map<double, Complex, std::abs> (*this);
03241 }
03242
03243 ComplexMatrix
03244 ComplexMatrix::diag (octave_idx_type k) const
03245 {
03246 return MArray<Complex>::diag (k);
03247 }
03248
03249 bool
03250 ComplexMatrix::row_is_real_only (octave_idx_type i) const
03251 {
03252 bool retval = true;
03253
03254 octave_idx_type nc = columns ();
03255
03256 for (octave_idx_type j = 0; j < nc; j++)
03257 {
03258 if (std::imag (elem (i, j)) != 0.0)
03259 {
03260 retval = false;
03261 break;
03262 }
03263 }
03264
03265 return retval;
03266 }
03267
03268 bool
03269 ComplexMatrix::column_is_real_only (octave_idx_type j) const
03270 {
03271 bool retval = true;
03272
03273 octave_idx_type nr = rows ();
03274
03275 for (octave_idx_type i = 0; i < nr; i++)
03276 {
03277 if (std::imag (elem (i, j)) != 0.0)
03278 {
03279 retval = false;
03280 break;
03281 }
03282 }
03283
03284 return retval;
03285 }
03286
03287 ComplexColumnVector
03288 ComplexMatrix::row_min (void) const
03289 {
03290 Array<octave_idx_type> dummy_idx;
03291 return row_min (dummy_idx);
03292 }
03293
03294 ComplexColumnVector
03295 ComplexMatrix::row_min (Array<octave_idx_type>& idx_arg) const
03296 {
03297 ComplexColumnVector result;
03298
03299 octave_idx_type nr = rows ();
03300 octave_idx_type nc = cols ();
03301
03302 if (nr > 0 && nc > 0)
03303 {
03304 result.resize (nr);
03305 idx_arg.resize (dim_vector (nr, 1));
03306
03307 for (octave_idx_type i = 0; i < nr; i++)
03308 {
03309 bool real_only = row_is_real_only (i);
03310
03311 octave_idx_type idx_j;
03312
03313 Complex tmp_min;
03314
03315 double abs_min = octave_NaN;
03316
03317 for (idx_j = 0; idx_j < nc; idx_j++)
03318 {
03319 tmp_min = elem (i, idx_j);
03320
03321 if (! xisnan (tmp_min))
03322 {
03323 abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min);
03324 break;
03325 }
03326 }
03327
03328 for (octave_idx_type j = idx_j+1; j < nc; j++)
03329 {
03330 Complex tmp = elem (i, j);
03331
03332 if (xisnan (tmp))
03333 continue;
03334
03335 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp);
03336
03337 if (abs_tmp < abs_min)
03338 {
03339 idx_j = j;
03340 tmp_min = tmp;
03341 abs_min = abs_tmp;
03342 }
03343 }
03344
03345 if (xisnan (tmp_min))
03346 {
03347 result.elem (i) = Complex_NaN_result;
03348 idx_arg.elem (i) = 0;
03349 }
03350 else
03351 {
03352 result.elem (i) = tmp_min;
03353 idx_arg.elem (i) = idx_j;
03354 }
03355 }
03356 }
03357
03358 return result;
03359 }
03360
03361 ComplexColumnVector
03362 ComplexMatrix::row_max (void) const
03363 {
03364 Array<octave_idx_type> dummy_idx;
03365 return row_max (dummy_idx);
03366 }
03367
03368 ComplexColumnVector
03369 ComplexMatrix::row_max (Array<octave_idx_type>& idx_arg) const
03370 {
03371 ComplexColumnVector result;
03372
03373 octave_idx_type nr = rows ();
03374 octave_idx_type nc = cols ();
03375
03376 if (nr > 0 && nc > 0)
03377 {
03378 result.resize (nr);
03379 idx_arg.resize (dim_vector (nr, 1));
03380
03381 for (octave_idx_type i = 0; i < nr; i++)
03382 {
03383 bool real_only = row_is_real_only (i);
03384
03385 octave_idx_type idx_j;
03386
03387 Complex tmp_max;
03388
03389 double abs_max = octave_NaN;
03390
03391 for (idx_j = 0; idx_j < nc; idx_j++)
03392 {
03393 tmp_max = elem (i, idx_j);
03394
03395 if (! xisnan (tmp_max))
03396 {
03397 abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max);
03398 break;
03399 }
03400 }
03401
03402 for (octave_idx_type j = idx_j+1; j < nc; j++)
03403 {
03404 Complex tmp = elem (i, j);
03405
03406 if (xisnan (tmp))
03407 continue;
03408
03409 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp);
03410
03411 if (abs_tmp > abs_max)
03412 {
03413 idx_j = j;
03414 tmp_max = tmp;
03415 abs_max = abs_tmp;
03416 }
03417 }
03418
03419 if (xisnan (tmp_max))
03420 {
03421 result.elem (i) = Complex_NaN_result;
03422 idx_arg.elem (i) = 0;
03423 }
03424 else
03425 {
03426 result.elem (i) = tmp_max;
03427 idx_arg.elem (i) = idx_j;
03428 }
03429 }
03430 }
03431
03432 return result;
03433 }
03434
03435 ComplexRowVector
03436 ComplexMatrix::column_min (void) const
03437 {
03438 Array<octave_idx_type> dummy_idx;
03439 return column_min (dummy_idx);
03440 }
03441
03442 ComplexRowVector
03443 ComplexMatrix::column_min (Array<octave_idx_type>& idx_arg) const
03444 {
03445 ComplexRowVector result;
03446
03447 octave_idx_type nr = rows ();
03448 octave_idx_type nc = cols ();
03449
03450 if (nr > 0 && nc > 0)
03451 {
03452 result.resize (nc);
03453 idx_arg.resize (dim_vector (1, nc));
03454
03455 for (octave_idx_type j = 0; j < nc; j++)
03456 {
03457 bool real_only = column_is_real_only (j);
03458
03459 octave_idx_type idx_i;
03460
03461 Complex tmp_min;
03462
03463 double abs_min = octave_NaN;
03464
03465 for (idx_i = 0; idx_i < nr; idx_i++)
03466 {
03467 tmp_min = elem (idx_i, j);
03468
03469 if (! xisnan (tmp_min))
03470 {
03471 abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min);
03472 break;
03473 }
03474 }
03475
03476 for (octave_idx_type i = idx_i+1; i < nr; i++)
03477 {
03478 Complex tmp = elem (i, j);
03479
03480 if (xisnan (tmp))
03481 continue;
03482
03483 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp);
03484
03485 if (abs_tmp < abs_min)
03486 {
03487 idx_i = i;
03488 tmp_min = tmp;
03489 abs_min = abs_tmp;
03490 }
03491 }
03492
03493 if (xisnan (tmp_min))
03494 {
03495 result.elem (j) = Complex_NaN_result;
03496 idx_arg.elem (j) = 0;
03497 }
03498 else
03499 {
03500 result.elem (j) = tmp_min;
03501 idx_arg.elem (j) = idx_i;
03502 }
03503 }
03504 }
03505
03506 return result;
03507 }
03508
03509 ComplexRowVector
03510 ComplexMatrix::column_max (void) const
03511 {
03512 Array<octave_idx_type> dummy_idx;
03513 return column_max (dummy_idx);
03514 }
03515
03516 ComplexRowVector
03517 ComplexMatrix::column_max (Array<octave_idx_type>& idx_arg) const
03518 {
03519 ComplexRowVector result;
03520
03521 octave_idx_type nr = rows ();
03522 octave_idx_type nc = cols ();
03523
03524 if (nr > 0 && nc > 0)
03525 {
03526 result.resize (nc);
03527 idx_arg.resize (dim_vector (1, nc));
03528
03529 for (octave_idx_type j = 0; j < nc; j++)
03530 {
03531 bool real_only = column_is_real_only (j);
03532
03533 octave_idx_type idx_i;
03534
03535 Complex tmp_max;
03536
03537 double abs_max = octave_NaN;
03538
03539 for (idx_i = 0; idx_i < nr; idx_i++)
03540 {
03541 tmp_max = elem (idx_i, j);
03542
03543 if (! xisnan (tmp_max))
03544 {
03545 abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max);
03546 break;
03547 }
03548 }
03549
03550 for (octave_idx_type i = idx_i+1; i < nr; i++)
03551 {
03552 Complex tmp = elem (i, j);
03553
03554 if (xisnan (tmp))
03555 continue;
03556
03557 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp);
03558
03559 if (abs_tmp > abs_max)
03560 {
03561 idx_i = i;
03562 tmp_max = tmp;
03563 abs_max = abs_tmp;
03564 }
03565 }
03566
03567 if (xisnan (tmp_max))
03568 {
03569 result.elem (j) = Complex_NaN_result;
03570 idx_arg.elem (j) = 0;
03571 }
03572 else
03573 {
03574 result.elem (j) = tmp_max;
03575 idx_arg.elem (j) = idx_i;
03576 }
03577 }
03578 }
03579
03580 return result;
03581 }
03582
03583
03584
03585 std::ostream&
03586 operator << (std::ostream& os, const ComplexMatrix& a)
03587 {
03588 for (octave_idx_type i = 0; i < a.rows (); i++)
03589 {
03590 for (octave_idx_type j = 0; j < a.cols (); j++)
03591 {
03592 os << " ";
03593 octave_write_complex (os, a.elem (i, j));
03594 }
03595 os << "\n";
03596 }
03597 return os;
03598 }
03599
03600 std::istream&
03601 operator >> (std::istream& is, ComplexMatrix& a)
03602 {
03603 octave_idx_type nr = a.rows ();
03604 octave_idx_type nc = a.cols ();
03605
03606 if (nr > 0 && nc > 0)
03607 {
03608 Complex tmp;
03609 for (octave_idx_type i = 0; i < nr; i++)
03610 for (octave_idx_type j = 0; j < nc; j++)
03611 {
03612 tmp = octave_read_value<Complex> (is);
03613 if (is)
03614 a.elem (i, j) = tmp;
03615 else
03616 goto done;
03617 }
03618 }
03619
03620 done:
03621
03622 return is;
03623 }
03624
03625 ComplexMatrix
03626 Givens (const Complex& x, const Complex& y)
03627 {
03628 double cc;
03629 Complex cs, temp_r;
03630
03631 F77_FUNC (zlartg, ZLARTG) (x, y, cc, cs, temp_r);
03632
03633 ComplexMatrix g (2, 2);
03634
03635 g.elem (0, 0) = cc;
03636 g.elem (1, 1) = cc;
03637 g.elem (0, 1) = cs;
03638 g.elem (1, 0) = -conj (cs);
03639
03640 return g;
03641 }
03642
03643 ComplexMatrix
03644 Sylvester (const ComplexMatrix& a, const ComplexMatrix& b,
03645 const ComplexMatrix& c)
03646 {
03647 ComplexMatrix retval;
03648
03649
03650
03651
03652
03653
03654 ComplexSCHUR as (a, "U");
03655 ComplexSCHUR bs (b, "U");
03656
03657
03658
03659 ComplexMatrix ua = as.unitary_matrix ();
03660 ComplexMatrix sch_a = as.schur_matrix ();
03661
03662 ComplexMatrix ub = bs.unitary_matrix ();
03663 ComplexMatrix sch_b = bs.schur_matrix ();
03664
03665 ComplexMatrix cx = ua.hermitian () * c * ub;
03666
03667
03668
03669
03670 octave_idx_type a_nr = a.rows ();
03671 octave_idx_type b_nr = b.rows ();
03672
03673 double scale;
03674 octave_idx_type info;
03675
03676 Complex *pa = sch_a.fortran_vec ();
03677 Complex *pb = sch_b.fortran_vec ();
03678 Complex *px = cx.fortran_vec ();
03679
03680 F77_XFCN (ztrsyl, ZTRSYL, (F77_CONST_CHAR_ARG2 ("N", 1),
03681 F77_CONST_CHAR_ARG2 ("N", 1),
03682 1, a_nr, b_nr, pa, a_nr, pb,
03683 b_nr, px, a_nr, scale, info
03684 F77_CHAR_ARG_LEN (1)
03685 F77_CHAR_ARG_LEN (1)));
03686
03687
03688
03689 retval = -ua * cx * ub.hermitian ();
03690
03691 return retval;
03692 }
03693
03694 ComplexMatrix
03695 operator * (const ComplexMatrix& m, const Matrix& a)
03696 {
03697 if (m.columns () > std::min (m.rows (), a.columns ()) / 10)
03698 return ComplexMatrix (real (m) * a, imag (m) * a);
03699 else
03700 return m * ComplexMatrix (a);
03701 }
03702
03703 ComplexMatrix
03704 operator * (const Matrix& m, const ComplexMatrix& a)
03705 {
03706 if (a.rows () > std::min (m.rows (), a.columns ()) / 10)
03707 return ComplexMatrix (m * real (a), m * imag (a));
03708 else
03709 return ComplexMatrix (m) * a;
03710 }
03711
03712
03713
03714
03715
03716
03717
03718
03719
03720
03721
03722
03723
03724
03725
03726
03727
03728
03729
03730
03731
03732
03733 static inline char
03734 get_blas_trans_arg (bool trans, bool conj)
03735 {
03736 return trans ? (conj ? 'C' : 'T') : 'N';
03737 }
03738
03739
03740
03741 ComplexMatrix
03742 xgemm (const ComplexMatrix& a, const ComplexMatrix& b,
03743 blas_trans_type transa, blas_trans_type transb)
03744 {
03745 ComplexMatrix retval;
03746
03747 bool tra = transa != blas_no_trans, trb = transb != blas_no_trans;
03748 bool cja = transa == blas_conj_trans, cjb = transb == blas_conj_trans;
03749
03750 octave_idx_type a_nr = tra ? a.cols () : a.rows ();
03751 octave_idx_type a_nc = tra ? a.rows () : a.cols ();
03752
03753 octave_idx_type b_nr = trb ? b.cols () : b.rows ();
03754 octave_idx_type b_nc = trb ? b.rows () : b.cols ();
03755
03756 if (a_nc != b_nr)
03757 gripe_nonconformant ("operator *", a_nr, a_nc, b_nr, b_nc);
03758 else
03759 {
03760 if (a_nr == 0 || a_nc == 0 || b_nc == 0)
03761 retval = ComplexMatrix (a_nr, b_nc, 0.0);
03762 else if (a.data () == b.data () && a_nr == b_nc && tra != trb)
03763 {
03764 octave_idx_type lda = a.rows ();
03765
03766
03767
03768
03769
03770
03771 retval = ComplexMatrix (a_nr, b_nc, 0.0);
03772 Complex *c = retval.fortran_vec ();
03773
03774 const char ctra = get_blas_trans_arg (tra, cja);
03775 if (cja || cjb)
03776 {
03777 F77_XFCN (zherk, ZHERK, (F77_CONST_CHAR_ARG2 ("U", 1),
03778 F77_CONST_CHAR_ARG2 (&ctra, 1),
03779 a_nr, a_nc, 1.0,
03780 a.data (), lda, 0.0, c, a_nr
03781 F77_CHAR_ARG_LEN (1)
03782 F77_CHAR_ARG_LEN (1)));
03783 for (octave_idx_type j = 0; j < a_nr; j++)
03784 for (octave_idx_type i = 0; i < j; i++)
03785 retval.xelem (j,i) = std::conj (retval.xelem (i,j));
03786 }
03787 else
03788 {
03789 F77_XFCN (zsyrk, ZSYRK, (F77_CONST_CHAR_ARG2 ("U", 1),
03790 F77_CONST_CHAR_ARG2 (&ctra, 1),
03791 a_nr, a_nc, 1.0,
03792 a.data (), lda, 0.0, c, a_nr
03793 F77_CHAR_ARG_LEN (1)
03794 F77_CHAR_ARG_LEN (1)));
03795 for (octave_idx_type j = 0; j < a_nr; j++)
03796 for (octave_idx_type i = 0; i < j; i++)
03797 retval.xelem (j,i) = retval.xelem (i,j);
03798
03799 }
03800
03801 }
03802 else
03803 {
03804 octave_idx_type lda = a.rows (), tda = a.cols ();
03805 octave_idx_type ldb = b.rows (), tdb = b.cols ();
03806
03807 retval = ComplexMatrix (a_nr, b_nc, 0.0);
03808 Complex *c = retval.fortran_vec ();
03809
03810 if (b_nc == 1 && a_nr == 1)
03811 {
03812 if (cja == cjb)
03813 {
03814 F77_FUNC (xzdotu, XZDOTU) (a_nc, a.data (), 1, b.data (), 1, *c);
03815 if (cja) *c = std::conj (*c);
03816 }
03817 else if (cja)
03818 F77_FUNC (xzdotc, XZDOTC) (a_nc, a.data (), 1, b.data (), 1, *c);
03819 else
03820 F77_FUNC (xzdotc, XZDOTC) (a_nc, b.data (), 1, a.data (), 1, *c);
03821 }
03822 else if (b_nc == 1 && ! cjb)
03823 {
03824 const char ctra = get_blas_trans_arg (tra, cja);
03825 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (&ctra, 1),
03826 lda, tda, 1.0, a.data (), lda,
03827 b.data (), 1, 0.0, c, 1
03828 F77_CHAR_ARG_LEN (1)));
03829 }
03830 else if (a_nr == 1 && ! cja && ! cjb)
03831 {
03832 const char crevtrb = get_blas_trans_arg (! trb, cjb);
03833 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (&crevtrb, 1),
03834 ldb, tdb, 1.0, b.data (), ldb,
03835 a.data (), 1, 0.0, c, 1
03836 F77_CHAR_ARG_LEN (1)));
03837 }
03838 else
03839 {
03840 const char ctra = get_blas_trans_arg (tra, cja);
03841 const char ctrb = get_blas_trans_arg (trb, cjb);
03842 F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 (&ctra, 1),
03843 F77_CONST_CHAR_ARG2 (&ctrb, 1),
03844 a_nr, b_nc, a_nc, 1.0, a.data (),
03845 lda, b.data (), ldb, 0.0, c, a_nr
03846 F77_CHAR_ARG_LEN (1)
03847 F77_CHAR_ARG_LEN (1)));
03848 }
03849 }
03850 }
03851
03852 return retval;
03853 }
03854
03855 ComplexMatrix
03856 operator * (const ComplexMatrix& a, const ComplexMatrix& b)
03857 {
03858 return xgemm (a, b);
03859 }
03860
03861
03862
03863
03864 #define EMPTY_RETURN_CHECK(T) \
03865 if (nr == 0 || nc == 0) \
03866 return T (nr, nc);
03867
03868 ComplexMatrix
03869 min (const Complex& c, const ComplexMatrix& m)
03870 {
03871 octave_idx_type nr = m.rows ();
03872 octave_idx_type nc = m.columns ();
03873
03874 EMPTY_RETURN_CHECK (ComplexMatrix);
03875
03876 ComplexMatrix result (nr, nc);
03877
03878 for (octave_idx_type j = 0; j < nc; j++)
03879 for (octave_idx_type i = 0; i < nr; i++)
03880 {
03881 octave_quit ();
03882 result (i, j) = xmin (c, m (i, j));
03883 }
03884
03885 return result;
03886 }
03887
03888 ComplexMatrix
03889 min (const ComplexMatrix& m, const Complex& c)
03890 {
03891 octave_idx_type nr = m.rows ();
03892 octave_idx_type nc = m.columns ();
03893
03894 EMPTY_RETURN_CHECK (ComplexMatrix);
03895
03896 ComplexMatrix result (nr, nc);
03897
03898 for (octave_idx_type j = 0; j < nc; j++)
03899 for (octave_idx_type i = 0; i < nr; i++)
03900 {
03901 octave_quit ();
03902 result (i, j) = xmin (m (i, j), c);
03903 }
03904
03905 return result;
03906 }
03907
03908 ComplexMatrix
03909 min (const ComplexMatrix& a, const ComplexMatrix& b)
03910 {
03911 octave_idx_type nr = a.rows ();
03912 octave_idx_type nc = a.columns ();
03913
03914 if (nr != b.rows () || nc != b.columns ())
03915 {
03916 (*current_liboctave_error_handler)
03917 ("two-arg min expecting args of same size");
03918 return ComplexMatrix ();
03919 }
03920
03921 EMPTY_RETURN_CHECK (ComplexMatrix);
03922
03923 ComplexMatrix result (nr, nc);
03924
03925 for (octave_idx_type j = 0; j < nc; j++)
03926 {
03927 int columns_are_real_only = 1;
03928 for (octave_idx_type i = 0; i < nr; i++)
03929 {
03930 octave_quit ();
03931 if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0)
03932 {
03933 columns_are_real_only = 0;
03934 break;
03935 }
03936 }
03937
03938 if (columns_are_real_only)
03939 {
03940 for (octave_idx_type i = 0; i < nr; i++)
03941 result (i, j) = xmin (std::real (a (i, j)), std::real (b (i, j)));
03942 }
03943 else
03944 {
03945 for (octave_idx_type i = 0; i < nr; i++)
03946 {
03947 octave_quit ();
03948 result (i, j) = xmin (a (i, j), b (i, j));
03949 }
03950 }
03951 }
03952
03953 return result;
03954 }
03955
03956 ComplexMatrix
03957 max (const Complex& c, const ComplexMatrix& m)
03958 {
03959 octave_idx_type nr = m.rows ();
03960 octave_idx_type nc = m.columns ();
03961
03962 EMPTY_RETURN_CHECK (ComplexMatrix);
03963
03964 ComplexMatrix result (nr, nc);
03965
03966 for (octave_idx_type j = 0; j < nc; j++)
03967 for (octave_idx_type i = 0; i < nr; i++)
03968 {
03969 octave_quit ();
03970 result (i, j) = xmax (c, m (i, j));
03971 }
03972
03973 return result;
03974 }
03975
03976 ComplexMatrix
03977 max (const ComplexMatrix& m, const Complex& c)
03978 {
03979 octave_idx_type nr = m.rows ();
03980 octave_idx_type nc = m.columns ();
03981
03982 EMPTY_RETURN_CHECK (ComplexMatrix);
03983
03984 ComplexMatrix result (nr, nc);
03985
03986 for (octave_idx_type j = 0; j < nc; j++)
03987 for (octave_idx_type i = 0; i < nr; i++)
03988 {
03989 octave_quit ();
03990 result (i, j) = xmax (m (i, j), c);
03991 }
03992
03993 return result;
03994 }
03995
03996 ComplexMatrix
03997 max (const ComplexMatrix& a, const ComplexMatrix& b)
03998 {
03999 octave_idx_type nr = a.rows ();
04000 octave_idx_type nc = a.columns ();
04001
04002 if (nr != b.rows () || nc != b.columns ())
04003 {
04004 (*current_liboctave_error_handler)
04005 ("two-arg max expecting args of same size");
04006 return ComplexMatrix ();
04007 }
04008
04009 EMPTY_RETURN_CHECK (ComplexMatrix);
04010
04011 ComplexMatrix result (nr, nc);
04012
04013 for (octave_idx_type j = 0; j < nc; j++)
04014 {
04015 int columns_are_real_only = 1;
04016 for (octave_idx_type i = 0; i < nr; i++)
04017 {
04018 octave_quit ();
04019 if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0)
04020 {
04021 columns_are_real_only = 0;
04022 break;
04023 }
04024 }
04025
04026 if (columns_are_real_only)
04027 {
04028 for (octave_idx_type i = 0; i < nr; i++)
04029 {
04030 octave_quit ();
04031 result (i, j) = xmax (std::real (a (i, j)), std::real (b (i, j)));
04032 }
04033 }
04034 else
04035 {
04036 for (octave_idx_type i = 0; i < nr; i++)
04037 {
04038 octave_quit ();
04039 result (i, j) = xmax (a (i, j), b (i, j));
04040 }
04041 }
04042 }
04043
04044 return result;
04045 }
04046
04047 ComplexMatrix linspace (const ComplexColumnVector& x1,
04048 const ComplexColumnVector& x2,
04049 octave_idx_type n)
04050
04051 {
04052 if (n < 1) n = 1;
04053
04054 octave_idx_type m = x1.length ();
04055
04056 if (x2.length () != m)
04057 (*current_liboctave_error_handler) ("linspace: vectors must be of equal length");
04058
04059 NoAlias<ComplexMatrix> retval;
04060
04061 retval.clear (m, n);
04062 for (octave_idx_type i = 0; i < m; i++)
04063 retval(i, 0) = x1(i);
04064
04065
04066 Complex *delta = &retval(0, n-1);
04067 for (octave_idx_type i = 0; i < m; i++)
04068 delta[i] = (x2(i) - x1(i)) / (n - 1.0);
04069
04070 for (octave_idx_type j = 1; j < n-1; j++)
04071 for (octave_idx_type i = 0; i < m; i++)
04072 retval(i, j) = x1(i) + static_cast<double> (j)*delta[i];
04073
04074 for (octave_idx_type i = 0; i < m; i++)
04075 retval(i, n-1) = x2(i);
04076
04077 return retval;
04078 }
04079
04080 MS_CMP_OPS (ComplexMatrix, Complex)
04081 MS_BOOL_OPS (ComplexMatrix, Complex)
04082
04083 SM_CMP_OPS (Complex, ComplexMatrix)
04084 SM_BOOL_OPS (Complex, ComplexMatrix)
04085
04086 MM_CMP_OPS (ComplexMatrix, ComplexMatrix)
04087 MM_BOOL_OPS (ComplexMatrix, ComplexMatrix)