Mercurial > octave
diff src/DLD-FUNCTIONS/quad.cc @ 3243:dd00769643ae
[project @ 1999-05-28 04:19:00 by jwe]
author | jwe |
---|---|
date | Fri, 28 May 1999 04:19:24 +0000 |
parents | 9c5160c83bd2 |
children | 7d80b56e0dc8 |
line wrap: on
line diff
--- a/src/DLD-FUNCTIONS/quad.cc Fri Apr 09 00:20:06 1999 +0000 +++ b/src/DLD-FUNCTIONS/quad.cc Fri May 28 04:19:24 1999 +0000 @@ -37,6 +37,7 @@ #include "pager.h" #include "oct-obj.h" #include "ov-fcn.h" +#include "unwind-prot.h" #include "utils.h" #include "variables.h" @@ -49,6 +50,9 @@ static Quad_options quad_opts; +// Is this a recursive call? +static int call_depth = 0; + double quad_user_function (double x) { @@ -111,141 +115,157 @@ { octave_value_list retval; + unwind_protect::begin_frame ("Fquad"); + + unwind_protect_int (call_depth); + call_depth++; + + if (call_depth > 1) + { + error ("quad: invalid recursive call"); + return retval; + } + int nargin = args.length (); - if (nargin < 3 || nargin > 5 || nargout > 4) + if (nargin > 2 && nargin < 6 && nargout < 5) + { + quad_fcn = extract_function (args(0), "quad", "__quad_fcn__", + "function y = __quad_fcn__ (x) y = ", + "; endfunction"); + if (! quad_fcn) + return retval; + + double a = args(1).double_value (); + + if (error_state) + { + error ("quad: expecting second argument to be a scalar"); + return retval; + } + + double b = args(2).double_value (); + + if (error_state) + { + error ("quad: expecting third argument to be a scalar"); + return retval; + } + + int indefinite = 0; + IndefQuad::IntegralType indef_type = IndefQuad::doubly_infinite; + double bound = 0.0; + if (xisinf (a) && xisinf (b)) + { + indefinite = 1; + indef_type = IndefQuad::doubly_infinite; + } + else if (xisinf (a)) + { + indefinite = 1; + bound = b; + indef_type = IndefQuad::neg_inf_to_bound; + } + else if (xisinf (b)) + { + indefinite = 1; + bound = a; + indef_type = IndefQuad::bound_to_inf; + } + + int ier = 0; + int nfun = 0; + double abserr = 0.0; + double val = 0.0; + double abstol = 1e-6; + double reltol = 1e-6; + ColumnVector tol (2); + ColumnVector sing; + int have_sing = 0; + switch (nargin) + { + case 5: + if (indefinite) + { + error("quad: singularities not allowed on infinite intervals"); + return retval; + } + + have_sing = 1; + + sing = args(4).vector_value (); + + if (error_state) + { + error ("quad: expecting vector of singularities as fourth argument"); + return retval; + } + + case 4: + tol = args(3).vector_value (); + + if (error_state) + { + error ("quad: expecting vector of tolerances as fifth argument"); + return retval; + } + + switch (tol.capacity ()) + { + case 2: + reltol = tol (1); + + case 1: + abstol = tol (0); + break; + + default: + error ("quad: expecting tol to contain no more than two values"); + return retval; + } + + case 3: + if (indefinite) + { + IndefQuad iq (quad_user_function, bound, indef_type, abstol, reltol); + iq.set_options (quad_opts); + val = iq.integrate (ier, nfun, abserr); + } + else + { + if (have_sing) + { + DefQuad dq (quad_user_function, a, b, sing, abstol, reltol); + dq.set_options (quad_opts); + val = dq.integrate (ier, nfun, abserr); + } + else + { + DefQuad dq (quad_user_function, a, b, abstol, reltol); + dq.set_options (quad_opts); + val = dq.integrate (ier, nfun, abserr); + } + } + break; + + default: + panic_impossible (); + break; + } + + retval(3) = abserr; + retval(2) = static_cast<double> (nfun); + retval(1) = static_cast<double> (ier); + retval(0) = val; + } + else { print_usage ("quad"); return retval; } - quad_fcn = extract_function (args(0), "quad", "__quad_fcn__", - "function y = __quad_fcn__ (x) y = ", - "; endfunction"); - if (! quad_fcn) - return retval; - - double a = args(1).double_value (); - - if (error_state) - { - error ("quad: expecting second argument to be a scalar"); - return retval; - } - - double b = args(2).double_value (); - - if (error_state) - { - error ("quad: expecting third argument to be a scalar"); - return retval; - } - - int indefinite = 0; - IndefQuad::IntegralType indef_type = IndefQuad::doubly_infinite; - double bound = 0.0; - if (xisinf (a) && xisinf (b)) - { - indefinite = 1; - indef_type = IndefQuad::doubly_infinite; - } - else if (xisinf (a)) - { - indefinite = 1; - bound = b; - indef_type = IndefQuad::neg_inf_to_bound; - } - else if (xisinf (b)) - { - indefinite = 1; - bound = a; - indef_type = IndefQuad::bound_to_inf; - } - - int ier = 0; - int nfun = 0; - double abserr = 0.0; - double val = 0.0; - double abstol = 1e-6; - double reltol = 1e-6; - ColumnVector tol (2); - ColumnVector sing; - int have_sing = 0; - switch (nargin) - { - case 5: - if (indefinite) - { - error("quad: singularities not allowed on infinite intervals"); - return retval; - } - - have_sing = 1; - - sing = args(4).vector_value (); - - if (error_state) - { - error ("quad: expecting vector of singularities as fourth argument"); - return retval; - } - - case 4: - tol = args(3).vector_value (); - - if (error_state) - { - error ("quad: expecting vector of tolerances as fifth argument"); - return retval; - } - - switch (tol.capacity ()) - { - case 2: - reltol = tol (1); - - case 1: - abstol = tol (0); - break; - - default: - error ("quad: expecting tol to contain no more than two values"); - return retval; - } - - case 3: - if (indefinite) - { - IndefQuad iq (quad_user_function, bound, indef_type, abstol, reltol); - iq.set_options (quad_opts); - val = iq.integrate (ier, nfun, abserr); - } - else - { - if (have_sing) - { - DefQuad dq (quad_user_function, a, b, sing, abstol, reltol); - dq.set_options (quad_opts); - val = dq.integrate (ier, nfun, abserr); - } - else - { - DefQuad dq (quad_user_function, a, b, abstol, reltol); - dq.set_options (quad_opts); - val = dq.integrate (ier, nfun, abserr); - } - } - break; - - default: - panic_impossible (); - break; - } - - retval(3) = abserr; - retval(2) = static_cast<double> (nfun); - retval(1) = static_cast<double> (ier); - retval(0) = val; + abort: + unwind_protect::run_frame ("Fquad"); return retval; }