Mercurial > hg > octave-jordi

changeset 3952:945e8c160191

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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;
 }