diff src/lsode.cc @ 289:c23f50e61c58

[project @ 1994-01-13 06:25:58 by jwe]
author jwe
date Thu, 13 Jan 1994 06:26:54 +0000
parents 7ec58832918f
children 3c23b8ea9099
line wrap: on
line diff
--- a/src/lsode.cc	Thu Jan 13 03:29:16 1994 +0000
+++ b/src/lsode.cc	Thu Jan 13 06:26:54 1994 +0000
@@ -25,6 +25,8 @@
 #include "config.h"
 #endif
 
+#include <strstream.h>
+
 #include "ODE.h"
 
 #include "tree-const.h"
@@ -32,6 +34,7 @@
 #include "gripes.h"
 #include "error.h"
 #include "utils.h"
+#include "pager.h"
 #include "f-lsode.h"
 
 // Global pointer for user defined function required by lsode.
@@ -51,6 +54,8 @@
 }
 #endif
 
+static ODE_options lsode_opts;
+
 ColumnVector
 lsode_user_function (const ColumnVector& x, double t)
 {
@@ -136,6 +141,7 @@
 
   ODEFunc func (lsode_user_function);
   ODE ode (state, tzero, func);
+  ode.copy (lsode_opts);
 
   int nstates = state.capacity ();
   Matrix output (nsteps, nstates + 1);
@@ -150,13 +156,137 @@
   return retval;
 }
 
+typedef void (ODE_options::*d_set_opt_mf) (double);
+typedef double (ODE_options::*d_get_opt_mf) (void);
+
+#define MAX_TOKENS 3
+
+struct ODE_OPTIONS
+{
+  char *keyword;
+  char *kw_tok[MAX_TOKENS + 1];
+  int min_len[MAX_TOKENS + 1];
+  int min_toks_to_match;
+  d_set_opt_mf d_set_fcn;
+  d_get_opt_mf d_get_fcn;
+};
+
+static ODE_OPTIONS lsode_option_table[] =
+{
+  { "absolute tolerance",
+    { "absolute", "tolerance", NULL, NULL, },
+    { 1, 0, 0, 0, }, 1,
+    ODE_options::set_absolute_tolerance,
+    ODE_options::absolute_tolerance, },
+
+  { "initial step size",
+    { "initial", "step", "size", NULL, },
+    { 1, 0, 0, 0, }, 1,
+    ODE_options::set_initial_step_size,
+    ODE_options::initial_step_size, },
+
+  { "maximum step size",
+    { "maximum", "step", "size", NULL, },
+    { 2, 0, 0, 0, }, 1,
+    ODE_options::set_maximum_step_size,
+    ODE_options::maximum_step_size, },
+
+  { "minimum step size",
+    { "minimum", "step", "size", NULL, },
+    { 2, 0, 0, 0, }, 1,
+    ODE_options::set_minimum_step_size,
+    ODE_options::minimum_step_size, },
+
+  { "relative tolerance",
+    { "relative", "tolerance", NULL, NULL, },
+    { 1, 0, 0, 0, }, 1,
+    ODE_options::set_relative_tolerance,
+    ODE_options::relative_tolerance, },
+
+  { NULL,
+    { NULL, NULL, NULL, NULL, },
+    { 0, 0, 0, 0, }, 0,
+    NULL, NULL, },
+};
+
+static void
+print_lsode_option_list (void)
+{
+  ostrstream output_buf;
+
+  print_usage ("lsode_options", 1);
+
+  output_buf << "\n"
+	     << "Options for lsode include:\n\n"
+	     << "  keyword                                  value\n"
+	     << "  -------                                  -----\n\n";
+
+  ODE_OPTIONS *list = lsode_option_table;
+
+  char *keyword;
+  while ((keyword = list->keyword) != (char *) NULL)
+    {
+      output_buf.form ("  %-40s ", keyword);
+
+      double val = (lsode_opts.*list->d_get_fcn) ();
+      if (val < 0.0)
+	output_buf << "computed automatically";
+      else
+	output_buf << val;
+
+      output_buf << "\n";
+      list++;
+    }
+
+  output_buf << "\n" << ends;
+  maybe_page_output (output_buf);
+}
+
+static void
+do_lsode_option (char *keyword, double val)
+{
+  ODE_OPTIONS *list = lsode_option_table;
+
+  while (list->keyword != (char *) NULL)
+    {
+      if (keyword_almost_match (list->kw_tok, list->min_len, keyword,
+				list->min_toks_to_match, MAX_TOKENS))
+	{
+	  (lsode_opts.*list->d_set_fcn) (val);
+
+	  return;
+	}
+      list++;
+    }
+
+  warning ("lsode_options: no match for `%s'", keyword);
+}
+
 tree_constant *
 lsode_options (const tree_constant *args, int nargin, int nargout)
 {
-// Assumes that we have been given the correct number of arguments.
+  tree_constant *retval = NULL_TREE_CONST;
 
-  tree_constant *retval = NULL_TREE_CONST;
-  error ("lsode_options: not implemented yet");
+  if (nargin == 1)
+    {
+      print_lsode_option_list ();
+    }
+  else if (nargin == 3)
+    {
+      if (args[1].is_string_type ())
+	{
+	  char *keyword = args[1].string_value ();
+	  double val = args[2].double_value ();
+	  do_lsode_option (keyword, val);
+	}
+      else
+	print_usage ("lsode_options");
+    }
+  else
+    {
+      print_usage ("lsode_options");
+    }
+
   return retval;
 }