Mercurial > hg > octave-lyh

comparison src/dassl.cc @ 289:c23f50e61c58

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1994-01-13 06:25:58 by jwe]
author jwe
date Thu, 13 Jan 1994 06:26:54 +0000
parents 7ec58832918f
children 3c23b8ea9099
comparison
equal deleted inserted replaced
288:f8ae4f4dc9fd 289:c23f50e61c58
22 */ 22 */
23 23
24 #ifdef HAVE_CONFIG_H 24 #ifdef HAVE_CONFIG_H
25 #include "config.h" 25 #include "config.h"
26 #endif 26 #endif
27
28 #include <strstream.h>
27 29
28 #include "DAE.h" 30 #include "DAE.h"
29 31
30 #include "tree-const.h" 32 #include "tree-const.h"
31 #include "variables.h" 33 #include "variables.h"
32 #include "gripes.h" 34 #include "gripes.h"
33 #include "error.h" 35 #include "error.h"
34 #include "utils.h" 36 #include "utils.h"
37 #include "pager.h"
35 #include "f-dassl.h" 38 #include "f-dassl.h"
36 39
37 // Global pointer for user defined function required by dassl. 40 // Global pointer for user defined function required by dassl.
38 static tree *dassl_fcn; 41 static tree *dassl_fcn;
39 42
48 builtin_dassl_options_2 (const tree_constant *args, int nargin, int nargout) 51 builtin_dassl_options_2 (const tree_constant *args, int nargin, int nargout)
49 { 52 {
50 return dassl_options (args, nargin, nargout); 53 return dassl_options (args, nargin, nargout);
51 } 54 }
52 #endif 55 #endif
56
57 static ODE_options dassl_opts;
53 58
54 ColumnVector 59 ColumnVector
55 dassl_user_function (const ColumnVector& x, const ColumnVector& xdot, double t) 60 dassl_user_function (const ColumnVector& x, const ColumnVector& xdot, double t)
56 { 61 {
57 ColumnVector retval; 62 ColumnVector retval;
151 156
152 double tzero = out_times.elem (0); 157 double tzero = out_times.elem (0);
153 158
154 DAEFunc func (dassl_user_function); 159 DAEFunc func (dassl_user_function);
155 DAE dae (state, deriv, tzero, func); 160 DAE dae (state, deriv, tzero, func);
161 dae.copy (dassl_opts);
156 162
157 Matrix output; 163 Matrix output;
158 Matrix deriv_output; 164 Matrix deriv_output;
159 165
160 if (crit_times_set) 166 if (crit_times_set)
166 retval[0] = tree_constant (output); 172 retval[0] = tree_constant (output);
167 retval[1] = tree_constant (deriv_output); 173 retval[1] = tree_constant (deriv_output);
168 return retval; 174 return retval;
169 } 175 }
170 176
177 typedef void (ODE_options::*d_set_opt_mf) (double);
178 typedef double (ODE_options::*d_get_opt_mf) (void);
179
180 #define MAX_TOKENS 3
181
182 struct ODE_OPTIONS
183 {
184 char *keyword;
185 char *kw_tok[MAX_TOKENS + 1];
186 int min_len[MAX_TOKENS + 1];
187 int min_toks_to_match;
188 d_set_opt_mf d_set_fcn;
189 d_get_opt_mf d_get_fcn;
190 };
191
192 static ODE_OPTIONS dassl_option_table[] =
193 {
194 { "absolute tolerance",
195 { "absolute", "tolerance", NULL, NULL, },
196 { 1, 0, 0, 0, }, 1,
197 ODE_options::set_absolute_tolerance,
198 ODE_options::absolute_tolerance, },
199
200 { "initial step size",
201 { "initial", "step", "size", NULL, },
202 { 1, 0, 0, 0, }, 1,
203 ODE_options::set_initial_step_size,
204 ODE_options::initial_step_size, },
205
206 { "maximum step size",
207 { "maximum", "step", "size", NULL, },
208 { 2, 0, 0, 0, }, 1,
209 ODE_options::set_maximum_step_size,
210 ODE_options::maximum_step_size, },
211
212 { "relative tolerance",
213 { "relative", "tolerance", NULL, NULL, },
214 { 1, 0, 0, 0, }, 1,
215 ODE_options::set_relative_tolerance,
216 ODE_options::relative_tolerance, },
217
218 { NULL,
219 { NULL, NULL, NULL, NULL, },
220 { 0, 0, 0, 0, }, 0,
221 NULL, NULL, },
222 };
223
224 static void
225 print_dassl_option_list (void)
226 {
227 ostrstream output_buf;
228
229 print_usage ("dassl_options", 1);
230
231 output_buf << "\n"
232 << "Options for dassl include:\n\n"
233 << " keyword value\n"
234 << " ------- -----\n\n";
235
236 ODE_OPTIONS *list = dassl_option_table;
237
238 char *keyword;
239 while ((keyword = list->keyword) != (char *) NULL)
240 {
241 output_buf.form (" %-40s ", keyword);
242
243 double val = (dassl_opts.*list->d_get_fcn) ();
244 if (val < 0.0)
245 output_buf << "computed automatically";
246 else
247 output_buf << val;
248
249 output_buf << "\n";
250 list++;
251 }
252
253 output_buf << "\n" << ends;
254 maybe_page_output (output_buf);
255 }
256
257 static void
258 do_dassl_option (char *keyword, double val)
259 {
260 ODE_OPTIONS *list = dassl_option_table;
261
262 while (list->keyword != (char *) NULL)
263 {
264 if (keyword_almost_match (list->kw_tok, list->min_len, keyword,
265 list->min_toks_to_match, MAX_TOKENS))
266 {
267 (dassl_opts.*list->d_set_fcn) (val);
268
269 return;
270 }
271 list++;
272 }
273
274 warning ("dassl_options: no match for `%s'", keyword);
275 }
276
171 tree_constant * 277 tree_constant *
172 dassl_options (const tree_constant *args, int nargin, int nargout) 278 dassl_options (const tree_constant *args, int nargin, int nargout)
173 { 279 {
174 // Assumes that we have been given the correct number of arguments.
175
176 tree_constant *retval = NULL_TREE_CONST; 280 tree_constant *retval = NULL_TREE_CONST;
177 error ("dassl_options: not implemented yet"); 281
282 if (nargin == 1)
283 {
284 print_dassl_option_list ();
285 }
286 else if (nargin == 3)
287 {
288 if (args[1].is_string_type ())
289 {
290 char *keyword = args[1].string_value ();
291 double val = args[2].double_value ();
292 do_dassl_option (keyword, val);
293 }
294 else
295 print_usage ("dassl_options");
296 }
297 else
298 {
299 print_usage ("dassl_options");
300 }
301
178 return retval; 302 return retval;
179 } 303 }
180 304
181 /* 305 /*
182 ;;; Local Variables: *** 306 ;;; Local Variables: ***