octave: libinterp/corefcn/ordschur.cc annotate

annotate libinterp/corefcn/ordschur.cc @ 19747:56157a7505ed

Add new ordschur function. * libinterp/corefcn/ordschur.cc: New file. * libinterp/corefcn/module.mk: Include it in the list of source files. * scripts/help/__unimplemented__.m: Remove ordschur from the list of unimplemented functions. * doc/interpreter/linalg.txi: Add it to the interpreter manual. * NEWS: Mention it. * libinterp/corefcn/schur.cc (schur): Reference it from the documentation of the schur function. Thanks to Carnë Draug for improving the original patch, and to Mike Miller for reviewing it and suggesting improvements.

author	Sébastien Villemot <sebastien@debian.org>
date	Sat, 07 Feb 2015 21:51:20 +0100
parents
children	ca7599ae464d

rev	line source
19747 56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	1 /*
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	2
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	3 Copyright (C) 2015 Sébastien Villemot <sebastien@debian.org>
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	4
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	5 This file is part of Octave.
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	6
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	7 Octave is free software; you can redistribute it and/or modify it
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	8 under the terms of the GNU General Public License as published by the
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	9 Free Software Foundation; either version 3 of the License, or (at your
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	10 option) any later version.
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	11
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	12 Octave is distributed in the hope that it will be useful, but WITHOUT
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	15 for more details.
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	16
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	17 You should have received a copy of the GNU General Public License
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	18 along with Octave; see the file COPYING. If not, see
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	19 <http://www.gnu.org/licenses/>.
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	20
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	21 */
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	22
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	23 #ifdef HAVE_CONFIG_H
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	24 #include <config.h>
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	25 #endif
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	26
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	27 #include "defun.h"
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	28 #include "error.h"
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	29 #include "oct-obj.h"
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	30 #include "f77-fcn.h"
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	31
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	32 extern "C"
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	33 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	34 F77_RET_T
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	35 F77_FUNC (dtrsen, DTRSEN) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	36 const octave_idx_type*, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	37 double, const octave_idx_type&, double, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	38 double, double, octave_idx_type&, double&, double&, double*,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	39 const octave_idx_type&, octave_idx_type*,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	40 const octave_idx_type&, octave_idx_type&);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	41
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	42 F77_RET_T
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	43 F77_FUNC (ztrsen, ZTRSEN) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	44 const octave_idx_type*, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	45 Complex, const octave_idx_type&, Complex, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	46 Complex, octave_idx_type&, double&, double&, Complex,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	47 const octave_idx_type&, octave_idx_type &);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	48
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	49 F77_RET_T
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	50 F77_FUNC (strsen, STRSEN) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	51 const octave_idx_type*, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	52 float, const octave_idx_type&, float, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	53 float, float, octave_idx_type&, float&, float&, float*,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	54 const octave_idx_type&, octave_idx_type*,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	55 const octave_idx_type&, octave_idx_type&);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	56
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	57 F77_RET_T
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	58 F77_FUNC (ctrsen, CTRSEN) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	59 const octave_idx_type*, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	60 FloatComplex, const octave_idx_type&, FloatComplex, const octave_idx_type&,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	61 FloatComplex, octave_idx_type&, float&, float&, FloatComplex,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	62 const octave_idx_type&, octave_idx_type &);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	63 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	64
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	65 DEFUN (ordschur, args, ,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	66 "-- texinfo --\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	67 @deftypefn {Loadable Function} {[@var{UR}, @var{SR}] =} ordschur (@var{U}, @var{S}, @var{select})\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	68 Reorders the real Schur factorization (@var{U},@var{S}) obtained with the\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	69 @code{schur} function, so that selected eigenvalues appear in the upper left\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	70 diagonal blocks of the quasi triangular Schur matrix.\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	71 The logical vector @var{select} specifies the selected eigenvalues as they\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	72 appear along @var{S}'s diagonal.\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	73 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	74 For example, given the matrix @code{@var{A} = [1, 2; 3, 4]}, and its Schur\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	75 decomposition\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	76 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	77 @example\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	78 [@var{U}, @var{S}] = schur (@var{A})\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	79 @end example\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	80 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	81 which returns\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	82 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	83 @example\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	84 @group\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	85 @var{U} =\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	86 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	87 -0.82456 -0.56577\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	88 0.56577 -0.82456\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	89 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	90 @var{S} =\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	91 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	92 -0.37228 -1.00000\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	93 0.00000 5.37228\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	94 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	95 @end group\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	96 @end example\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	97 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	98 It is possible to reorder the decomposition so that the positive eigenvalue is\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	99 in the upper left corner, by doing:\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	100 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	101 @example\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	102 [@var{U}, @var{S}] = ordschur (@var{U}, @var{S}, [0,1])\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	103 @end example\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	104 \n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	105 @seealso{schur}\n\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	106 @end deftypefn")
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	107 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	108 const octave_idx_type nargin = args.length ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	109 octave_value_list retval;
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	110
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	111 if (nargin != 3)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	112 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	113 print_usage ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	114 return retval;
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	115 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	116
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	117 const Array<octave_idx_type> sel = args(2).octave_idx_type_vector_value ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	118 if (error_state)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	119 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	120 error ("ordschur: SELECT must be an array of integers");
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	121 return retval;
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	122 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	123 const octave_idx_type n = sel.numel ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	124
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	125 const dim_vector dimU = args(0).dims ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	126 const dim_vector dimS = args(1).dims ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	127 if (n != dimU(0))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	128 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	129 error ("ordschur: SELECT must have same length as the sides of U and S");
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	130 return retval;
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	131 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	132 else if (n != dimU(0) \|\| n != dimS(0) \|\| n != dimU(1) \|\| n != dimS(1))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	133 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	134 error ("ordschur: U and S must be square and of equal sizes");
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	135 return retval;
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	136 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	137
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	138 const bool double_type = args(0).is_double_type ()
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	139 \|\| args(1).is_double_type ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	140 const bool complex_type = args(0).is_complex_type ()
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	141 \|\| args(1).is_complex_type ();
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	142
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	143 #define PREPARE_ARGS(TYPE, TYPE_M, TYPE_COND) \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	144 TYPE ## Matrix U = args(0).TYPE_M ## _value (); \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	145 TYPE ## Matrix S = args(1).TYPE_M ## _value (); \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	146 if (error_state) \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	147 { \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	148 error ("ordschur: U and S must be real or complex floating point matrices"); \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	149 return retval; \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	150 } \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	151 TYPE ## Matrix w (dim_vector (n, 1)); \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	152 TYPE ## Matrix work (dim_vector (n, 1)); \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	153 octave_idx_type m; \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	154 octave_idx_type info; \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	155 TYPE_COND cond1, cond2;
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	156
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	157 #define PREPARE_OUTPUT()\
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	158 if (info != 0) \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	159 { \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	160 error ("ordschur: trsen failed"); \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	161 return retval; \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	162 } \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	163 retval(0) = U; \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	164 retval(1) = S; \
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	165
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	166 if (double_type)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	167 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	168 if (complex_type)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	169 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	170 PREPARE_ARGS (Complex, complex_matrix, double)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	171
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	172 F77_XFCN (ztrsen, ztrsen,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	173 (F77_CONST_CHAR_ARG ("N"), F77_CONST_CHAR_ARG ("V"),
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	174 sel.data (), n, S.fortran_vec (), n, U.fortran_vec (), n,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	175 w.fortran_vec (), m, cond1, cond2, work.fortran_vec (), n,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	176 info));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	177 PREPARE_OUTPUT()
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	178 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	179 else
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	180 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	181 PREPARE_ARGS (, matrix, double)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	182 Matrix wi (dim_vector (n, 1));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	183 Array<octave_idx_type> iwork (dim_vector (n, 1));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	184
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	185 F77_XFCN (dtrsen, dtrsen,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	186 (F77_CONST_CHAR_ARG ("N"), F77_CONST_CHAR_ARG ("V"),
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	187 sel.data (), n, S.fortran_vec (), n, U.fortran_vec (), n,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	188 w.fortran_vec (), wi.fortran_vec (), m, cond1, cond2,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	189 work.fortran_vec (), n, iwork.fortran_vec (), n, info));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	190 PREPARE_OUTPUT ()
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	191 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	192 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	193 else
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	194 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	195 if (complex_type)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	196 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	197 PREPARE_ARGS (FloatComplex, float_complex_matrix, float)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	198
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	199 F77_XFCN (ctrsen, ctrsen,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	200 (F77_CONST_CHAR_ARG ("N"), F77_CONST_CHAR_ARG ("V"),
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	201 sel.data (), n, S.fortran_vec (), n, U.fortran_vec (), n,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	202 w.fortran_vec (), m, cond1, cond2, work.fortran_vec (), n,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	203 info));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	204 PREPARE_OUTPUT ()
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	205 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	206 else
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	207 {
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	208 PREPARE_ARGS (Float, float_matrix, float)
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	209 FloatMatrix wi (dim_vector (n, 1));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	210 Array<octave_idx_type> iwork (dim_vector (n, 1));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	211
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	212 F77_XFCN (strsen, strsen,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	213 (F77_CONST_CHAR_ARG ("N"), F77_CONST_CHAR_ARG ("V"),
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	214 sel.data (), n, S.fortran_vec (), n, U.fortran_vec (), n,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	215 w.fortran_vec (), wi.fortran_vec (), m, cond1, cond2,
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	216 work.fortran_vec (), n, iwork.fortran_vec (), n, info));
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	217 PREPARE_OUTPUT ()
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	218 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	219 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	220
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	221 #undef PREPARE_ARGS
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	222 #undef PREPARE_OUTPUT
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	223
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	224 return retval;
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	225 }
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	226
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	227 /*
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	228
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	229 %!test
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	230 %! A = [1, 2, 3, -2; 4, 5, 6, -5 ; 7, 8, 9, -5; 10, 11, 12, 4 ];
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	231 %! [U, T] = schur (A);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	232 %! [US, TS] = ordschur (U, T, [ 0, 0, 1, 1 ]);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	233 %! assert (USTSUS', A, sqrt (eps))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	234 %! assert (diag (T)(3:4), diag (TS)(1:2), sqrt (eps))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	235
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	236 %!test
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	237 %! A = [1, 2, 3, -2; 4, 5, 6, -5 ; 7, 8, 9, -5; 10, 11, 12, 4 ];
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	238 %! [U, T] = schur (A);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	239 %! [US, TS] = ordschur (single (U), single (T), [ 0, 0, 1, 1 ]);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	240 %! assert (USTSUS', A, sqrt (eps ("single")))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	241 %! assert (diag (T)(3:4), diag (TS)(1:2), sqrt (eps ("single")))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	242
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	243 %!test
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	244 %! A = [1, 2, 3, -2; 4, 5, 6, -5 ; 7, 8, 9, -5; 10, 11, 12, 4+3i ];
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	245 %! [U, T] = schur (A);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	246 %! [US, TS] = ordschur (U, T, [ 0, 0, 1, 1 ]);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	247 %! assert (USTSUS', A, sqrt (eps))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	248 %! assert (diag (T)(3:4), diag (TS)(1:2), sqrt (eps))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	249
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	250 %!test
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	251 %! A = [1, 2, 3, -2; 4, 5, 6, -5 ; 7, 8, 9, -5; 10, 11, 12, 4+3i ];
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	252 %! [U, T] = schur (A);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	253 %! [US, TS] = ordschur (single (U), single (T), [ 0, 0, 1, 1 ]);
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	254 %! assert (USTSUS', A, sqrt (eps ("single")))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	255 %! assert (diag (T)(3:4), diag (TS)(1:2), sqrt (eps ("single")))
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	256
56157a7505ed Add new ordschur function. Sébastien Villemot <sebastien@debian.org> parents: diff changeset	257 */

Mercurial > octave

annotate libinterp/corefcn/ordschur.cc @ 19747:56157a7505ed