annotate libinterp/corefcn/qz.cc @ 20616:fd0efcdb3718

use new string_value method to handle value extraction errors * dirfns.cc, file-io.cc, gammainc.cc, help.cc, load-path.cc, octave-link.cc, qz.cc, regexp.cc, strfns.cc, syscalls.cc, time.cc, variables.cc: Use new string_value method.
author John W. Eaton <jwe@octave.org>
date Thu, 08 Oct 2015 19:00:51 -0400
parents f90c8372b7ba
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1 /*
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
2
19731
4197fc428c7d maint: Update copyright notices for 2015.
John W. Eaton <jwe@octave.org>
parents: 19437
diff changeset
3 Copyright (C) 1998-2015 A. S. Hodel
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
4
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
5 This file is part of Octave.
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
6
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
7 Octave is free software; you can redistribute it and/or modify it
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 5823
diff changeset
9 Free Software Foundation; either version 3 of the License, or (at your
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 5823
diff changeset
10 option) any later version.
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
11
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
12 Octave is distributed in the hope that it will be useful, but WITHOUT
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
15 for more details.
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
16
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 5823
diff changeset
18 along with Octave; see the file COPYING. If not, see
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 5823
diff changeset
19 <http://www.gnu.org/licenses/>.
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
20
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
21 */
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
22
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
23 // Generalized eigenvalue balancing via LAPACK
3911
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents: 3887
diff changeset
24
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents: 3887
diff changeset
25 // Author: A. S. Hodel <scotte@eng.auburn.edu>
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
26
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
27 #undef DEBUG
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
28 #undef DEBUG_SORT
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
29 #undef DEBUG_EIG
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
30
9786
2c279308f6ab fix includes in some src/DLD-FUNCTIONS files
John W. Eaton <jwe@octave.org>
parents: 9758
diff changeset
31 #ifdef HAVE_CONFIG_H
2c279308f6ab fix includes in some src/DLD-FUNCTIONS files
John W. Eaton <jwe@octave.org>
parents: 9758
diff changeset
32 #include <config.h>
2c279308f6ab fix includes in some src/DLD-FUNCTIONS files
John W. Eaton <jwe@octave.org>
parents: 9758
diff changeset
33 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
34
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
35 #include <cfloat>
4051
b79da8779a0e [project @ 2002-08-17 19:38:32 by jwe]
jwe
parents: 3911
diff changeset
36
3523
b80bbb43a1a9 [project @ 2000-02-02 10:25:52 by jwe]
jwe
parents: 3500
diff changeset
37 #include <iostream>
4051
b79da8779a0e [project @ 2002-08-17 19:38:32 by jwe]
jwe
parents: 3911
diff changeset
38 #include <iomanip>
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
39
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
40 #include "CmplxQRP.h"
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
41 #include "CmplxQR.h"
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
42 #include "dbleQR.h"
4153
6b96ce9f5743 [project @ 2002-11-06 20:38:49 by jwe]
jwe
parents: 4051
diff changeset
43 #include "f77-fcn.h"
7231
2eb392d058bb [project @ 2007-11-30 18:53:29 by jwe]
jwe
parents: 7017
diff changeset
44 #include "lo-math.h"
4153
6b96ce9f5743 [project @ 2002-11-06 20:38:49 by jwe]
jwe
parents: 4051
diff changeset
45 #include "quit.h"
6b96ce9f5743 [project @ 2002-11-06 20:38:49 by jwe]
jwe
parents: 4051
diff changeset
46
15039
e753177cde93 maint: Move non-dynamically linked functions from DLD-FUNCTIONS/ to corefcn/ directory
Rik <rik@octave.org>
parents: 14876
diff changeset
47 #include "defun.h"
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
48 #include "error.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
49 #include "gripes.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
50 #include "oct-obj.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
51 #include "oct-map.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
52 #include "ov.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
53 #include "pager.h"
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
54 #if defined (DEBUG) || defined (DEBUG_SORT)
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
55 #include "pr-output.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
56 #endif
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
57 #include "symtab.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
58 #include "utils.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
59 #include "variables.h"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
60
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
61 typedef octave_idx_type (*sort_function) (const octave_idx_type& LSIZE,
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
62 const double& ALPHA,
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
63 const double& BETA, const double& S,
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
64 const double& P);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
65
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
66 extern "C"
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
67 {
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
68 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
69 F77_FUNC (dggbal, DGGBAL) (F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
70 const octave_idx_type& N, double* A,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
71 const octave_idx_type& LDA, double* B,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
72 const octave_idx_type& LDB, octave_idx_type& ILO,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
73 octave_idx_type& IHI, double* LSCALE,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
74 double* RSCALE, double* WORK,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
75 octave_idx_type& INFO
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
76 F77_CHAR_ARG_LEN_DECL);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
77
19895
19755f4fc851 maint: Cleanup C++ code to follow Octave coding conventions.
Rik <rik@octave.org>
parents: 19731
diff changeset
78 F77_RET_T
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
79 F77_FUNC (zggbal, ZGGBAL) (F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
80 const octave_idx_type& N, Complex* A,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
81 const octave_idx_type& LDA, Complex* B,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
82 const octave_idx_type& LDB, octave_idx_type& ILO,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
83 octave_idx_type& IHI, double* LSCALE,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
84 double* RSCALE, double* WORK,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
85 octave_idx_type& INFO
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
86 F77_CHAR_ARG_LEN_DECL);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
87
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
88 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
89 F77_FUNC (dggbak, DGGBAK) (F77_CONST_CHAR_ARG_DECL,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
90 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
91 const octave_idx_type& N,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
92 const octave_idx_type& ILO,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
93 const octave_idx_type& IHI,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
94 const double* LSCALE, const double* RSCALE,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
95 octave_idx_type& M, double* V,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
96 const octave_idx_type& LDV, octave_idx_type& INFO
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
97 F77_CHAR_ARG_LEN_DECL
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
98 F77_CHAR_ARG_LEN_DECL);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
99
19895
19755f4fc851 maint: Cleanup C++ code to follow Octave coding conventions.
Rik <rik@octave.org>
parents: 19731
diff changeset
100 F77_RET_T
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
101 F77_FUNC (zggbak, ZGGBAK) (F77_CONST_CHAR_ARG_DECL,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
102 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
103 const octave_idx_type& N,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
104 const octave_idx_type& ILO,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
105 const octave_idx_type& IHI,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
106 const double* LSCALE, const double* RSCALE,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
107 octave_idx_type& M, Complex* V,
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
108 const octave_idx_type& LDV, octave_idx_type& INFO
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
109 F77_CHAR_ARG_LEN_DECL
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
110 F77_CHAR_ARG_LEN_DECL);
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
111
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
112 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
113 F77_FUNC (dgghrd, DGGHRD) (F77_CONST_CHAR_ARG_DECL,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
114 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
115 const octave_idx_type& N,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
116 const octave_idx_type& ILO,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
117 const octave_idx_type& IHI, double* A,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
118 const octave_idx_type& LDA, double* B,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
119 const octave_idx_type& LDB, double* Q,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
120 const octave_idx_type& LDQ, double* Z,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
121 const octave_idx_type& LDZ, octave_idx_type& INFO
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
122 F77_CHAR_ARG_LEN_DECL
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
123 F77_CHAR_ARG_LEN_DECL);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
124
19895
19755f4fc851 maint: Cleanup C++ code to follow Octave coding conventions.
Rik <rik@octave.org>
parents: 19731
diff changeset
125 F77_RET_T
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
126 F77_FUNC (zgghrd, ZGGHRD) (F77_CONST_CHAR_ARG_DECL,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
127 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
128 const octave_idx_type& N,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
129 const octave_idx_type& ILO,
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
130 const octave_idx_type& IHI, Complex* A,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
131 const octave_idx_type& LDA, Complex* B,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
132 const octave_idx_type& LDB, Complex* Q,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
133 const octave_idx_type& LDQ, Complex* Z,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
134 const octave_idx_type& LDZ, octave_idx_type& INFO
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
135 F77_CHAR_ARG_LEN_DECL
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
136 F77_CHAR_ARG_LEN_DECL);
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
137
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
138 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
139 F77_FUNC (dhgeqz, DHGEQZ) (F77_CONST_CHAR_ARG_DECL,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
140 F77_CONST_CHAR_ARG_DECL,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
141 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
142 const octave_idx_type& N,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
143 const octave_idx_type& ILO,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
144 const octave_idx_type& IHI,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
145 double* A, const octave_idx_type& LDA, double* B,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
146 const octave_idx_type& LDB, double* ALPHAR,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
147 double* ALPHAI, double* BETA, double* Q,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
148 const octave_idx_type& LDQ, double* Z,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
149 const octave_idx_type& LDZ, double* WORK,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
150 const octave_idx_type& LWORK,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
151 octave_idx_type& INFO
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
152 F77_CHAR_ARG_LEN_DECL
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
153 F77_CHAR_ARG_LEN_DECL
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
154 F77_CHAR_ARG_LEN_DECL);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
155
19895
19755f4fc851 maint: Cleanup C++ code to follow Octave coding conventions.
Rik <rik@octave.org>
parents: 19731
diff changeset
156 F77_RET_T
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
157 F77_FUNC (zhgeqz, ZHGEQZ) (F77_CONST_CHAR_ARG_DECL,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
158 F77_CONST_CHAR_ARG_DECL,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
159 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
160 const octave_idx_type& N,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
161 const octave_idx_type& ILO,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
162 const octave_idx_type& IHI,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
163 Complex* A, const octave_idx_type& LDA,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
164 Complex* B, const octave_idx_type& LDB,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
165 Complex* ALPHA, Complex* BETA, Complex* CQ,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
166 const octave_idx_type& LDQ,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
167 Complex* CZ, const octave_idx_type& LDZ,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
168 Complex* WORK, const octave_idx_type& LWORK,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
169 double* RWORK, octave_idx_type& INFO
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
170 F77_CHAR_ARG_LEN_DECL
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
171 F77_CHAR_ARG_LEN_DECL
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
172 F77_CHAR_ARG_LEN_DECL);
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
173
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
174 F77_RET_T
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
175 F77_FUNC (dlag2, DLAG2) (const double* A, const octave_idx_type& LDA,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
176 const double* B, const octave_idx_type& LDB,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
177 const double& SAFMIN, double& SCALE1,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
178 double& SCALE2, double& WR1, double& WR2,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
179 double& WI);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
180
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
181 // Van Dooren's code (netlib.org: toms/590) for reordering
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
182 // GEP. Only processes Z, not Q.
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
183 F77_RET_T
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
184 F77_FUNC (dsubsp, DSUBSP) (const octave_idx_type& NMAX,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
185 const octave_idx_type& N, double* A,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
186 double* B, double* Z, sort_function,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
187 const double& EPS, octave_idx_type& NDIM,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
188 octave_idx_type& FAIL, octave_idx_type* IND);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
189
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
190 // Documentation for DTGEVC incorrectly states that VR, VL are
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
191 // complex*16; they are declared in DTGEVC as double precision
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
192 // (probably a cut and paste problem fro ZTGEVC).
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
193 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
194 F77_FUNC (dtgevc, DTGEVC) (F77_CONST_CHAR_ARG_DECL,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
195 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
196 octave_idx_type* SELECT,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
197 const octave_idx_type& N, double* A,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
198 const octave_idx_type& LDA, double* B,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
199 const octave_idx_type& LDB, double* VL,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
200 const octave_idx_type& LDVL, double* VR,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
201 const octave_idx_type& LDVR,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
202 const octave_idx_type& MM, octave_idx_type& M,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
203 double* WORK, octave_idx_type& INFO
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
204 F77_CHAR_ARG_LEN_DECL
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
205 F77_CHAR_ARG_LEN_DECL);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
206
19895
19755f4fc851 maint: Cleanup C++ code to follow Octave coding conventions.
Rik <rik@octave.org>
parents: 19731
diff changeset
207 F77_RET_T
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
208 F77_FUNC (ztgevc, ZTGEVC) (F77_CONST_CHAR_ARG_DECL,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
209 F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
210 octave_idx_type* SELECT,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
211 const octave_idx_type& N, const Complex* A,
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
212 const octave_idx_type& LDA,const Complex* B,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
213 const octave_idx_type& LDB, Complex* xVL,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
214 const octave_idx_type& LDVL, Complex* xVR,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
215 const octave_idx_type& LDVR,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
216 const octave_idx_type& MM, octave_idx_type& M,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
217 Complex* CWORK, double* RWORK,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
218 octave_idx_type& INFO
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
219 F77_CHAR_ARG_LEN_DECL
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
220 F77_CHAR_ARG_LEN_DECL);
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
221
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
222 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
223 F77_FUNC (xdlamch, XDLAMCH) (F77_CONST_CHAR_ARG_DECL,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
224 double& retval
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
225 F77_CHAR_ARG_LEN_DECL);
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
226
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
227 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
228 F77_FUNC (xdlange, XDLANGE) (F77_CONST_CHAR_ARG_DECL,
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
229 const octave_idx_type&,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
230 const octave_idx_type&, const double*,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
231 const octave_idx_type&, double*, double&
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
232 F77_CHAR_ARG_LEN_DECL);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
233 }
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
234
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
235 // fcrhp, fin, fout, folhp:
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
236 // routines for ordering of generalized eigenvalues
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
237 // return 1 if test is passed, 0 otherwise
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
238 // fin: |lambda| < 1
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
239 // fout: |lambda| >= 1
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
240 // fcrhp: real(lambda) >= 0
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
241 // folhp: real(lambda) < 0
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
242
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
243 static octave_idx_type
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
244 fcrhp (const octave_idx_type& lsize, const double& alpha,
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
245 const double& beta, const double& s, const double&)
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
246 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
247 if (lsize == 1)
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
248 return (alpha * beta >= 0 ? 1 : -1);
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
249 else
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
250 return (s >= 0 ? 1 : -1);
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
251 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
252
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
253 static octave_idx_type
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
254 fin (const octave_idx_type& lsize, const double& alpha,
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
255 const double& beta, const double&, const double& p)
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
256 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
257 octave_idx_type retval;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
258
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
259 if (lsize == 1)
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
260 retval = (fabs (alpha) < fabs (beta) ? 1 : -1);
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
261 else
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
262 retval = (fabs (p) < 1 ? 1 : -1);
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
263
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
264 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
265 std::cout << "qz: fin: retval=" << retval << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
266 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
267
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
268 return retval;
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
269 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
270
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
271 static octave_idx_type
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
272 folhp (const octave_idx_type& lsize, const double& alpha,
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
273 const double& beta, const double& s, const double&)
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
274 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
275 if (lsize == 1)
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
276 return (alpha * beta < 0 ? 1 : -1);
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
277 else
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
278 return (s < 0 ? 1 : -1);
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
279 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
280
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
281 static octave_idx_type
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
282 fout (const octave_idx_type& lsize, const double& alpha,
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
283 const double& beta, const double&, const double& p)
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
284 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
285 if (lsize == 1)
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
286 return (fabs (alpha) >= fabs (beta) ? 1 : -1);
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
287 else
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
288 return (fabs (p) >= 1 ? 1 : -1);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
289 }
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
290
13074
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
291
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
292 //FIXME: Matlab does not produce lambda as the first output argument.
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
293 // Compatibility problem?
15039
e753177cde93 maint: Move non-dynamically linked functions from DLD-FUNCTIONS/ to corefcn/ directory
Rik <rik@octave.org>
parents: 14876
diff changeset
294 DEFUN (qz, args, nargout,
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
295 "-*- texinfo -*-\n\
15039
e753177cde93 maint: Move non-dynamically linked functions from DLD-FUNCTIONS/ to corefcn/ directory
Rik <rik@octave.org>
parents: 14876
diff changeset
296 @deftypefn {Built-in Function} {@var{lambda} =} qz (@var{A}, @var{B})\n\
e753177cde93 maint: Move non-dynamically linked functions from DLD-FUNCTIONS/ to corefcn/ directory
Rik <rik@octave.org>
parents: 14876
diff changeset
297 @deftypefnx {Built-in Function} {@var{lambda} =} qz (@var{A}, @var{B}, @var{opt})\n\
11593
1577c6f80926 Use non-breaking spaces between certain adjectives and their nouns in docstrings.
Rik <octave@nomad.inbox5.com>
parents: 11586
diff changeset
298 QZ@tie{}decomposition of the generalized eigenvalue problem\n\
20207
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
299 (@math{A x = s B x}).\n\
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
300 \n\
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
301 There are three ways to call this function:\n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
302 @enumerate\n\
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
303 @item @code{@var{lambda} = qz (@var{A}, @var{B})}\n\
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
304 \n\
5016
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
305 Computes the generalized eigenvalues\n\
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
306 @tex\n\
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
307 $\\lambda$\n\
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
308 @end tex\n\
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 8286
diff changeset
309 @ifnottex\n\
5016
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
310 @var{lambda}\n\
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 8286
diff changeset
311 @end ifnottex\n\
5016
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
312 of @math{(A - s B)}.\n\
10840
89f4d7e294cc Grammarcheck .cc files
Rik <octave@nomad.inbox5.com>
parents: 10791
diff changeset
313 \n\
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
314 @item @code{[AA, BB, Q, Z, V, W, @var{lambda}] = qz (@var{A}, @var{B})}\n\
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
315 \n\
20207
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
316 Computes QZ@tie{}decomposition, generalized eigenvectors, and generalized\n\
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
317 eigenvalues of @math{(A - s B)}\n\
5016
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
318 @tex\n\
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
319 $$ AV = BV{ \\rm diag }(\\lambda) $$\n\
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
320 $$ W^T A = { \\rm diag }(\\lambda)W^T B $$\n\
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
321 $$ AA = Q^T AZ, BB = Q^T BZ $$\n\
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
322 @end tex\n\
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 8286
diff changeset
323 @ifnottex\n\
10840
89f4d7e294cc Grammarcheck .cc files
Rik <octave@nomad.inbox5.com>
parents: 10791
diff changeset
324 \n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
325 @example\n\
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
326 @group\n\
5481
65e02518f4f5 [project @ 2005-10-04 17:12:08 by jwe]
jwe
parents: 5333
diff changeset
327 \n\
14360
97883071e8e4 doc: Correct off-by-1 spacings in all .cc docstrings
Rik <octave@nomad.inbox5.com>
parents: 14138
diff changeset
328 A * V = B * V * diag (@var{lambda})\n\
97883071e8e4 doc: Correct off-by-1 spacings in all .cc docstrings
Rik <octave@nomad.inbox5.com>
parents: 14138
diff changeset
329 W' * A = diag (@var{lambda}) * W' * B\n\
97883071e8e4 doc: Correct off-by-1 spacings in all .cc docstrings
Rik <octave@nomad.inbox5.com>
parents: 14138
diff changeset
330 AA = Q * A * Z, BB = Q * B * Z\n\
5481
65e02518f4f5 [project @ 2005-10-04 17:12:08 by jwe]
jwe
parents: 5333
diff changeset
331 \n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
332 @end group\n\
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
333 @end example\n\
10840
89f4d7e294cc Grammarcheck .cc files
Rik <octave@nomad.inbox5.com>
parents: 10791
diff changeset
334 \n\
8517
81d6ab3ac93c Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents: 8286
diff changeset
335 @end ifnottex\n\
5016
bdbee5282954 [project @ 2004-09-22 02:50:35 by jwe]
jwe
parents: 4629
diff changeset
336 with @var{Q} and @var{Z} orthogonal (unitary)= @var{I}\n\
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
337 \n\
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
338 @item @code{[AA,BB,Z@{, @var{lambda}@}] = qz (@var{A}, @var{B}, @var{opt})}\n\
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
339 \n\
20207
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
340 As in form [2], but allows ordering of generalized eigenpairs for, e.g.,\n\
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
341 solution of discrete time algebraic Riccati equations. Form 3 is not\n\
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
342 available for complex matrices, and does not compute the generalized\n\
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
343 eigenvectors @var{V}, @var{W}, nor the orthogonal matrix @var{Q}.\n\
10791
3140cb7a05a1 Add spellchecker scripts for Octave and run spellcheck of documentation
Rik <octave@nomad.inbox5.com>
parents: 10350
diff changeset
344 \n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
345 @table @var\n\
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
346 @item opt\n\
20207
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
347 for ordering eigenvalues of the @nospell{GEP} pencil. The leading block of\n\
4f45eaf83908 doc: Update more docstrings to have one sentence summary as first line.
Rik <rik@octave.org>
parents: 19895
diff changeset
348 the revised pencil contains all eigenvalues that satisfy:\n\
14360
97883071e8e4 doc: Correct off-by-1 spacings in all .cc docstrings
Rik <octave@nomad.inbox5.com>
parents: 14138
diff changeset
349 \n\
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
350 @table @asis\n\
17281
bc924baa2c4e doc: Add new @qcode macro for code samples which are quoted.
Rik <rik@octave.org>
parents: 17097
diff changeset
351 @item @qcode{\"N\"}\n\
12642
f96b9b9f141b doc: Periodic grammarcheck and spellcheck of documentation.
Rik <octave@nomad.inbox5.com>
parents: 11593
diff changeset
352 = unordered (default)\n\
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
353 \n\
17281
bc924baa2c4e doc: Add new @qcode macro for code samples which are quoted.
Rik <rik@octave.org>
parents: 17097
diff changeset
354 @item @qcode{\"S\"}\n\
12642
f96b9b9f141b doc: Periodic grammarcheck and spellcheck of documentation.
Rik <octave@nomad.inbox5.com>
parents: 11593
diff changeset
355 = small: leading block has all |lambda| @leq{} 1\n\
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
356 \n\
17281
bc924baa2c4e doc: Add new @qcode macro for code samples which are quoted.
Rik <rik@octave.org>
parents: 17097
diff changeset
357 @item @qcode{\"B\"}\n\
12642
f96b9b9f141b doc: Periodic grammarcheck and spellcheck of documentation.
Rik <octave@nomad.inbox5.com>
parents: 11593
diff changeset
358 = big: leading block has all |lambda| @geq{} 1\n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
359 \n\
17281
bc924baa2c4e doc: Add new @qcode macro for code samples which are quoted.
Rik <rik@octave.org>
parents: 17097
diff changeset
360 @item @qcode{\"-\"}\n\
5481
65e02518f4f5 [project @ 2005-10-04 17:12:08 by jwe]
jwe
parents: 5333
diff changeset
361 = negative real part: leading block has all eigenvalues\n\
65e02518f4f5 [project @ 2005-10-04 17:12:08 by jwe]
jwe
parents: 5333
diff changeset
362 in the open left half-plane\n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
363 \n\
17281
bc924baa2c4e doc: Add new @qcode macro for code samples which are quoted.
Rik <rik@octave.org>
parents: 17097
diff changeset
364 @item @qcode{\"+\"}\n\
9209
923c7cb7f13f Simplify TeXinfo files by eliminating redundant @iftex followed by @tex construction.
Rik <rdrider0-list@yahoo.com>
parents: 9064
diff changeset
365 = non-negative real part: leading block has all eigenvalues\n\
5481
65e02518f4f5 [project @ 2005-10-04 17:12:08 by jwe]
jwe
parents: 5333
diff changeset
366 in the closed right half-plane\n\
9064
7c02ec148a3c Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents: 8927
diff changeset
367 @end table\n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
368 @end table\n\
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
369 @end enumerate\n\
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
370 \n\
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
371 Note: @code{qz} performs permutation balancing, but not scaling\n\
17097
e7a059a9a644 doc: Use XREF as anchor prefix in documentation for clearer results in Info viewer.
Rik <rik@octave.org>
parents: 16920
diff changeset
372 (@pxref{XREFbalance}). The order of output arguments was selected for\n\
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
373 compatibility with @sc{matlab}.\n\
16920
53eaa83e4181 doc: Add seealso links between various factorization forms.
Rik <rik@octave.org>
parents: 16826
diff changeset
374 @seealso{eig, balance, lu, chol, hess, qr, qzhess, schur, svd}\n\
3372
f16c2ce14886 [project @ 1999-11-23 19:07:09 by jwe]
jwe
parents: 3187
diff changeset
375 @end deftypefn")
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
376 {
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
377 octave_value_list retval;
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
378 int nargin = args.length ();
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
379
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
380 #ifdef DEBUG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
381 std::cout << "qz: nargin = " << nargin
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
382 << ", nargout = " << nargout << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
383 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
384
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
385 if (nargin < 2 || nargin > 3 || nargout > 7)
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
386 {
5823
080c08b192d8 [project @ 2006-05-19 05:32:17 by jwe]
jwe
parents: 5775
diff changeset
387 print_usage ();
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
388 return retval;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
389 }
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
390 else if (nargin == 3 && (nargout < 3 || nargout > 4))
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
391 {
3427
e098ebb77023 [project @ 2000-01-13 09:25:53 by jwe]
jwe
parents: 3372
diff changeset
392 error ("qz: invalid number of output arguments for form [3] call");
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
393 return retval;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
394 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
395
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
396 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
397 std::cout << "qz: determine ordering option" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
398 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
399
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
400 // Determine ordering option.
8927
d75f4ee0538d qz.cc (Fqz): avoid maybe clobbred by vfork warning from GCC
John W. Eaton <jwe@octave.org>
parents: 8920
diff changeset
401 volatile char ord_job = 0;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
402 static double safmin;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
403
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
404 if (nargin == 2)
8927
d75f4ee0538d qz.cc (Fqz): avoid maybe clobbred by vfork warning from GCC
John W. Eaton <jwe@octave.org>
parents: 8920
diff changeset
405 ord_job = 'N';
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
406 else
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
407 {
20616
fd0efcdb3718 use new string_value method to handle value extraction errors
John W. Eaton <jwe@octave.org>
parents: 20587
diff changeset
408 std::string tmp = args(2).string_value ("qz: OPT must be a string");
8927
d75f4ee0538d qz.cc (Fqz): avoid maybe clobbred by vfork warning from GCC
John W. Eaton <jwe@octave.org>
parents: 8920
diff changeset
409
d75f4ee0538d qz.cc (Fqz): avoid maybe clobbred by vfork warning from GCC
John W. Eaton <jwe@octave.org>
parents: 8920
diff changeset
410 if (! tmp.empty ())
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
411 ord_job = tmp[0];
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
412
8927
d75f4ee0538d qz.cc (Fqz): avoid maybe clobbred by vfork warning from GCC
John W. Eaton <jwe@octave.org>
parents: 8920
diff changeset
413 if (! (ord_job == 'N' || ord_job == 'n'
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
414 || ord_job == 'S' || ord_job == 's'
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
415 || ord_job == 'B' || ord_job == 'b'
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
416 || ord_job == '+' || ord_job == '-'))
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
417 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
418 error ("qz: invalid order option");
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
419 return retval;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
420 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
421
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
422 // overflow constant required by dlag2
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
423 F77_FUNC (xdlamch, XDLAMCH) (F77_CONST_CHAR_ARG2 ("S", 1),
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
424 safmin
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
425 F77_CHAR_ARG_LEN (1));
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
426
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
427 #ifdef DEBUG_EIG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
428 std::cout << "qz: initial value of safmin="
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
429 << setiosflags (std::ios::scientific)
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
430 << safmin << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
431 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
432
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
433 // Some machines (e.g., DEC alpha) get safmin = 0;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
434 // for these, use eps instead to avoid problems in dlag2.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
435 if (safmin == 0)
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
436 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
437 #ifdef DEBUG_EIG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
438 std::cout << "qz: DANGER WILL ROBINSON: safmin is 0!" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
439 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
440
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
441 F77_FUNC (xdlamch, XDLAMCH) (F77_CONST_CHAR_ARG2 ("E", 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
442 safmin
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
443 F77_CHAR_ARG_LEN (1));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
444
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
445 #ifdef DEBUG_EIG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
446 std::cout << "qz: safmin set to "
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
447 << setiosflags (std::ios::scientific)
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
448 << safmin << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
449 #endif
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
450 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
451 }
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
452
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
453 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
454 std::cout << "qz: check argument 1" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
455 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
456
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
457 // Argument 1: check if it's o.k. dimensioned.
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
458 octave_idx_type nn = args(0).rows ();
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
459
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
460 #ifdef DEBUG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
461 std::cout << "argument 1 dimensions: ("
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
462 << nn << "," << args(0).columns () << ")"
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
463 << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
464 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
465
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
466 int arg_is_empty = empty_arg ("qz", nn, args(0).columns ());
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
467
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
468 if (arg_is_empty < 0)
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
469 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
470 gripe_empty_arg ("qz: parameter 1", 0);
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
471 return retval;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
472 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
473 else if (arg_is_empty > 0)
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
474 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
475 gripe_empty_arg ("qz: parameter 1; continuing", 0);
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
476 return octave_value_list (2, Matrix ());
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
477 }
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
478 else if (args(0).columns () != nn)
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
479 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
480 gripe_square_matrix_required ("qz");
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
481 return retval;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
482 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
483
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
484 // Argument 1: dimensions look good; get the value.
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
485 Matrix aa;
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
486 ComplexMatrix caa;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
487
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
488 if (args(0).is_complex_type ())
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
489 caa = args(0).complex_matrix_value ();
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
490 else
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
491 aa = args(0).matrix_value ();
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
492
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
493 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
494 std::cout << "qz: check argument 2" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
495 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
496
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
497 // Extract argument 2 (bb, or cbb if complex).
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
498 if ((nn != args(1).columns ()) || (nn != args(1).rows ()))
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
499 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
500 gripe_nonconformant ();
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
501 return retval;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
502 }
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
503
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
504 Matrix bb;
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
505 ComplexMatrix cbb;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
506
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
507 if (args(1).is_complex_type ())
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
508 cbb = args(1).complex_matrix_value ();
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
509 else
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
510 bb = args(1).matrix_value ();
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
511
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
512 // Both matrices loaded, now let's check what kind of arithmetic:
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
513 // declared volatile to avoid compiler warnings about long jumps,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
514 // vforks.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
515
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
516 volatile int complex_case
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
517 = (args(0).is_complex_type () || args(1).is_complex_type ());
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
518
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
519 if (nargin == 3 && complex_case)
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
520 {
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
521 error ("qz: cannot re-order complex qz decomposition");
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
522 return retval;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
523 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
524
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
525 // First, declare variables used in both the real and complex case.
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
526 Matrix QQ(nn,nn), ZZ(nn,nn), VR(nn,nn), VL(nn,nn);
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
527 RowVector alphar(nn), alphai(nn), betar(nn);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
528 ComplexRowVector xalpha(nn), xbeta(nn);
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
529 ComplexMatrix CQ(nn,nn), CZ(nn,nn), CVR(nn,nn), CVL(nn,nn);
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
530 octave_idx_type ilo, ihi, info;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
531 char compq = (nargout >= 3 ? 'V' : 'N');
14876
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
532 char compz = ((nargout >= 4 || nargin == 3)? 'V' : 'N');
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
533
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
534 // Initialize Q, Z to identity if we need either of them.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
535 if (compq == 'V' || compz == 'V')
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
536 for (octave_idx_type ii = 0; ii < nn; ii++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 5016
diff changeset
537 for (octave_idx_type jj = 0; jj < nn; jj++)
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
538 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
539 OCTAVE_QUIT;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
540 QQ(ii,jj) = ZZ(ii,jj) = (ii == jj ? 1.0 : 0.0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
541 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
542
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
543 // Always perform permutation balancing.
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
544 const char bal_job = 'P';
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
545 RowVector lscale (nn), rscale (nn), work (6 * nn), rwork (nn);
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
546
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
547 if (complex_case)
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
548 {
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
549 #ifdef DEBUG
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
550 if (compq == 'V')
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
551 std::cout << "qz: performing balancing; CQ=" << std::endl
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
552 << CQ << std::endl;
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
553 #endif
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
554 if (args(0).is_real_type ())
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
555 caa = ComplexMatrix (aa);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
556
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
557 if (args(1).is_real_type ())
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
558 cbb = ComplexMatrix (bb);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
559
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
560 if (compq == 'V')
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
561 CQ = ComplexMatrix (QQ);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
562
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
563 if (compz == 'V')
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
564 CZ = ComplexMatrix (ZZ);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
565
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
566 F77_XFCN (zggbal, ZGGBAL,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
567 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
568 nn, caa.fortran_vec (), nn, cbb.fortran_vec (),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
569 nn, ilo, ihi, lscale.fortran_vec (),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
570 rscale.fortran_vec (), work.fortran_vec (), info
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
571 F77_CHAR_ARG_LEN (1)));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
572 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
573 else
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
574 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
575 #ifdef DEBUG
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
576 if (compq == 'V')
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
577 std::cout << "qz: performing balancing; QQ=" << std::endl
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
578 << QQ << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
579 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
580
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
581 F77_XFCN (dggbal, DGGBAL,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
582 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
583 nn, aa.fortran_vec (), nn, bb.fortran_vec (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
584 nn, ilo, ihi, lscale.fortran_vec (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
585 rscale.fortran_vec (), work.fortran_vec (), info
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
586 F77_CHAR_ARG_LEN (1)));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
587 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
588
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
589 // Since we just want the balancing matrices, we can use dggbal
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
590 // for both the real and complex cases; left first
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
591
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
592 #if 0
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
593 if (compq == 'V')
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
594 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
595 F77_XFCN (dggbak, DGGBAK,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
596 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
597 F77_CONST_CHAR_ARG2 ("L", 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
598 nn, ilo, ihi, lscale.data (), rscale.data (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
599 nn, QQ.fortran_vec (), nn, info
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
600 F77_CHAR_ARG_LEN (1)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
601 F77_CHAR_ARG_LEN (1)));
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
602
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
603 #ifdef DEBUG
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
604 if (compq == 'V')
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
605 std::cout << "qz: balancing done; QQ=" << std::endl << QQ << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
606 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
607 }
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
608
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
609 // then right
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
610 if (compz == 'V')
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
611 {
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4153
diff changeset
612 F77_XFCN (dggbak, DGGBAK,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
613 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
614 F77_CONST_CHAR_ARG2 ("R", 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
615 nn, ilo, ihi, lscale.data (), rscale.data (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
616 nn, ZZ.fortran_vec (), nn, info
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
617 F77_CHAR_ARG_LEN (1)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
618 F77_CHAR_ARG_LEN (1)));
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
619
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
620 #ifdef DEBUG
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
621 if (compz == 'V')
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
622 std::cout << "qz: balancing done; ZZ=" << std::endl << ZZ << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
623 #endif
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
624 }
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
625 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
626
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
627 static char qz_job;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
628 qz_job = (nargout < 2 ? 'E' : 'S');
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
629
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
630 if (complex_case)
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
631 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
632 // Complex case.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
633
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
634 // The QR decomposition of cbb.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
635 ComplexQR cbqr (cbb);
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
636 // The R matrix of QR decomposition for cbb.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
637 cbb = cbqr.R ();
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
638 // (Q*)caa for following work.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
639 caa = (cbqr.Q ().hermitian ()) * caa;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
640 CQ = CQ * cbqr.Q ();
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
641
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
642 F77_XFCN (zgghrd, ZGGHRD,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
643 (F77_CONST_CHAR_ARG2 (&compq, 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
644 F77_CONST_CHAR_ARG2 (&compz, 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
645 nn, ilo, ihi, caa.fortran_vec (),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
646 nn, cbb.fortran_vec (), nn, CQ.fortran_vec (), nn,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
647 CZ.fortran_vec (), nn, info
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
648 F77_CHAR_ARG_LEN (1)
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
649 F77_CHAR_ARG_LEN (1)));
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
650
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
651 ComplexRowVector cwork (1 * nn);
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
652
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
653 F77_XFCN (zhgeqz, ZHGEQZ,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
654 (F77_CONST_CHAR_ARG2 (&qz_job, 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
655 F77_CONST_CHAR_ARG2 (&compq, 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
656 F77_CONST_CHAR_ARG2 (&compz, 1),
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
657 nn, ilo, ihi,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
658 caa.fortran_vec (), nn,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
659 cbb.fortran_vec (),nn,
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
660 xalpha.fortran_vec (), xbeta.fortran_vec (),
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
661 CQ.fortran_vec (), nn,
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
662 CZ.fortran_vec (), nn,
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
663 cwork.fortran_vec (), nn, rwork.fortran_vec (), info
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
664 F77_CHAR_ARG_LEN (1)
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
665 F77_CHAR_ARG_LEN (1)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
666 F77_CHAR_ARG_LEN (1)));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
667
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
668 if (compq == 'V')
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
669 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
670 // Left eigenvector.
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
671 F77_XFCN (zggbak, ZGGBAK,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
672 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
673 F77_CONST_CHAR_ARG2 ("L", 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
674 nn, ilo, ihi, lscale.data (), rscale.data (),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
675 nn, CQ.fortran_vec (), nn, info
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
676 F77_CHAR_ARG_LEN (1)
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
677 F77_CHAR_ARG_LEN (1)));
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
678 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
679
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
680 // Right eigenvector.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
681 if (compz == 'V')
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
682 {
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
683 F77_XFCN (zggbak, ZGGBAK,
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
684 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
685 F77_CONST_CHAR_ARG2 ("R", 1),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
686 nn, ilo, ihi, lscale.data (), rscale.data (),
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
687 nn, CZ.fortran_vec (), nn, info
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
688 F77_CHAR_ARG_LEN (1)
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
689 F77_CHAR_ARG_LEN (1)));
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
690 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
691
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
692 }
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
693 else
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
694 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
695 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
696 std::cout << "qz: peforming qr decomposition of bb" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
697 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
698
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
699 // Compute the QR factorization of bb.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
700 QR bqr (bb);
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
701
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
702 #ifdef DEBUG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
703 std::cout << "qz: qr (bb) done; now peforming qz decomposition"
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
704 << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
705 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
706
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
707 bb = bqr.R ();
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
708
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
709 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
710 std::cout << "qz: extracted bb" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
711 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
712
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
713 aa = (bqr.Q ()).transpose () * aa;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
714
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
715 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
716 std::cout << "qz: updated aa " << std::endl;
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
717 std::cout << "bqr.Q () = " << std::endl << bqr.Q () << std::endl;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
718
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
719 if (compq == 'V')
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
720 std::cout << "QQ =" << QQ << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
721 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
722
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
723 if (compq == 'V')
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
724 QQ = QQ * bqr.Q ();
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
725
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
726 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
727 std::cout << "qz: precursors done..." << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
728 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
729
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
730 #ifdef DEBUG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
731 std::cout << "qz: compq = " << compq << ", compz = " << compz
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
732 << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
733 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
734
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
735 // Reduce to generalized hessenberg form.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
736 F77_XFCN (dgghrd, DGGHRD,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
737 (F77_CONST_CHAR_ARG2 (&compq, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
738 F77_CONST_CHAR_ARG2 (&compz, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
739 nn, ilo, ihi, aa.fortran_vec (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
740 nn, bb.fortran_vec (), nn, QQ.fortran_vec (), nn,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
741 ZZ.fortran_vec (), nn, info
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
742 F77_CHAR_ARG_LEN (1)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
743 F77_CHAR_ARG_LEN (1)));
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
744
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
745 // Check if just computing generalized eigenvalues or if we're
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
746 // actually computing the decomposition.
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
747
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
748 // Reduce to generalized Schur form.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
749 F77_XFCN (dhgeqz, DHGEQZ,
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
750 (F77_CONST_CHAR_ARG2 (&qz_job, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
751 F77_CONST_CHAR_ARG2 (&compq, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
752 F77_CONST_CHAR_ARG2 (&compz, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
753 nn, ilo, ihi, aa.fortran_vec (), nn, bb.fortran_vec (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
754 nn, alphar.fortran_vec (), alphai.fortran_vec (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
755 betar.fortran_vec (), QQ.fortran_vec (), nn,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
756 ZZ.fortran_vec (), nn, work.fortran_vec (), nn, info
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
757 F77_CHAR_ARG_LEN (1)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
758 F77_CHAR_ARG_LEN (1)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
759 F77_CHAR_ARG_LEN (1)));
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
760
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
761 if (compq == 'V')
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
762 {
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
763 F77_XFCN (dggbak, DGGBAK,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
764 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
765 F77_CONST_CHAR_ARG2 ("L", 1),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
766 nn, ilo, ihi, lscale.data (), rscale.data (),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
767 nn, QQ.fortran_vec (), nn, info
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
768 F77_CHAR_ARG_LEN (1)
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
769 F77_CHAR_ARG_LEN (1)));
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
770
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
771 #ifdef DEBUG
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
772 if (compq == 'V')
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
773 std::cout << "qz: balancing done; QQ=" << std::endl
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
774 << QQ << std::endl;
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
775 #endif
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
776 }
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
777
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
778 // then right
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
779 if (compz == 'V')
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
780 {
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
781 F77_XFCN (dggbak, DGGBAK,
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
782 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
783 F77_CONST_CHAR_ARG2 ("R", 1),
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
784 nn, ilo, ihi, lscale.data (), rscale.data (),
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
785 nn, ZZ.fortran_vec (), nn, info
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
786 F77_CHAR_ARG_LEN (1)
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
787 F77_CHAR_ARG_LEN (1)));
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
788
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
789 #ifdef DEBUG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
790 if (compz == 'V')
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
791 std::cout << "qz: balancing done; ZZ=" << std::endl
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
792 << ZZ << std::endl;
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
793 #endif
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
794 }
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
795
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
796 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
797
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
798 // Order the QZ decomposition?
8927
d75f4ee0538d qz.cc (Fqz): avoid maybe clobbred by vfork warning from GCC
John W. Eaton <jwe@octave.org>
parents: 8920
diff changeset
799 if (! (ord_job == 'N' || ord_job == 'n'))
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
800 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
801 if (complex_case)
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
802 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
803 // Probably not needed, but better be safe.
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
804 error ("qz: cannot re-order complex qz decomposition");
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
805 return retval;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
806 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
807 else
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
808 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
809 #ifdef DEBUG_SORT
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
810 std::cout << "qz: ordering eigenvalues: ord_job = "
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
811 << ord_job << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
812 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
813
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
814 // Declared static to avoid vfork/long jump compiler complaints.
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
815 static sort_function sort_test;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
816 sort_test = 0;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
817
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
818 switch (ord_job)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
819 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
820 case 'S':
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
821 case 's':
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
822 sort_test = &fin;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
823 break;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
824
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
825 case 'B':
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
826 case 'b':
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
827 sort_test = &fout;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
828 break;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
829
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
830 case '+':
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
831 sort_test = &fcrhp;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
832 break;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
833
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
834 case '-':
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
835 sort_test = &folhp;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
836 break;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
837
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
838 default:
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
839 // Invalid order option (should never happen, since we
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
840 // checked the options at the top).
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
841 panic_impossible ();
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
842 break;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
843 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
844
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
845 octave_idx_type ndim, fail;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
846 double inf_norm;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
847
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
848 F77_XFCN (xdlange, XDLANGE,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
849 (F77_CONST_CHAR_ARG2 ("I", 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
850 nn, nn, aa.data (), nn, work.fortran_vec (), inf_norm
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
851 F77_CHAR_ARG_LEN (1)));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
852
15220
61822c866ba1 use std::numeric_limits<T>::epsilon in C++ code
John W. Eaton <jwe@octave.org>
parents: 15195
diff changeset
853 double eps = std::numeric_limits<double>::epsilon () * inf_norm * nn;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
854
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
855 #ifdef DEBUG_SORT
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
856 std::cout << "qz: calling dsubsp: aa=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
857 octave_print_internal (std::cout, aa, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
858 std::cout << std::endl << "bb=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
859 octave_print_internal (std::cout, bb, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
860 if (compz == 'V')
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
861 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
862 std::cout << std::endl << "ZZ=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
863 octave_print_internal (std::cout, ZZ, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
864 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
865 std::cout << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
866 std::cout << "alphar = " << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
867 octave_print_internal (std::cout, (Matrix) alphar, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
868 std::cout << std::endl << "alphai = " << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
869 octave_print_internal (std::cout, (Matrix) alphai, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
870 std::cout << std::endl << "beta = " << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
871 octave_print_internal (std::cout, (Matrix) betar, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
872 std::cout << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
873 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
874
11570
57632dea2446 attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents: 11553
diff changeset
875 Array<octave_idx_type> ind (dim_vector (nn, 1));
3550
bc492f4a94cb [project @ 2000-02-03 01:36:30 by jwe]
jwe
parents: 3538
diff changeset
876
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
877 F77_XFCN (dsubsp, DSUBSP,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
878 (nn, nn, aa.fortran_vec (), bb.fortran_vec (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
879 ZZ.fortran_vec (), sort_test, eps, ndim, fail,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
880 ind.fortran_vec ()));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
881
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
882 #ifdef DEBUG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
883 std::cout << "qz: back from dsubsp: aa=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
884 octave_print_internal (std::cout, aa, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
885 std::cout << std::endl << "bb=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
886 octave_print_internal (std::cout, bb, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
887 if (compz == 'V')
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
888 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
889 std::cout << std::endl << "ZZ=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
890 octave_print_internal (std::cout, ZZ, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
891 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
892 std::cout << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
893 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
894
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
895 // Manually update alphar, alphai, betar.
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
896 static int jj;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
897
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
898 jj = 0;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
899 while (jj < nn)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
900 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
901 #ifdef DEBUG_EIG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
902 std::cout << "computing gen eig #" << jj << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
903 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
904
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
905 // Number of zeros in this block.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
906 static int zcnt;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
907
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
908 if (jj == (nn-1))
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
909 zcnt = 1;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
910 else if (aa(jj+1,jj) == 0)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
911 zcnt = 1;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
912 else zcnt = 2;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
913
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
914 if (zcnt == 1)
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
915 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
916 // Real zero.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
917 #ifdef DEBUG_EIG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
918 std::cout << " single gen eig:" << std::endl;
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
919 std::cout << " alphar(" << jj << ") = " << aa(jj,jj)
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
920 << std::endl;
18712
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 17787
diff changeset
921 std::cout << " betar(" << jj << ") = " << bb(jj,jj)
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
922 << std::endl;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
923 std::cout << " alphai(" << jj << ") = 0" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
924 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
925
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
926 alphar(jj) = aa(jj,jj);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
927 alphai(jj) = 0;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
928 betar(jj) = bb(jj,jj);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
929 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
930 else
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
931 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
932 // Complex conjugate pair.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
933 #ifdef DEBUG_EIG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
934 std::cout << "qz: calling dlag2:" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
935 std::cout << "safmin="
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
936 << setiosflags (std::ios::scientific)
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
937 << safmin << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
938
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
939 for (int idr = jj; idr <= jj+1; idr++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
940 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
941 for (int idc = jj; idc <= jj+1; idc++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
942 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
943 std::cout << "aa(" << idr << "," << idc << ")="
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
944 << aa(idr,idc) << std::endl;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
945 std::cout << "bb(" << idr << "," << idc << ")="
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
946 << bb(idr,idc) << std::endl;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
947 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
948 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
949 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
950
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
951 // FIXME: probably should be using
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
952 // fortran_vec instead of &aa(jj,jj) here.
4566
30ba814d6700 [project @ 2003-10-29 15:06:29 by jwe]
jwe
parents: 4552
diff changeset
953
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
954 double scale1, scale2, wr1, wr2, wi;
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
955 const double *aa_ptr = aa.data () + jj * nn + jj;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
956 const double *bb_ptr = bb.data () + jj * nn + jj;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
957 F77_XFCN (dlag2, DLAG2,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
958 (aa_ptr, nn, bb_ptr, nn, safmin,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
959 scale1, scale2, wr1, wr2, wi));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
960
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
961 #ifdef DEBUG_EIG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
962 std::cout << "dlag2 returns: scale1=" << scale1
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
963 << "\tscale2=" << scale2 << std::endl
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
964 << "\twr1=" << wr1 << "\twr2=" << wr2
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
965 << "\twi=" << wi << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
966 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
967
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
968 // Just to be safe, check if it's a real pair.
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
969 if (wi == 0)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
970 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
971 alphar(jj) = wr1;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
972 alphai(jj) = 0;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
973 betar(jj) = scale1;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
974 alphar(jj+1) = wr2;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
975 alphai(jj+1) = 0;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
976 betar(jj+1) = scale2;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
977 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
978 else
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
979 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
980 alphar(jj) = alphar(jj+1) = wr1;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
981 alphai(jj) = -(alphai(jj+1) = wi);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
982 betar(jj) = betar(jj+1) = scale1;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
983 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
984 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
985
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
986 // Advance past this block.
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
987 jj += zcnt;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
988 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
989
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
990 #ifdef DEBUG_SORT
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
991 std::cout << "qz: back from dsubsp: aa=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
992 octave_print_internal (std::cout, aa, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
993 std::cout << std::endl << "bb=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
994 octave_print_internal (std::cout, bb, 0);
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
995
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
996 if (compz == 'V')
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
997 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
998 std::cout << std::endl << "ZZ=" << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
999 octave_print_internal (std::cout, ZZ, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1000 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1001 std::cout << std::endl << "qz: ndim=" << ndim << std::endl
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1002 << "fail=" << fail << std::endl;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1003 std::cout << "alphar = " << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1004 octave_print_internal (std::cout, (Matrix) alphar, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1005 std::cout << std::endl << "alphai = " << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1006 octave_print_internal (std::cout, (Matrix) alphai, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1007 std::cout << std::endl << "beta = " << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1008 octave_print_internal (std::cout, (Matrix) betar, 0);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1009 std::cout << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1010 #endif
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1011 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1012 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1013
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1014 // Compute generalized eigenvalues?
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1015 ComplexColumnVector gev;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1016
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1017 if (nargout < 2 || nargout == 7 || (nargin == 3 && nargout == 4))
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1018 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1019 if (complex_case)
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1020 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1021 int cnt = 0;
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1022
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1023 for (int ii = 0; ii < nn; ii++)
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1024 cnt++;
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1025
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1026 ComplexColumnVector tmp (cnt);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1027
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1028 cnt = 0;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1029 for (int ii = 0; ii < nn; ii++)
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1030 tmp(cnt++) = xalpha(ii) / xbeta(ii);
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1031
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1032 gev = tmp;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1033 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1034 else
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1035 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1036 #ifdef DEBUG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1037 std::cout << "qz: computing generalized eigenvalues" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1038 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1039
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1040 // Return finite generalized eigenvalues.
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1041 int cnt = 0;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1042
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1043 for (int ii = 0; ii < nn; ii++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1044 if (betar(ii) != 0)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1045 cnt++;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1046
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1047 ComplexColumnVector tmp (cnt);
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1048
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1049 cnt = 0;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1050 for (int ii = 0; ii < nn; ii++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1051 if (betar(ii) != 0)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1052 tmp(cnt++) = Complex(alphar(ii), alphai(ii))/betar(ii);
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1053
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1054 gev = tmp;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1055 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1056 }
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1057
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1058 // Right, left eigenvector matrices.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1059 if (nargout >= 5)
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1060 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1061 // Which side to compute?
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1062 char side = (nargout == 5 ? 'R' : 'B');
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1063 // Compute all of them and backtransform
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1064 char howmny = 'B';
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1065 // Dummy pointer; select is not used.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1066 octave_idx_type *select = 0;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1067
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1068 if (complex_case)
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1069 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1070 CVL = CQ;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1071 CVR = CZ;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1072 ComplexRowVector cwork2 (2 * nn);
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1073 RowVector rwork2 (8 * nn);
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1074 octave_idx_type m;
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1075
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1076 F77_XFCN (ztgevc, ZTGEVC,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1077 (F77_CONST_CHAR_ARG2 (&side, 1),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1078 F77_CONST_CHAR_ARG2 (&howmny, 1),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1079 select, nn, caa.fortran_vec (), nn, cbb.fortran_vec (),
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1080 nn, CVL.fortran_vec (), nn, CVR.fortran_vec (), nn, nn,
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1081 m, cwork2.fortran_vec (), rwork2.fortran_vec (), info
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1082 F77_CHAR_ARG_LEN (1)
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1083 F77_CHAR_ARG_LEN (1)));
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1084 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1085 else
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1086 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1087 #ifdef DEBUG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1088 std::cout << "qz: computing generalized eigenvectors" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1089 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1090
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1091 VL = QQ;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1092 VR = ZZ;
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1093 octave_idx_type m;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1094
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1095 F77_XFCN (dtgevc, DTGEVC,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1096 (F77_CONST_CHAR_ARG2 (&side, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1097 F77_CONST_CHAR_ARG2 (&howmny, 1),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1098 select, nn, aa.fortran_vec (), nn, bb.fortran_vec (),
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1099 nn, VL.fortran_vec (), nn, VR.fortran_vec (), nn, nn,
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1100 m, work.fortran_vec (), info
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1101 F77_CHAR_ARG_LEN (1)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1102 F77_CHAR_ARG_LEN (1)));
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1103
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1104 // Now construct the complex form of VV, WW.
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1105 int jj = 0;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1106
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1107 while (jj < nn)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1108 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1109 OCTAVE_QUIT;
4153
6b96ce9f5743 [project @ 2002-11-06 20:38:49 by jwe]
jwe
parents: 4051
diff changeset
1110
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1111 // See if real or complex eigenvalue.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1112
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1113 // Column increment; assume complex eigenvalue.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1114 int cinc = 2;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1115
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1116 if (jj == (nn-1))
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1117 // Single column.
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1118 cinc = 1;
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1119 else if (aa(jj+1,jj) == 0)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1120 cinc = 1;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1121
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1122 // Now copy the eigenvector (s) to CVR, CVL.
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1123 if (cinc == 1)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1124 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1125 for (int ii = 0; ii < nn; ii++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1126 CVR(ii,jj) = VR(ii,jj);
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1127
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1128 if (side == 'B')
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1129 for (int ii = 0; ii < nn; ii++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1130 CVL(ii,jj) = VL(ii,jj);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1131 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1132 else
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1133 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1134 // Double column; complex vector.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1135
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1136 for (int ii = 0; ii < nn; ii++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1137 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1138 CVR(ii,jj) = Complex (VR(ii,jj), VR(ii,jj+1));
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1139 CVR(ii,jj+1) = Complex (VR(ii,jj), -VR(ii,jj+1));
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1140 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1141
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1142 if (side == 'B')
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1143 for (int ii = 0; ii < nn; ii++)
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1144 {
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1145 CVL(ii,jj) = Complex (VL(ii,jj), VL(ii,jj+1));
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1146 CVL(ii,jj+1) = Complex (VL(ii,jj), -VL(ii,jj+1));
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1147 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1148 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1149
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1150 // Advance to next eigenvectors (if any).
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1151 jj += cinc;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1152 }
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1153 }
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1154 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1155
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1156 switch (nargout)
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1157 {
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1158 case 7:
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1159 retval(6) = gev;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1160
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1161 case 6:
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1162 // Return eigenvectors.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1163 retval(5) = CVL;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1164
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1165 case 5:
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1166 // Return eigenvectors.
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1167 retval(4) = CVR;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1168
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1169 case 4:
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1170 if (nargin == 3)
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1171 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1172 #ifdef DEBUG
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1173 std::cout << "qz: sort: retval(3) = gev = " << std::endl;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1174 octave_print_internal (std::cout, gev);
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1175 std::cout << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1176 #endif
10154
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1177 retval(3) = gev;
40dfc0c99116 DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents: 9786
diff changeset
1178 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1179 else
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1180 {
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1181 if (complex_case)
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1182 retval(3) = CZ;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1183 else
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1184 retval(3) = ZZ;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1185 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1186
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1187 case 3:
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1188 if (nargin == 3)
14876
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1189 {
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1190 if (complex_case)
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1191 retval(2) = CZ;
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1192 else
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1193 retval(2) = ZZ;
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1194 }
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1195 else
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1196 {
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1197 if (complex_case)
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1198 retval(2) = CQ.hermitian ();
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1199 else
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1200 retval(2) = QQ.transpose ();
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1201 }
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1202
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1203 case 2:
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1204 {
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1205 if (complex_case)
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1206 {
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1207 #ifdef DEBUG
14844
5bc9b9cb4362 maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents: 14501
diff changeset
1208 std::cout << "qz: retval(1) = cbb = " << std::endl;
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1209 octave_print_internal (std::cout, cbb, 0);
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1210 std::cout << std::endl << "qz: retval(0) = caa = " <<std::endl;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1211 octave_print_internal (std::cout, caa, 0);
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1212 std::cout << std::endl;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1213 #endif
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1214 retval(1) = cbb;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1215 retval(0) = caa;
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1216 }
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1217 else
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1218 {
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1219 #ifdef DEBUG
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1220 std::cout << "qz: retval(1) = bb = " << std::endl;
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1221 octave_print_internal (std::cout, bb, 0);
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1222 std::cout << std::endl << "qz: retval(0) = aa = " <<std::endl;
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1223 octave_print_internal (std::cout, aa, 0);
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1224 std::cout << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1225 #endif
17787
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1226 retval(1) = bb;
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1227 retval(0) = aa;
175b392e91fe Use GNU style coding conventions for code in libinterp/
Rik <rik@octave.org>
parents: 17744
diff changeset
1228 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11570
diff changeset
1229 }
10311
a217e1d74353 untabify qz.cc
John W. Eaton <jwe@octave.org>
parents: 10307
diff changeset
1230 break;
10307
4e4270ab70d6 support complex case in qz
Jyh-miin Lin <jyhmiinlin@gmail.com>
parents: 10155
diff changeset
1231
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1232
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1233 case 1:
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1234 case 0:
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1235 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
1236 std::cout << "qz: retval(0) = gev = " << gev << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1237 #endif
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1238 retval(0) = gev;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1239 break;
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1240
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1241 default:
11553
01f703952eff Improve docstrings for functions in DLD-FUNCTIONS directory.
Rik <octave@nomad.inbox5.com>
parents: 11523
diff changeset
1242 error ("qz: too many return arguments");
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1243 break;
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1244 }
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1245
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1246 #ifdef DEBUG
3538
0ff7323dab8b [project @ 2000-02-02 12:36:25 by jwe]
jwe
parents: 3531
diff changeset
1247 std::cout << "qz: exiting (at long last)" << std::endl;
3185
9580887dd160 [project @ 1998-09-26 02:45:55 by jwe]
jwe
parents: 3183
diff changeset
1248 #endif
3183
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1249
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1250 return retval;
5edc539c2f80 [project @ 1998-09-25 03:37:22 by jwe]
jwe
parents:
diff changeset
1251 }
13074
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1252
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1253 /*
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1254 %!shared a, b, c
14501
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1255 %! a = [1 2; 0 3];
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1256 %! b = [1 0; 0 0];
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1257 %! c = [0 1; 0 0];
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1258 %!assert (qz (a,b), 1)
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1259 %!assert (isempty (qz (a,c)))
13074
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1260
14501
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1261 ## Exaple 7.7.3 in Golub & Van Loan
13074
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1262 %!test
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1263 %! a = [ 10 1 2;
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1264 %! 1 2 -1;
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1265 %! 1 1 2];
14501
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1266 %! b = reshape (1:9,3,3);
13074
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1267 %! [aa, bb, q, z, v, w, lambda] = qz (a, b);
14501
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1268 %! sz = length (lambda);
60e5cf354d80 Update %!tests in DLD-FUNCTIONS/ directory with Octave coding conventions.
Rik <octave@nomad.inbox5.com>
parents: 14360
diff changeset
1269 %! observed = (b * v * diag ([lambda;0])) (:, 1:sz);
18712
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 17787
diff changeset
1270 %! assert ((a*v)(:, 1:sz), observed, norm (observed) * 1e-14);
13088
4ffea87ad71b codesprint: Fix tolerance for qz.cc tests.
Ben Abbott <bpabbott@mac.com>
parents: 13074
diff changeset
1271 %! observed = (diag ([lambda;0]) * w' * b) (1:sz, :);
18712
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 17787
diff changeset
1272 %! assert ((w'*a)(1:sz, :) , observed, norm (observed) * 1e-13);
13088
4ffea87ad71b codesprint: Fix tolerance for qz.cc tests.
Ben Abbott <bpabbott@mac.com>
parents: 13074
diff changeset
1273 %! assert (q * a * z, aa, norm (aa) * 1e-14);
4ffea87ad71b codesprint: Fix tolerance for qz.cc tests.
Ben Abbott <bpabbott@mac.com>
parents: 13074
diff changeset
1274 %! assert (q * b * z, bb, norm (bb) * 1e-14);
13074
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1275
14876
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1276 %!test
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1277 %! A = [0, 0, -1, 0; 1, 0, 0, 0; -1, 0, -2, -1; 0, -1, 1, 0];
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1278 %! B = [0, 0, 0, 0; 0, 1, 0, 0; 0, 0, 1, 0; 0, 0, 0, 1];
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1279 %! [AA, BB, Q, Z1] = qz (A, B);
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1280 %! [AA, BB, Z2] = qz (A, B, '-');
54a386f2ac4e correcly compute Z for 3-output call to qz (bug #36728)
John W. Eaton <jwe@octave.org>
parents: 14844
diff changeset
1281 %! assert (Z1, Z2);
13074
0b789a03bde1 codesprint: Add 3 tests for qz.cc
Jordi Gutiérrez Hermoso <jordigh@gmail.com>
parents: 12642
diff changeset
1282 */