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-colloc.cc < prev    next >
C/C++ Source or Header  |  1996-09-28  |  3KB  |  141 lines
  1. // f-colloc.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. #ifdef HAVE_CONFIG_H
  25. #include "config.h"
  26. #endif
  27.  
  28. #include "CollocWt.h"
  29.  
  30. #include "tree-const.h"
  31. #include "error.h"
  32. #include "utils.h"
  33. #include "help.h"
  34. #include "defun-dld.h"
  35.  
  36. DEFUN_DLD_BUILTIN ("colloc", Fcolloc, Scolloc, 7, 4,
  37.   "[R, A, B, Q] = colloc (N [, \"left\"] [, \"right\"]): collocation weights")
  38. {
  39.   Octave_object retval;
  40.  
  41.   int nargin = args.length ();
  42.  
  43.   if (nargin < 1 || nargin > 3)
  44.     {
  45.       print_usage ("colloc");
  46.       return retval;
  47.     }
  48.  
  49.   if (! args(0).is_scalar_type ())
  50.     {
  51.       error ("colloc: first argument must be a scalar");
  52.       return retval;
  53.     }
  54.  
  55.   double tmp = args(0).double_value ();
  56.  
  57.   if (error_state)
  58.     return retval;
  59.  
  60.   if (xisnan (tmp))
  61.     {
  62.       error ("colloc: NaN is invalid as NCOL");
  63.       return retval;
  64.     }
  65.  
  66.   int ncol = NINT (tmp);
  67.   if (ncol < 0)
  68.     {
  69.       error ("colloc: first argument must be non-negative");
  70.       return retval;
  71.     }
  72.  
  73.   int ntot = ncol;
  74.   int left = 0;
  75.   int right = 0;
  76.  
  77.   for (int i = 1; i < nargin; i++)
  78.     {
  79.       if (args(i).is_defined ())
  80.     {
  81.       if (! args(i).is_string ())
  82.         {
  83.           error ("colloc: expecting string argument");
  84.           return retval;
  85.         }
  86.  
  87.       char *s = args(i).string_value ();
  88.  
  89.       if (s && (((*s == 'R' || *s == 'r') && strlen (s) == 1)
  90.             || strcmp (s, "right") == 0))
  91.         {
  92.           right = 1;
  93.         }
  94.       else if (s && (((*s == 'L' || *s == 'l') && strlen (s) == 1)
  95.              || strcmp (s, "left") == 0))
  96.         {
  97.           left = 1;
  98.         }
  99.       else
  100.         {
  101.           error ("colloc: unrecognized argument");
  102.           return retval;
  103.         }
  104.     }
  105.       else
  106.     {
  107.       error ("colloc: unexpected NULL argument");
  108.       return retval;
  109.     }
  110.     }
  111.  
  112.   ntot += left + right;
  113.   if (ntot < 1)
  114.     {
  115.       error ("colloc: the total number of roots must be positive");
  116.       return retval;
  117.     }
  118.   
  119.   CollocWt wts (ncol, left, right);
  120.  
  121.   ColumnVector r = wts.roots ();
  122.   Matrix A = wts.first ();
  123.   Matrix B = wts.second ();
  124.   ColumnVector q = wts.quad_weights ();
  125.  
  126.   retval(3) = q;
  127.   retval(2) = B;
  128.   retval(1) = A;
  129.   retval(0) = r;
  130.  
  131.   return retval;
  132. }
  133.  
  134. /*
  135. ;;; Local Variables: ***
  136. ;;; mode: C++ ***
  137. ;;; page-delimiter: "^/\\*" ***
  138. ;;; End: ***
  139. */
  140.  
  141.