octave-lojdl: src/DLD-FUNCTIONS/lsode.cc comparison

comparison src/DLD-FUNCTIONS/lsode.cc @ 5729:e065f7c18bdc

[project @ 2006-04-03 19:03:30 by jwe]

author	jwe
date	Mon, 03 Apr 2006 19:03:31 +0000
parents	95d90f781ca8
children	080c08b192d8

comparison

equal deleted inserted replaced

-:4ff0cb3e1dd1
+:e065f7c18bdc
 #include "defun-dld.h"
 #include "error.h"
 #include "gripes.h"
 #include "oct-obj.h"
 #include "ov-fcn.h"
+#include "ov-cell.h"
 #include "pager.h"
 #include "pr-output.h"
 #include "unwind-prot.h"
 #include "utils.h"
 #include "variables.h"
 corresponding to an element of the vector @var{t}.  The first element\n\
 of @var{t} should be @math{t_0} and should correspond to the initial\n\
 state of the system @var{x_0}, so that the first row of the output\n\
 is @var{x_0}.\n\
 \n\
-The first argument, @var{fcn}, is a string that names the function to\n\
+The first argument, @var{fcn}, is a string, or cell array of strings,\n\
-call to compute the vector of right hand sides for the set of equations.\n\
+inline or function handles, that names the function to call to compute\n\
-The function must have the form\n\
+the vector of right hand sides for the set of equations. The function\n\
+must have the form\n\
 \n\
 @example\n\
 @var{xdot} = f (@var{x}, @var{t})\n\
 @end example\n\
 \n\
 int nargin = args.length ();
 if (nargin > 2 && nargin < 5 && nargout < 4)
 {
+std::string fcn_name, fname, jac_name, jname;
 lsode_fcn = 0;
 lsode_jac = 0;
 octave_value f_arg = args(0);
-switch (f_arg.rows ())
+if (f_arg.is_cell ())
 	{
-	case 1:
+	  Cell c = f_arg.cell_value ();
-	  lsode_fcn = extract_function
+	  if (c.length() == 1)
-	    (f_arg, "lsode", "__lsode_fcn__",
+	    f_arg = c(0);
-	     "function xdot = __lsode_fcn__ (x, t) xdot = ",
+	  else if (c.length() == 2)
-	     "; endfunction");
+	    {
-	  break;
+	      if (c(0).is_function_handle () || c(0).is_inline_function ())
+		lsode_fcn = c(0).function_value ();
-	case 2:
+	      else
-	  {
+		{
-	    string_vector tmp = f_arg.all_strings ();
+		  fcn_name = unique_symbol_name ("__lsode_fcn__");
+		  fname = "function y = ";
-	    if (! error_state)
+		  fname.append (fcn_name);
-	      {
+		  fname.append (" (x, t) y = ");
-		lsode_fcn = extract_function
+		  lsode_fcn = extract_function
-		  (tmp(0), "lsode", "__lsode_fcn__",
+		    (c(0), "lsode", fcn_name, fname, "; endfunction");
-		   "function xdot = __lsode_fcn__ (x, t) xdot = ",
+		}
-		   "; endfunction");
+	      if (lsode_fcn)
-		if (lsode_fcn)
+		{
+		  if (c(1).is_function_handle () || c(1).is_inline_function ())
+		    lsode_jac = c(1).function_value ();
+		  else
+		    {
+			jac_name = unique_symbol_name ("__lsode_jac__");
+			jname = "function jac = ";
+			jname.append(jac_name);
+			jname.append (" (x, t) jac = ");
+			lsode_jac = extract_function
+			  (c(1), "lsode", jac_name, jname, "; endfunction");
+		      if (!lsode_jac)
+			{
+			  if (fcn_name.length())
+			    clear_function (fcn_name);
+			  lsode_fcn = 0;
+			}
+		    }
+		}
+	    }
+	  else
+	    LSODE_ABORT1 ("incorrect number of elements in cell array");
+	}
+if (!lsode_fcn && ! f_arg.is_cell())
+	{
+	  if (f_arg.is_function_handle () || f_arg.is_inline_function ())
+	    lsode_fcn = f_arg.function_value ();
+	  else
+	    {
+	      switch (f_arg.rows ())
+		{
+		case 1:
+		  do
+		    {
+		      fcn_name = unique_symbol_name ("__lsode_fcn__");
+		      fname = "function y = ";
+		      fname.append (fcn_name);
+		      fname.append (" (x, t) y = ");
+		      lsode_fcn = extract_function
+			(f_arg, "lsode", fcn_name, fname, "; endfunction");
+		    }
+		  while (0);
+		  break;
+		case 2:
 		  {
-		    lsode_jac = extract_function
+		    string_vector tmp = f_arg.all_strings ();
-		      (tmp(1), "lsode", "__lsode_jac__",
-		       "function jac = __lsode_jac__ (x, t) jac = ",
+		    if (! error_state)
-		       "; endfunction");
+		      {
+			fcn_name = unique_symbol_name ("__lsode_fcn__");
-		    if (! lsode_jac)
+			fname = "function y = ";
-		      lsode_fcn = 0;
+			fname.append (fcn_name);
+			fname.append (" (x, t) y = ");
+			lsode_fcn = extract_function
+			  (tmp(0), "lsode", fcn_name, fname, "; endfunction");
+			if (lsode_fcn)
+			  {
+			    jac_name = unique_symbol_name ("__lsode_jac__");
+			    jname = "function jac = ";
+			    jname.append(jac_name);
+			    jname.append (" (x, t) jac = ");
+			    lsode_jac = extract_function
+			      (tmp(1), "lsode", jac_name, jname,
+			      "; endfunction");
+			    if (!lsode_jac)
+			      {
+				if (fcn_name.length())
+				  clear_function (fcn_name);
+				lsode_fcn = 0;
+			      }
+			  }
+		      }
 		  }
-	      }
+		  break;
-	  }
-	  break;
+		default:
+		  LSODE_ABORT1
-	default:
+		    ("first arg should be a string or 2-element string array");
-	  LSODE_ABORT1
+		}
-	    ("first arg should be a string or 2-element string array");
+	    }
 	}
 if (error_state || ! lsode_fcn)
 	LSODE_ABORT ();
 if (crit_times_set)
 	output = ode.integrate (out_times, crit_times);
 else
 	output = ode.integrate (out_times);
+if (fcn_name.length())
+	clear_function (fcn_name);
+if (jac_name.length())
+	clear_function (jac_name);
 if (! error_state)
 	{
 	  std::string msg = ode.error_message ();
 	  retval(2) = msg;

Mercurial > hg > octave-lojdl

comparison src/DLD-FUNCTIONS/lsode.cc @ 5729:e065f7c18bdc