OpenEuphoria

Re: built in routine id's

• Posted by Rolf Schröder <r.schr at t-online.de> Mar 23, 2002
• 559 views

Bernie Ryan wrote:
> 
> Rolf:
>    I do not understand your question.
>    Can you give me a simple example then maybe I can come
>    up with an idea.

Bernie,

enclosed an example. Each in build function has to be called via an
extra user defined function to make it for the function 'qgauss'
callable, like SIN instead sin. If you replace SIN by sin in the MAIN
section you will get an error. I think, the build in
functions/procedures should also freely be usable for routine_id() and
call_func()/call_proc().

Have a nice day, Rolf
 
----------------------------------------------------------------------
-- 10 point Gauss integration of 'func' over interval (a,b).
-- (after 'Numerical Recipes (FORTRAN), W.H.Press et al., 1988, p122)
----------------------------------------------------------------------
include misc.e  -- PI
----------------------------------------------------------------------
constant X = { .1488743389,
	       .4333953941,
	       .6794095682,
	       .8650633666,
	       .9739065285}
constant W = { .2955242247,
	       .2692667193,
	       .2190863625,
	       .1494513491,
	       .0666713443}
----------------------------------------------------------------------

function SIN(atom x)    -- equivalent of build in sin()
--       ***
    return sin(x)
end function    
----------------------------------------------------------------------

function quad(atom x)   -- x^2
--       ****
    return x*x
end function
----------------------------------------------------------------------

function qgauss(sequence func, atom a, atom b)
--       ******
    atom    xm, xr, ss, dx
    integer id
    
    id = routine_id(func)
    xm = (b+a)/2
    xr = (b-a)/2
    ss = 0.0
    for j = 1 to 5 do
	dx = xr*X[j]
	ss += W[j]*(call_func(id,{xm+dx})+call_func(id,{xm-dx}))
    end for
    return xr*ss
end function
----------------------------------------------------------------------
-- MAIN program area: examples for qgauss() function. 
-- ****
-- Nunerical integration of sin(x) over (0,PI) and x*x over (0,3).
--
    printf(1,"I(sin)[0,PI] = %15.10f (2 exactly)\n\n",
						qgauss("SIN",0,PI))
    printf(1,"I(x*x)[0,3] = %15.10f (9 exactly)\n", 
						qgauss("quad",0,3))
    abort(0)
----------------------------------------------------------------------