home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / src / f-givens.cc < prev    next >
C/C++ Source or Header  |  1996-09-28  |  4KB  |  189 lines
  1. // f-givens.cc                                           -*- C++ -*-
  2. /*
  3.  
  4. Copyright (C) 1993, 1994, 1995 John W. Eaton
  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
  10. Free Software Foundation; either version 2, or (at your option) any
  11. later version.
  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
  19. along with Octave; see the file COPYING.  If not, write to the Free
  20. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. */
  23.  
  24. // Written by A. S. Hodel <scotte@eng.auburn.edu>
  25.  
  26. #ifdef HAVE_CONFIG_H
  27. #include "config.h"
  28. #endif
  29.  
  30. #include "dMatrix.h"
  31. #include "CMatrix.h"
  32. #include "f77-uscore.h"
  33.  
  34. #include "tree-const.h"
  35. #include "user-prefs.h"
  36. #include "error.h"
  37. #include "gripes.h"
  38. #include "help.h"
  39. #include "defun-dld.h"
  40.  
  41. extern "C"
  42. {
  43.   int F77_FCN (dlartg) (const double*, const double*, double*, double*,
  44.             double*);
  45.  
  46.   int F77_FCN (zlartg) (const Complex*, const Complex*, double*,
  47.             Complex*, Complex*);
  48. }
  49.  
  50. DEFUN_DLD_BUILTIN ("givens", Fgivens, Sgivens, 3, 2,
  51.   "G = givens (X, Y)\n\
  52. \n\
  53. compute orthogonal matrix G = [c s; -conj (s) c]\n\
  54. such that G [x; y] = [*; 0]  (x, y scalars)\n\
  55. \n\
  56. [c, s] = givens (x, y) returns the (c, s) values themselves.")
  57. {
  58.   Octave_object retval;
  59.  
  60.   int nargin = args.length ();
  61.  
  62.   if (nargin != 2 || nargout > 2)
  63.     {
  64.       print_usage ("givens");
  65.       return retval;
  66.     }
  67.  
  68.   tree_constant arg_a = args(0);
  69.   tree_constant arg_b = args(1);
  70.  
  71.   if (! arg_a.is_scalar_type () && arg_b.is_scalar_type ())
  72.     {
  73.       error("givens: requires two scalar arguments");
  74.       return retval;
  75.     }
  76.  
  77.   Complex cx, cy;
  78.   double x, y;
  79.  
  80.   if (arg_a.is_complex_type ())
  81.     {
  82.       cx = arg_a.complex_value ();
  83.  
  84.       if (error_state)
  85.     return retval;
  86.     }
  87.   else 
  88.     {
  89.       x = arg_a.double_value ();
  90.  
  91.       if (error_state)
  92.     return retval;
  93.  
  94.       cx = x;            // copy to complex just in case
  95.     }
  96.  
  97.   if (arg_b.is_complex_type ())
  98.     {
  99.       cy = arg_b.complex_value ();
  100.  
  101.       if (error_state)
  102.     return retval;
  103.     }
  104.   else
  105.     {
  106.       y = arg_b.double_value ();
  107.  
  108.       if (error_state)
  109.     return retval;
  110.  
  111.       cy = y;            // copy to complex just in case
  112.     }
  113.  
  114. // Now compute the rotation.
  115.  
  116.   double cc;
  117.   if (arg_a.is_complex_type () || arg_b.is_complex_type ())
  118.     {
  119.       Complex cs, temp_r;
  120.  
  121.       F77_FCN (zlartg) (&cx, &cy, &cc, &cs, &temp_r);
  122.  
  123.       switch (nargout)
  124.     {
  125.     case 0:        // output a matrix
  126.     case 1:
  127.       {
  128.         ComplexMatrix g (2, 2);
  129.         g.elem (0, 0) = cc;
  130.         g.elem (1, 1) = cc;
  131.         g.elem (0, 1) = cs;
  132.         g.elem (1, 0) = -conj (cs);
  133.  
  134.         retval(0) = g;
  135.       }
  136.       break;
  137.    
  138.     case 2:        // output scalar values
  139.       retval(0) = cc;
  140.       retval(1) = cs;
  141.       break;
  142.  
  143.     default:  
  144.       error ("givens: invalid number of output arguments");
  145.       break;
  146.     }
  147.     }
  148.   else
  149.     {
  150.       double s, temp_r;
  151.  
  152.       F77_FCN (dlartg) (&x, &y, &cc, &s, &temp_r);
  153.  
  154.       switch (nargout)
  155.     {
  156.     case 0:        // output a matrix
  157.     case 1:
  158.       {
  159.         Matrix g (2, 2);
  160.         g.elem (0, 0) = cc;
  161.         g.elem (1, 1) = cc;
  162.         g.elem (0, 1) = s;
  163.         g.elem (1, 0) = -s;
  164.  
  165.         retval(0) = g;
  166.       }
  167.       break;
  168.    
  169.     case 2:        // output scalar values
  170.       retval(0) = cc;
  171.       retval(1) = s;
  172.       break;
  173.    
  174.     default:
  175.       error ("givens: invalid number of output arguments");
  176.       break;
  177.     }
  178.     }
  179.  
  180.   return retval;
  181. }
  182.  
  183. /*
  184. ;;; Local Variables: ***
  185. ;;; mode: C++ ***
  186. ;;; page-delimiter: "^/\\*" ***
  187. ;;; End: ***
  188. */
  189.