Mercurial > hg > octave-nkf
annotate liboctave/dbleAEPBAL.cc @ 14684:23149db50468 stable
3.6.2-rc1 release candidate
* configure.ac (AC_INIT): Version is now 3.6.2-rc1.
(OCTAVE_RELEASE_DATE): Now 2012-05-24.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Thu, 24 May 2012 12:19:04 -0400 |
parents | 72c96de7a403 |
children |
rev | line source |
---|---|
457 | 1 /* |
2 | |
14138
72c96de7a403
maint: update copyright notices for 2012
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
3 Copyright (C) 1994-2012 John W. Eaton |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
4 Copyright (C) 2008 Jaroslav Hajek |
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 "dbleAEPBAL.h" |
1847 | 31 #include "f77-fcn.h" |
457 | 32 |
33 extern "C" | |
34 { | |
4552 | 35 F77_RET_T |
36 F77_FUNC (dgebal, DGEBAL) (F77_CONST_CHAR_ARG_DECL, | |
11518 | 37 const octave_idx_type&, double*, |
38 const octave_idx_type&, octave_idx_type&, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
39 octave_idx_type&, double*, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
40 F77_CHAR_ARG_LEN_DECL); |
457 | 41 |
4552 | 42 F77_RET_T |
43 F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
44 F77_CONST_CHAR_ARG_DECL, |
11518 | 45 const octave_idx_type&, const octave_idx_type&, |
46 const octave_idx_type&, const double*, | |
47 const octave_idx_type&, double*, | |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
48 const octave_idx_type&, octave_idx_type& |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
49 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
50 F77_CHAR_ARG_LEN_DECL); |
457 | 51 } |
52 | |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
53 AEPBALANCE::AEPBALANCE (const Matrix& a, bool noperm, bool noscal) |
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
54 : base_aepbal<Matrix, ColumnVector> () |
457 | 55 { |
5275 | 56 octave_idx_type n = a.cols (); |
1730 | 57 |
1933 | 58 if (a.rows () != n) |
457 | 59 { |
60 (*current_liboctave_error_handler) ("AEPBALANCE requires square matrix"); | |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
61 return; |
457 | 62 } |
63 | |
5275 | 64 octave_idx_type info; |
457 | 65 |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
66 scale = ColumnVector (n); |
1933 | 67 double *pscale = scale.fortran_vec (); |
457 | 68 |
69 balanced_mat = a; | |
1933 | 70 double *p_balanced_mat = balanced_mat.fortran_vec (); |
1730 | 71 |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
72 job = noperm ? (noscal ? 'N' : 'S') : (noscal ? 'P' : 'B'); |
457 | 73 |
4552 | 74 F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
75 n, p_balanced_mat, n, ilo, ihi, pscale, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
76 F77_CHAR_ARG_LEN (1))); |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
77 } |
457 | 78 |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
79 Matrix |
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
80 AEPBALANCE::balancing_matrix (void) const |
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
81 { |
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
82 octave_idx_type n = balanced_mat.rows (); |
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
83 Matrix balancing_mat (n, n, 0.0); |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
84 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
|
85 balancing_mat.elem (i ,i) = 1.0; |
457 | 86 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
87 double *p_balancing_mat = balancing_mat.fortran_vec (); |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
88 const double *pscale = scale.fortran_vec (); |
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
89 |
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
90 octave_idx_type info; |
1933 | 91 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
92 char side = 'R'; |
457 | 93 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
94 F77_XFCN (dgebak, DGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
95 F77_CONST_CHAR_ARG2 (&side, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
96 n, ilo, ihi, pscale, n, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
97 p_balancing_mat, n, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
98 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
99 F77_CHAR_ARG_LEN (1))); |
457 | 100 |
8386
a5e080076778
make balance more Matlab-compatible
Jaroslav Hajek <highegg@gmail.com>
parents:
7482
diff
changeset
|
101 return balancing_mat; |
457 | 102 } |