Mercurial > hg > octave-lyh
annotate liboctave/CmplxAEPBAL.cc @ 8367:445d27d79f4e
support permutation matrix objects
| author | Jaroslav Hajek <highegg@gmail.com> |
|---|---|
| date | Thu, 04 Dec 2008 08:31:56 +0100 |
| parents | 29980c6b8604 |
| children | a5e080076778 |
| rev | line source |
|---|---|
| 457 | 1 /* |
| 2 | |
| 7017 | 3 Copyright (C) 1994, 1995, 1996, 1997, 2000, 2002, 2003, 2004, 2005, |
| 4 2007 John W. Eaton | |
| 457 | 5 |
| 6 This file is part of Octave. | |
| 7 | |
| 8 Octave is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
| 11 option) any later version. | |
| 457 | 12 |
| 13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 7016 | 19 along with Octave; see the file COPYING. If not, see |
| 20 <http://www.gnu.org/licenses/>. | |
| 457 | 21 |
| 22 */ | |
| 23 | |
| 24 #ifdef HAVE_CONFIG_H | |
| 1192 | 25 #include <config.h> |
| 457 | 26 #endif |
| 27 | |
| 1730 | 28 #include <string> |
| 29 | |
| 457 | 30 #include "CmplxAEPBAL.h" |
| 31 #include "dMatrix.h" | |
| 1847 | 32 #include "f77-fcn.h" |
| 457 | 33 |
| 34 extern "C" | |
| 35 { | |
| 4552 | 36 F77_RET_T |
| 5275 | 37 F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
| 38 Complex*, const octave_idx_type&, | |
| 39 octave_idx_type&, octave_idx_type&, double*, | |
| 40 octave_idx_type& F77_CHAR_ARG_LEN_DECL); | |
| 457 | 41 |
| 4552 | 42 F77_RET_T |
| 5275 | 43 F77_FUNC (zgebak, ZGEBAK) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, |
| 44 const octave_idx_type&, const octave_idx_type&, | |
| 45 const octave_idx_type&, double*, | |
| 46 const octave_idx_type&, Complex*, | |
| 47 const octave_idx_type&, octave_idx_type& | |
| 48 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); | |
| 457 | 49 } |
| 50 | |
| 5275 | 51 octave_idx_type |
| 3504 | 52 ComplexAEPBALANCE::init (const ComplexMatrix& a, |
| 53 const std::string& balance_job) | |
| 457 | 54 { |
| 5275 | 55 octave_idx_type n = a.cols (); |
| 457 | 56 |
| 1933 | 57 if (a.rows () != n) |
| 1730 | 58 { |
| 59 (*current_liboctave_error_handler) ("AEPBALANCE requires square matrix"); | |
| 60 return -1; | |
| 61 } | |
| 62 | |
| 5275 | 63 octave_idx_type info; |
| 64 octave_idx_type ilo; | |
| 65 octave_idx_type ihi; | |
| 457 | 66 |
| 1933 | 67 Array<double> scale (n); |
| 68 double *pscale = scale.fortran_vec (); | |
| 457 | 69 |
| 70 balanced_mat = a; | |
| 1933 | 71 Complex *p_balanced_mat = balanced_mat.fortran_vec (); |
| 1730 | 72 |
| 1933 | 73 char job = balance_job[0]; |
| 457 | 74 |
| 4552 | 75 F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), |
| 76 n, p_balanced_mat, n, ilo, ihi, | |
| 77 pscale, info | |
| 78 F77_CHAR_ARG_LEN (1))); | |
| 457 | 79 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
80 balancing_mat = ComplexMatrix (n, n, 0.0); |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
81 for (octave_idx_type i = 0; i < n; i++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
82 balancing_mat.elem (i, i) = 1.0; |
| 457 | 83 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
84 Complex *p_balancing_mat = balancing_mat.fortran_vec (); |
| 1933 | 85 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
86 char side = 'R'; |
| 457 | 87 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
88 F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
89 F77_CONST_CHAR_ARG2 (&side, 1), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
90 n, ilo, ihi, pscale, n, |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
91 p_balancing_mat, n, info |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
92 F77_CHAR_ARG_LEN (1) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
93 F77_CHAR_ARG_LEN (1))); |
| 457 | 94 |
| 95 return info; | |
| 96 } | |
| 97 | |
| 98 /* | |
| 99 ;;; Local Variables: *** | |
| 100 ;;; mode: C++ *** | |
| 101 ;;; End: *** | |
| 102 */ |