comparison src/quad.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
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 "Quad.h" 30 #include "Quad.h"
29 31
30 #include "tree-const.h" 32 #include "tree-const.h"
31 #include "variables.h" 33 #include "variables.h"
32 #include "mappers.h" 34 #include "mappers.h"
33 #include "gripes.h" 35 #include "gripes.h"
34 #include "error.h" 36 #include "error.h"
35 #include "utils.h" 37 #include "utils.h"
38 #include "pager.h"
36 #include "f-quad.h" 39 #include "f-quad.h"
37 40
38 // Global pointer for user defined function required by quadrature functions. 41 // Global pointer for user defined function required by quadrature functions.
39 static tree *quad_fcn; 42 static tree *quad_fcn;
40 43
49 builtin_quad_options_2 (const tree_constant *args, int nargin, int nargout) 52 builtin_quad_options_2 (const tree_constant *args, int nargin, int nargout)
50 { 53 {
51 return quad_options (args, nargin, nargout); 54 return quad_options (args, nargin, nargout);
52 } 55 }
53 #endif 56 #endif
57
58 static Quad_options quad_opts;
54 59
55 double 60 double
56 quad_user_function (double x) 61 quad_user_function (double x)
57 { 62 {
58 double retval = 0.0; 63 double retval = 0.0;
162 } 167 }
163 case 4: 168 case 4:
164 if (indefinite) 169 if (indefinite)
165 { 170 {
166 IndefQuad iq (quad_user_function, bound, indef_type, abstol, reltol); 171 IndefQuad iq (quad_user_function, bound, indef_type, abstol, reltol);
172 iq.copy (quad_opts);
167 val = iq.integrate (ier, nfun, abserr); 173 val = iq.integrate (ier, nfun, abserr);
168 } 174 }
169 else 175 else
170 { 176 {
171 if (have_sing) 177 if (have_sing)
172 { 178 {
173 DefQuad dq (quad_user_function, a, b, sing, abstol, reltol); 179 DefQuad dq (quad_user_function, a, b, sing, abstol, reltol);
180 dq.copy (quad_opts);
174 val = dq.integrate (ier, nfun, abserr); 181 val = dq.integrate (ier, nfun, abserr);
175 } 182 }
176 else 183 else
177 { 184 {
178 DefQuad dq (quad_user_function, a, b, abstol, reltol); 185 DefQuad dq (quad_user_function, a, b, abstol, reltol);
186 dq.copy (quad_opts);
179 val = dq.integrate (ier, nfun, abserr); 187 val = dq.integrate (ier, nfun, abserr);
180 } 188 }
181 } 189 }
182 break; 190 break;
183 default: 191 default:
193 retval[3] = tree_constant (abserr); 201 retval[3] = tree_constant (abserr);
194 202
195 return retval; 203 return retval;
196 } 204 }
197 205
206 typedef void (Quad_options::*d_set_opt_mf) (double);
207 typedef double (Quad_options::*d_get_opt_mf) (void);
208
209 #define MAX_TOKENS 2
210
211 struct QUAD_OPTIONS
212 {
213 char *keyword;
214 char *kw_tok[MAX_TOKENS + 1];
215 int min_len[MAX_TOKENS + 1];
216 int min_toks_to_match;
217 d_set_opt_mf d_set_fcn;
218 d_get_opt_mf d_get_fcn;
219 };
220
221 static QUAD_OPTIONS quad_option_table[] =
222 {
223 { "absolute tolerance",
224 { "absolute", "tolerance", NULL, },
225 { 1, 0, 0, }, 1,
226 Quad_options::set_absolute_tolerance,
227 Quad_options::absolute_tolerance, },
228
229 { "relative tolerance",
230 { "relative", "tolerance", NULL, },
231 { 1, 0, 0, }, 1,
232 Quad_options::set_relative_tolerance,
233 Quad_options::relative_tolerance, },
234
235 { NULL,
236 { NULL, NULL, NULL, },
237 { 0, 0, 0, }, 0,
238 NULL, NULL, },
239 };
240
241 static void
242 print_quad_option_list (void)
243 {
244 ostrstream output_buf;
245
246 print_usage ("quad_options", 1);
247
248 output_buf << "\n"
249 << "Options for quad include:\n\n"
250 << " keyword value\n"
251 << " ------- -----\n\n";
252
253 QUAD_OPTIONS *list = quad_option_table;
254
255 char *keyword;
256 while ((keyword = list->keyword) != (char *) NULL)
257 {
258 output_buf.form (" %-40s ", keyword);
259
260 double val = (quad_opts.*list->d_get_fcn) ();
261 if (val < 0.0)
262 output_buf << "computed automatically";
263 else
264 output_buf << val;
265
266 output_buf << "\n";
267 list++;
268 }
269
270 output_buf << "\n" << ends;
271 maybe_page_output (output_buf);
272 }
273
274 static void
275 do_quad_option (char *keyword, double val)
276 {
277 QUAD_OPTIONS *list = quad_option_table;
278
279 while (list->keyword != (char *) NULL)
280 {
281 if (keyword_almost_match (list->kw_tok, list->min_len, keyword,
282 list->min_toks_to_match, MAX_TOKENS))
283 {
284 (quad_opts.*list->d_set_fcn) (val);
285
286 return;
287 }
288 list++;
289 }
290
291 warning ("quad_options: no match for `%s'", keyword);
292 }
293
198 tree_constant * 294 tree_constant *
199 quad_options (const tree_constant *args, int nargin, int nargout) 295 quad_options (const tree_constant *args, int nargin, int nargout)
200 { 296 {
201 // Assumes that we have been given the correct number of arguments.
202
203 tree_constant *retval = NULL_TREE_CONST; 297 tree_constant *retval = NULL_TREE_CONST;
204 error ("quad_options: not implemented yet"); 298
299 if (nargin == 1)
300 {
301 print_quad_option_list ();
302 }
303 else if (nargin == 3)
304 {
305 if (args[1].is_string_type ())
306 {
307 char *keyword = args[1].string_value ();
308 double val = args[2].double_value ();
309 do_quad_option (keyword, val);
310 }
311 else
312 print_usage ("quad_options");
313 }
314 else
315 {
316 print_usage ("quad_options");
317 }
318
205 return retval; 319 return retval;
206 } 320 }
207 321
208 /* 322 /*
209 ;;; Local Variables: *** 323 ;;; Local Variables: ***