Mercurial > octave
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; }