Mercurial > hg > octave-terminal
changeset 3952:945e8c160191
[project @ 2002-05-23 17:18:12 by jwe]
author | jwe |
---|---|
date | Thu, 23 May 2002 17:18:13 +0000 |
parents | e6f67a1ed814 |
children | 3a8de88328af |
files | liboctave/Array.h liboctave/ChangeLog liboctave/LSODE.cc liboctave/LSODE.h src/ChangeLog src/DLD-FUNCTIONS/lsode.cc |
diffstat | 6 files changed, 154 insertions(+), 42 deletions(-) [+] |
line wrap: on
line diff
--- a/liboctave/Array.h +++ b/liboctave/Array.h @@ -222,6 +222,8 @@ const T *data (void) const { return rep->data; } + const T *fortran_vec (void) const { return data (); } + T *fortran_vec (void); Array<T>& qsort (int (*compare) (const void *, const void *))
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,13 @@ +2002-05-23 John W. Eaton <jwe@bevo.che.wisc.edu> + + * LSODE.h (LSODE_options::x_absolute_tolerance): Now Array<double>. + Change all uses. + (LSODE_OPTIONS::absolute_tolerance): Return Array<double>, not double. + (LSODE_OPTIONS::set_absolute_tolerance (const Array<double>&)): + New function. + + * Array.h (Array::fortran_vec): New const version. + 2002-05-22 John W. Eaton <jwe@bevo.che.wisc.edu> * cmd-edit.cc (gnu_readline::history_search_backward): New function.
--- a/liboctave/LSODE.cc +++ b/liboctave/LSODE.cc @@ -46,9 +46,9 @@ extern "C" int F77_FUNC (lsode, LSODE) (lsode_fcn_ptr, int&, double*, double&, - double&, int&, double&, double&, int&, - int&, int&, double*, int&, int*, int&, - lsode_jac_ptr, int&); + double&, int&, double&, const double*, int&, + int&, int&, double*, int&, int*, int&, + lsode_jac_ptr, int&); static ODEFunc::ODERHSFunc user_fun; static ODEFunc::ODEJacFunc user_jac; @@ -65,7 +65,6 @@ restart = 1; istate = 1; - itol = 1; itask = 1; iopt = 0; @@ -87,7 +86,6 @@ restart = 1; istate = 1; - itol = 1; itask = 1; iopt = 0; @@ -229,9 +227,27 @@ itask = 1; } - double abs_tol = absolute_tolerance (); double rel_tol = relative_tolerance (); + const Array<double> abs_tol = absolute_tolerance (); + + int abs_tol_len = abs_tol.length (); + + int itol; + + if (abs_tol_len == 1) + itol = 1; + else if (abs_tol_len == n) + itol == 2; + else + { + (*current_liboctave_error_handler) + ("lsode: inconsistent sizes for state and absolute tolerance vectors"); + + integration_error = 1; + return retval; + } + if (initial_step_size () >= 0.0) { rwork.elem (4) = initial_step_size (); @@ -256,11 +272,12 @@ iopt = 1; } + const double *pabs_tol = abs_tol.fortran_vec (); int *piwork = iwork.fortran_vec (); double *prwork = rwork.fortran_vec (); F77_XFCN (lsode, LSODE, (lsode_f, n, xp, t, tout, itol, rel_tol, - abs_tol, itask, istate, iopt, prwork, lrw, + pabs_tol, itask, istate, iopt, prwork, lrw, piwork, liw, lsode_j, method_flag)); if (f77_exception_encountered)
--- a/liboctave/LSODE.h +++ b/liboctave/LSODE.h @@ -54,7 +54,8 @@ void init (void) { double sqrt_eps = ::sqrt (DBL_EPSILON); - x_absolute_tolerance = sqrt_eps; + x_absolute_tolerance.resize (1); + x_absolute_tolerance(0) = sqrt_eps; x_initial_step_size = -1.0; x_maximum_step_size = -1.0; x_minimum_step_size = 0.0; @@ -80,7 +81,13 @@ void set_default_options (void) { init (); } void set_absolute_tolerance (double val) - { x_absolute_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } + { + x_absolute_tolerance.resize (1); + x_absolute_tolerance(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_absolute_tolerance (const Array<double>& val) + { x_absolute_tolerance = val; } void set_initial_step_size (double val) { x_initial_step_size = (val >= 0.0) ? val : -1.0; } @@ -97,27 +104,27 @@ void set_step_limit (int val) { x_step_limit = val; } - double absolute_tolerance (void) + Array<double> absolute_tolerance (void) const { return x_absolute_tolerance; } - double initial_step_size (void) + double initial_step_size (void) const { return x_initial_step_size; } - double maximum_step_size (void) + double maximum_step_size (void) const { return x_maximum_step_size; } - double minimum_step_size (void) + double minimum_step_size (void) const { return x_minimum_step_size; } - double relative_tolerance (void) + double relative_tolerance (void) const { return x_relative_tolerance; } - int step_limit (void) + int step_limit (void) const { return x_step_limit; } private: - double x_absolute_tolerance; + Array<double> x_absolute_tolerance; double x_initial_step_size; double x_maximum_step_size; double x_minimum_step_size; @@ -162,7 +169,6 @@ Array<int> iwork; Array<double> rwork; int istate; - int itol; int itask; int iopt; int liw;
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2002-05-23 John W. Eaton <jwe@bevo.che.wisc.edu> + + * DLD-FUNCTIONS/lsode.cc (LSODE_options::da_set_opt_mf, + LSODE_options::da_get_opt_mf): New typedefs. + (LSODE_OPTIONS::da_set_fcn, LSODE_OPTIONS::da_get_fcn): New fields. + (lsode_option_table): Fill them in. + (set_lsode_option (const Array<double>&)): New function. + (print_lsode_option_list): Handle vector options. + (show_lsode_option_list): Likewise. + (Flsode_options): Likewise. + 2002-05-22 John W. Eaton <jwe@bevo.che.wisc.edu> * c-file-ptr-stream.h (c_file_ptr_buf::fclose): New function.
--- a/src/DLD-FUNCTIONS/lsode.cc +++ b/src/DLD-FUNCTIONS/lsode.cc @@ -38,6 +38,7 @@ #include "oct-obj.h" #include "ov-fcn.h" #include "pager.h" +#include "pr-output.h" #include "unwind-prot.h" #include "utils.h" #include "variables.h" @@ -294,10 +295,12 @@ return retval; } +typedef void (LSODE_options::*da_set_opt_mf) (const Array<double>&); typedef void (LSODE_options::*d_set_opt_mf) (double); typedef void (LSODE_options::*i_set_opt_mf) (int); -typedef double (LSODE_options::*d_get_opt_mf) (void); -typedef int (LSODE_options::*i_get_opt_mf) (void); +typedef Array<double> (LSODE_options::*da_get_opt_mf) (void) const; +typedef double (LSODE_options::*d_get_opt_mf) (void) const; +typedef int (LSODE_options::*i_get_opt_mf) (void) const; #define MAX_TOKENS 3 @@ -307,8 +310,10 @@ const char *kw_tok[MAX_TOKENS + 1]; int min_len[MAX_TOKENS + 1]; int min_toks_to_match; + da_set_opt_mf da_set_fcn; d_set_opt_mf d_set_fcn; i_set_opt_mf i_set_fcn; + da_get_opt_mf da_get_fcn; d_get_opt_mf d_get_fcn; i_get_opt_mf i_get_fcn; }; @@ -318,43 +323,43 @@ { "absolute tolerance", { "absolute", "tolerance", 0, 0, }, { 1, 0, 0, 0, }, 1, - &LSODE_options::set_absolute_tolerance, 0, - &LSODE_options::absolute_tolerance, 0, }, + &LSODE_options::set_absolute_tolerance, 0, 0, + &LSODE_options::absolute_tolerance, 0, 0, }, { "initial step size", { "initial", "step", "size", 0, }, { 1, 0, 0, 0, }, 1, - &LSODE_options::set_initial_step_size, 0, - &LSODE_options::initial_step_size, 0, }, + 0, &LSODE_options::set_initial_step_size, 0, + 0, &LSODE_options::initial_step_size, 0, }, { "maximum step size", { "maximum", "step", "size", 0, }, { 2, 0, 0, 0, }, 1, - &LSODE_options::set_maximum_step_size, 0, - &LSODE_options::maximum_step_size, 0, }, + 0, &LSODE_options::set_maximum_step_size, 0, + 0, &LSODE_options::maximum_step_size, 0, }, { "minimum step size", { "minimum", "step", "size", 0, }, { 2, 0, 0, 0, }, 1, - &LSODE_options::set_minimum_step_size, 0, - &LSODE_options::minimum_step_size, 0, }, + 0, &LSODE_options::set_minimum_step_size, 0, + 0, &LSODE_options::minimum_step_size, 0, }, { "relative tolerance", { "relative", "tolerance", 0, 0, }, { 1, 0, 0, 0, }, 1, - &LSODE_options::set_relative_tolerance, 0, - &LSODE_options::relative_tolerance, 0, }, + 0, &LSODE_options::set_relative_tolerance, 0, + 0, &LSODE_options::relative_tolerance, 0, }, { "step limit", { "step", "limit", 0, 0, }, { 1, 0, 0, 0, }, 1, - 0, &LSODE_options::set_step_limit, - 0, &LSODE_options::step_limit, }, + 0, 0, &LSODE_options::set_step_limit, + 0, 0, &LSODE_options::step_limit, }, { 0, { 0, 0, 0, 0, }, { 0, 0, 0, 0, }, 0, - 0, 0, 0, 0, }, + 0, 0, 0, 0, 0, 0, }, }; static void @@ -378,7 +383,26 @@ << std::resetiosflags (std::ios::left) << " "; - if (list->d_get_fcn) + if (list->da_get_fcn) + { + Array<double> val = (lsode_opts.*list->da_get_fcn) (); + if (val.length () == 1) + { + if (val(0) < 0.0) + os << "computed automatically"; + else + os << val(0); + } + else + { + os << "\n\n"; + // XXX FIXME XXX + Matrix tmp = Matrix (ColumnVector (val)); + octave_print_internal (os, tmp, false, 2); + os << "\n"; + } + } + else if (list->d_get_fcn) { double val = (lsode_opts.*list->d_get_fcn) (); if (val < 0.0) @@ -431,6 +455,29 @@ warning ("lsode_options: no match for `%s'", keyword.c_str ()); } +static void +set_lsode_option (const std::string& keyword, const Array<double>& val) +{ + LSODE_OPTIONS *list = lsode_option_table; + + while (list->keyword != 0) + { + if (keyword_almost_match (list->kw_tok, list->min_len, keyword, + list->min_toks_to_match, MAX_TOKENS)) + { + if (list->da_set_fcn) + (lsode_opts.*list->da_set_fcn) (val); + else + error ("lsode_options: no function to handle vector option"); + + return; + } + list++; + } + + warning ("lsode_options: no match for `%s'", keyword.c_str ()); +} + static octave_value_list show_lsode_option (const std::string& keyword) { @@ -443,7 +490,20 @@ if (keyword_almost_match (list->kw_tok, list->min_len, keyword, list->min_toks_to_match, MAX_TOKENS)) { - if (list->d_get_fcn) + if (list->da_get_fcn) + { + Array<double> val = (lsode_opts.*list->da_get_fcn) (); + if (val.length () == 1) + { + if (val(0) < 0.0) + retval = "computed automatically"; + else + retval = val(0); + } + else + retval = ColumnVector (val); + } + else if (list->d_get_fcn) { double val = (lsode_opts.*list->d_get_fcn) (); if (val < 0.0) @@ -487,7 +547,6 @@ if (nargin == 0) { print_lsode_option_list (octave_stdout); - return retval; } else if (nargin == 1 || nargin == 2) { @@ -496,21 +555,28 @@ if (! error_state) { if (nargin == 1) - return show_lsode_option (keyword); + retval = show_lsode_option (keyword); else { - double val = args(1).double_value (); + if (args(1).is_scalar_type ()) + { + double val = args(1).double_value (); - if (! error_state) + if (! error_state) + set_lsode_option (keyword, val); + } + else { - set_lsode_option (keyword, val); - return retval; + Array<double> val = args(1).vector_value (); + + if (! error_state) + set_lsode_option (keyword, val); } } } } - - print_usage ("lsode_options"); + else + print_usage ("lsode_options"); return retval; }