Mercurial > octave-antonio
annotate src/DLD-FUNCTIONS/schur.cc @ 8920:eb63fbe60fab
update copyright notices
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Sat, 07 Mar 2009 10:41:27 -0500 |
parents | 81d6ab3ac93c |
children | 09da0bd91412 |
rev | line source |
---|---|
2928 | 1 /* |
2 | |
8920 | 3 Copyright (C) 1996, 1997, 1999, 2000, 2004, 2005, 2006, 2007, 2008, 2009 |
7017 | 4 John W. Eaton |
2928 | 5 |
6 This file is part of Octave. | |
7 | |
8 Octave is free software; you can redistribute it and/or modify it | |
9 under the terms of the GNU General Public License as published by the | |
7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
11 option) any later version. | |
2928 | 12 |
13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
7016 | 19 along with Octave; see the file COPYING. If not, see |
20 <http://www.gnu.org/licenses/>. | |
2928 | 21 |
22 */ | |
23 | |
24 #ifdef HAVE_CONFIG_H | |
25 #include <config.h> | |
26 #endif | |
27 | |
28 #include <string> | |
29 | |
30 #include "CmplxSCHUR.h" | |
31 #include "dbleSCHUR.h" | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
32 #include "fCmplxSCHUR.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
33 #include "floatSCHUR.h" |
2928 | 34 |
35 #include "defun-dld.h" | |
36 #include "error.h" | |
37 #include "gripes.h" | |
38 #include "oct-obj.h" | |
39 #include "utils.h" | |
40 | |
41 DEFUN_DLD (schur, args, nargout, | |
3548 | 42 "-*- texinfo -*-\n\ |
3372 | 43 @deftypefn {Loadable Function} {@var{s} =} schur (@var{a})\n\ |
44 @deftypefnx {Loadable Function} {[@var{u}, @var{s}] =} schur (@var{a}, @var{opt})\n\ | |
45 @cindex Schur decomposition\n\ | |
46 The Schur decomposition is used to compute eigenvalues of a\n\ | |
47 square matrix, and has applications in the solution of algebraic\n\ | |
48 Riccati equations in control (see @code{are} and @code{dare}).\n\ | |
49 @code{schur} always returns\n\ | |
50 @iftex\n\ | |
51 @tex\n\ | |
52 $S = U^T A U$\n\ | |
53 @end tex\n\ | |
54 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
55 @ifnottex\n\ |
3372 | 56 @code{s = u' * a * u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
57 @end ifnottex\n\ |
3372 | 58 where\n\ |
59 @iftex\n\ | |
60 @tex\n\ | |
61 $U$\n\ | |
62 @end tex\n\ | |
63 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
64 @ifnottex\n\ |
3372 | 65 @code{u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
66 @end ifnottex\n\ |
3372 | 67 is a unitary matrix\n\ |
68 @iftex\n\ | |
69 @tex\n\ | |
70 ($U^T U$ is identity)\n\ | |
71 @end tex\n\ | |
72 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
73 @ifnottex\n\ |
3372 | 74 (@code{u'* u} is identity)\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
75 @end ifnottex\n\ |
3372 | 76 and\n\ |
77 @iftex\n\ | |
78 @tex\n\ | |
79 $S$\n\ | |
80 @end tex\n\ | |
81 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
82 @ifnottex\n\ |
3372 | 83 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
84 @end ifnottex\n\ |
3372 | 85 is upper triangular. The eigenvalues of\n\ |
86 @iftex\n\ | |
87 @tex\n\ | |
88 $A$ (and $S$)\n\ | |
89 @end tex\n\ | |
90 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
91 @ifnottex\n\ |
3372 | 92 @code{a} (and @code{s})\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
93 @end ifnottex\n\ |
3372 | 94 are the diagonal elements of\n\ |
95 @iftex\n\ | |
96 @tex\n\ | |
5555 | 97 $S$.\n\ |
3372 | 98 @end tex\n\ |
99 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
100 @ifnottex\n\ |
5555 | 101 @code{s}.\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
102 @end ifnottex\n\ |
3372 | 103 If the matrix\n\ |
104 @iftex\n\ | |
105 @tex\n\ | |
106 $A$\n\ | |
107 @end tex\n\ | |
108 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
109 @ifnottex\n\ |
3372 | 110 @code{a}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
111 @end ifnottex\n\ |
3372 | 112 is real, then the real Schur decomposition is computed, in which the\n\ |
113 matrix\n\ | |
114 @iftex\n\ | |
115 @tex\n\ | |
116 $U$\n\ | |
117 @end tex\n\ | |
118 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
119 @ifnottex\n\ |
3372 | 120 @code{u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
121 @end ifnottex\n\ |
3372 | 122 is orthogonal and\n\ |
123 @iftex\n\ | |
124 @tex\n\ | |
125 $S$\n\ | |
126 @end tex\n\ | |
127 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
128 @ifnottex\n\ |
3372 | 129 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
130 @end ifnottex\n\ |
3372 | 131 is block upper triangular\n\ |
132 with blocks of size at most\n\ | |
133 @iftex\n\ | |
134 @tex\n\ | |
135 $2\\times 2$\n\ | |
136 @end tex\n\ | |
137 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
138 @ifnottex\n\ |
3372 | 139 @code{2 x 2}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
140 @end ifnottex\n\ |
3600 | 141 along the diagonal. The diagonal elements of\n\ |
3372 | 142 @iftex\n\ |
143 @tex\n\ | |
144 $S$\n\ | |
145 @end tex\n\ | |
146 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
147 @ifnottex\n\ |
3372 | 148 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
149 @end ifnottex\n\ |
3372 | 150 (or the eigenvalues of the\n\ |
151 @iftex\n\ | |
152 @tex\n\ | |
153 $2\\times 2$\n\ | |
154 @end tex\n\ | |
155 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
156 @ifnottex\n\ |
3372 | 157 @code{2 x 2}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
158 @end ifnottex\n\ |
3372 | 159 blocks, when\n\ |
160 appropriate) are the eigenvalues of\n\ | |
161 @iftex\n\ | |
162 @tex\n\ | |
163 $A$\n\ | |
164 @end tex\n\ | |
165 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
166 @ifnottex\n\ |
3372 | 167 @code{a}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
168 @end ifnottex\n\ |
3372 | 169 and\n\ |
170 @iftex\n\ | |
171 @tex\n\ | |
172 $S$.\n\ | |
173 @end tex\n\ | |
174 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
175 @ifnottex\n\ |
3372 | 176 @code{s}.\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
177 @end ifnottex\n\ |
2928 | 178 \n\ |
3372 | 179 The eigenvalues are optionally ordered along the diagonal according to\n\ |
180 the value of @code{opt}. @code{opt = \"a\"} indicates that all\n\ | |
181 eigenvalues with negative real parts should be moved to the leading\n\ | |
182 block of\n\ | |
183 @iftex\n\ | |
184 @tex\n\ | |
185 $S$\n\ | |
186 @end tex\n\ | |
187 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
188 @ifnottex\n\ |
3372 | 189 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
190 @end ifnottex\n\ |
3372 | 191 (used in @code{are}), @code{opt = \"d\"} indicates that all eigenvalues\n\ |
192 with magnitude less than one should be moved to the leading block of\n\ | |
193 @iftex\n\ | |
194 @tex\n\ | |
195 $S$\n\ | |
196 @end tex\n\ | |
197 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
198 @ifnottex\n\ |
3372 | 199 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
200 @end ifnottex\n\ |
3372 | 201 (used in @code{dare}), and @code{opt = \"u\"}, the default, indicates that\n\ |
202 no ordering of eigenvalues should occur. The leading\n\ | |
203 @iftex\n\ | |
204 @tex\n\ | |
205 $k$\n\ | |
206 @end tex\n\ | |
207 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
208 @ifnottex\n\ |
3372 | 209 @code{k}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
210 @end ifnottex\n\ |
3372 | 211 columns of\n\ |
212 @iftex\n\ | |
213 @tex\n\ | |
214 $U$\n\ | |
215 @end tex\n\ | |
216 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
217 @ifnottex\n\ |
3372 | 218 @code{u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
219 @end ifnottex\n\ |
3372 | 220 always span the\n\ |
221 @iftex\n\ | |
222 @tex\n\ | |
223 $A$-invariant\n\ | |
224 @end tex\n\ | |
225 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
226 @ifnottex\n\ |
3372 | 227 @code{a}-invariant\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
228 @end ifnottex\n\ |
3372 | 229 subspace corresponding to the\n\ |
230 @iftex\n\ | |
231 @tex\n\ | |
232 $k$\n\ | |
233 @end tex\n\ | |
234 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
235 @ifnottex\n\ |
3372 | 236 @code{k}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
237 @end ifnottex\n\ |
3372 | 238 leading eigenvalues of\n\ |
239 @iftex\n\ | |
240 @tex\n\ | |
241 $S$.\n\ | |
242 @end tex\n\ | |
243 @end iftex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
244 @ifnottex\n\ |
3372 | 245 @code{s}.\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
246 @end ifnottex\n\ |
3372 | 247 @end deftypefn") |
2928 | 248 { |
249 octave_value_list retval; | |
250 | |
251 int nargin = args.length (); | |
252 | |
253 if (nargin < 1 || nargin > 2 || nargout > 2) | |
254 { | |
5823 | 255 print_usage (); |
2928 | 256 return retval; |
257 } | |
258 | |
259 octave_value arg = args(0); | |
260 | |
3523 | 261 std::string ord; |
2928 | 262 |
263 if (nargin == 2) | |
264 { | |
265 ord = args(1).string_value (); | |
266 | |
267 if (error_state) | |
268 { | |
269 error ("schur: expecting string as second argument"); | |
270 return retval; | |
271 } | |
272 } | |
273 | |
274 char ord_char = ord.empty () ? 'U' : ord[0]; | |
275 | |
276 if (ord_char != 'U' && ord_char != 'A' && ord_char != 'D' | |
277 && ord_char != 'u' && ord_char != 'a' && ord_char != 'd') | |
278 { | |
279 warning ("schur: incorrect ordered schur argument `%c'", | |
280 ord.c_str ()); | |
281 return retval; | |
282 } | |
283 | |
5275 | 284 octave_idx_type nr = arg.rows (); |
285 octave_idx_type nc = arg.columns (); | |
2928 | 286 |
287 int arg_is_empty = empty_arg ("schur", nr, nc); | |
288 | |
289 if (arg_is_empty < 0) | |
290 return retval; | |
291 else if (arg_is_empty > 0) | |
292 return octave_value_list (2, Matrix ()); | |
293 | |
294 if (nr != nc) | |
295 { | |
296 gripe_square_matrix_required ("schur"); | |
297 return retval; | |
298 } | |
299 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
300 if (arg.is_single_type ()) |
2928 | 301 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
302 if (arg.is_real_type ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
303 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
304 FloatMatrix tmp = arg.float_matrix_value (); |
2928 | 305 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
306 if (! error_state) |
2928 | 307 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
308 if (nargout == 0 || nargout == 1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
309 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
310 FloatSCHUR result (tmp, ord, false); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
311 retval(0) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
312 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
313 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
314 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
315 FloatSCHUR result (tmp, ord, true); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
316 retval(1) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
317 retval(0) = result.unitary_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
318 } |
2928 | 319 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
320 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
321 else if (arg.is_complex_type ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
322 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
323 FloatComplexMatrix ctmp = arg.float_complex_matrix_value (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
324 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
325 if (! error_state) |
2928 | 326 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
327 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
328 if (nargout == 0 || nargout == 1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
329 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
330 FloatComplexSCHUR result (ctmp, ord, false); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
331 retval(0) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
332 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
333 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
334 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
335 FloatComplexSCHUR result (ctmp, ord, true); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
336 retval(1) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
337 retval(0) = result.unitary_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
338 } |
2928 | 339 } |
340 } | |
341 } | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
342 else |
2928 | 343 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
344 if (arg.is_real_type ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
345 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
346 Matrix tmp = arg.matrix_value (); |
2928 | 347 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
348 if (! error_state) |
2928 | 349 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
350 if (nargout == 0 || nargout == 1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
351 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
352 SCHUR result (tmp, ord, false); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
353 retval(0) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
354 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
355 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
356 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
357 SCHUR result (tmp, ord, true); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
358 retval(1) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
359 retval(0) = result.unitary_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
360 } |
2928 | 361 } |
362 } | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
363 else if (arg.is_complex_type ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
364 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
365 ComplexMatrix ctmp = arg.complex_matrix_value (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
366 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
367 if (! error_state) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
368 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
369 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
370 if (nargout == 0 || nargout == 1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
371 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
372 ComplexSCHUR result (ctmp, ord, false); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
373 retval(0) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
374 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
375 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
376 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
377 ComplexSCHUR result (ctmp, ord, true); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
378 retval(1) = result.schur_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
379 retval(0) = result.unitary_matrix (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
380 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
381 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
382 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
383 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
384 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
385 gripe_wrong_type_arg ("schur", arg); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
386 } |
2928 | 387 } |
388 | |
389 return retval; | |
390 } | |
391 | |
392 /* | |
7814
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
393 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
394 %!test |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
395 %! a = [1, 2, 3; 4, 5, 9; 7, 8, 6]; |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
396 %! [u, s] = schur (a); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
397 %! assert(u' * a * u, s, sqrt (eps)); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
398 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
399 %!test |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
400 %! a = single([1, 2, 3; 4, 5, 9; 7, 8, 6]); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
401 %! [u, s] = schur (a); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
402 %! assert(u' * a * u, s, sqrt (eps('single'))); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
403 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
404 %!test |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
405 %! fail("schur ([1, 2; 3, 4], 2)","warning"); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
406 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
407 %!error <Invalid call to schur.*> schur (); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
408 %!error schur ([1, 2, 3; 4, 5, 6]); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
409 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
410 */ |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
411 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
412 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
413 /* |
2928 | 414 ;;; Local Variables: *** |
415 ;;; mode: C++ *** | |
416 ;;; End: *** | |
417 */ |