fCmplxAEPBAL.cc

Go to the documentation of this file.
00001 /*
00002 
00003 Copyright (C) 1994-2012 John W. Eaton
00004 Copyright (C) 2008 Jaroslav Hajek
00005 
00006 This file is part of Octave.
00007 
00008 Octave is free software; you can redistribute it and/or modify it
00009 under the terms of the GNU General Public License as published by the
00010 Free Software Foundation; either version 3 of the License, or (at your
00011 option) any later version.
00012 
00013 Octave is distributed in the hope that it will be useful, but WITHOUT
00014 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
00015 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
00016 for more details.
00017 
00018 You should have received a copy of the GNU General Public License
00019 along with Octave; see the file COPYING.  If not, see
00020 <http://www.gnu.org/licenses/>.
00021 
00022 */
00023 
00024 #ifdef HAVE_CONFIG_H
00025 #include <config.h>
00026 #endif
00027 
00028 #include <string>
00029 
00030 #include "fCmplxAEPBAL.h"
00031 #include "fMatrix.h"
00032 #include "f77-fcn.h"
00033 
00034 extern "C"
00035 {
00036   F77_RET_T
00037   F77_FUNC (cgebal, CGEBAL) (F77_CONST_CHAR_ARG_DECL,
00038                              const octave_idx_type&, FloatComplex*,
00039                              const octave_idx_type&, octave_idx_type&,
00040                              octave_idx_type&, float*, octave_idx_type&
00041                              F77_CHAR_ARG_LEN_DECL);
00042 
00043   F77_RET_T
00044   F77_FUNC (cgebak, CGEBAK) (F77_CONST_CHAR_ARG_DECL,
00045                              F77_CONST_CHAR_ARG_DECL,
00046                              const octave_idx_type&, const octave_idx_type&,
00047                              const octave_idx_type&, const float*,
00048                              const octave_idx_type&, FloatComplex*,
00049                              const octave_idx_type&, octave_idx_type&
00050                              F77_CHAR_ARG_LEN_DECL
00051                              F77_CHAR_ARG_LEN_DECL);
00052 }
00053 
00054 FloatComplexAEPBALANCE::FloatComplexAEPBALANCE (const FloatComplexMatrix& a,
00055                                                 bool noperm, bool noscal)
00056  : base_aepbal<FloatComplexMatrix, FloatColumnVector> ()
00057 {
00058   octave_idx_type n = a.cols ();
00059 
00060   if (a.rows () != n)
00061     {
00062       (*current_liboctave_error_handler) ("AEPBALANCE requires square matrix");
00063       return;
00064     }
00065 
00066   octave_idx_type info;
00067 
00068   scale = FloatColumnVector (n);
00069   float *pscale = scale.fortran_vec ();
00070 
00071   balanced_mat = a;
00072   FloatComplex *p_balanced_mat = balanced_mat.fortran_vec ();
00073 
00074   job = noperm ? (noscal ? 'N' : 'S') : (noscal ? 'P' : 'B');
00075 
00076   F77_XFCN (cgebal, CGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1),
00077                              n, p_balanced_mat, n, ilo, ihi,
00078                              pscale, info
00079                              F77_CHAR_ARG_LEN (1)));
00080 }
00081 
00082 FloatComplexMatrix
00083 FloatComplexAEPBALANCE::balancing_matrix (void) const
00084 {
00085   octave_idx_type n = balanced_mat.rows ();
00086   FloatComplexMatrix balancing_mat (n, n, 0.0);
00087   for (octave_idx_type i = 0; i < n; i++)
00088     balancing_mat.elem (i, i) = 1.0;
00089 
00090   FloatComplex *p_balancing_mat = balancing_mat.fortran_vec ();
00091   const float *pscale = scale.fortran_vec ();
00092 
00093   octave_idx_type info;
00094 
00095   char side = 'R';
00096 
00097   F77_XFCN (cgebak, CGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1),
00098                              F77_CONST_CHAR_ARG2 (&side, 1),
00099                              n, ilo, ihi, pscale, n,
00100                              p_balancing_mat, n, info
00101                              F77_CHAR_ARG_LEN (1)
00102                              F77_CHAR_ARG_LEN (1)));
00103 
00104   return balancing_mat;
00105 }
 All Classes Files Functions Variables Typedefs Enumerations Enumerator Friends Defines