i/romberg

Home Manual Packages Global Index Keywords Quick Reference |
    /*
       ROMBERG.I
       Romberg integrator, after qromb in Numerical Recipes (Press, et.al.)

       $Id$
     */
    /*    Copyright (c) 1994.  The Regents of the University of California.
                        All rights reserved.  */

    func romberg (function, a, b, epsilon, notvector=)

    /* DOCUMENT integral= romberg(function, a, b)

             or integral= romberg(function, a, b, epsilon)
         returns the integral of FUNCTION(x) from A to B.  If EPSILON is
         given, Simpson's rule is refined until that fractional accuracy
         is obtained.  EPSILON defaults to 1.e-6.

         If the notvector= keyword is supplied and non-zero, then FUNCTION
         may not be called with a list of x values to return a list of
         results.  By default, FUNCTION is assumed to be a vector function.

         If the function is not very smooth, simpson may work better.

       SEE ALSO: simpson, max_doublings
     */
    {
      if (!epsilon || epsilon<0.) epsilon= 1.e-6;
      a= double(a);
      b= double(b);
      s= array(0.0, 5);
      h= [1.0, 0.25, 0.0625, 0.015625, 0.00390625];

      for (i=1 ; i<=max_doublings ; ++i) {

        ss= trapezoid(function, a, b, i, notvector);
        if (i >= 5) {
          s(5)= ss;
          c= d= s;  /* Neville algorithm tableau */
          ns= 4;    /* one less than smallest h, always last */
          for (m=1 ; m<5 ; ++m) {
    	m5= 5-m;
    	ho= h(1:m5);
    	hp= h(m+1:5);
    	w= (c(2:m5+1)-d(1:m5))/(ho-hp);
    	d(1:m5)= hp*w;
    	c(1:m5)= ho*w;
    	dss= (2*ns<m5)? c(ns+1) : d(ns--);
    	ss+= dss;
          }

          if (abs(dss) < epsilon*abs(ss)) return ss;
          /* extrapolation to h=0 always uses last 5 points */
          s(1:4)= s(2:5);
          h*= 0.25;
        } else {
          s(i)= ss;
        }
      }

      error, "no convergence after "+pr1(2^i)+" function evaluations";
    }

    func simpson (function, a, b, epsilon, notvector=)

    /* DOCUMENT integral= simpson(function, a, b)

             or integral= simpson(function, a, b, epsilon)
         returns the integral of FUNCTION(x) from A to B.  If EPSILON is
         given, Simpson's rule is refined until that fractional accuracy
         is obtained.  EPSILON defaults to 1.e-6.

         If the notvector= keyword is supplied and non-zero, then FUNCTION
         may not be called with a list of x values to return a list of
         results.  By default, FUNCTION is assumed to be a vector function.

         If the function is very smooth, romberg may work better.

       SEE ALSO: romberg, max_doublings
     */
    {
      if (!epsilon || epsilon<0.) epsilon= 1.e-6;
      a= double(a);
      b= double(b);
      ost= os= -1.e-30;

      for (i=1 ; i<=max_doublings ; ++i) {

        st= trapezoid(function, a, b, i, notvector);
        s= (4.*st - ost)/3.;

        if (abs(s-os) < epsilon*abs(os)) return s;
        os= s;
        ost= st;
      }

      error, "no convergence after "+pr1(2^i)+" function evaluations";
    }

    local max_doublings ;

    /* DOCUMENT max_doublings= 20

         is the maximum number of times romberg or simpson will split the
         integration interval in half.  Default is 20.
     */
    max_doublings= 20;

    func trapezoid (function, a, b, n, notvector)
    {
      extern _trapezoid_i, _trapezoid_s;
      if (n==1) {
        _trapezoid_i= 1;
        return _trapezoid_s= 0.5*(b-a)*(function(a)+function(b));
      }
      dx= (b-a)/_trapezoid_i;
      if (!notvector) {
        /* conserve memory-- dont try more than 8192 points at a time */
        if (_trapezoid_i <= 8192) {

          s= sum(function(span(a,b,_trapezoid_i+1)(zcen)));
        } else {
          x= a+(indgen(8192)-0.5)*dx;
          s= sum(function(x));
          dx2= 8192*dx;

          for (i=8193 ; i<=_trapezoid_i ; i+=8192) s+= sum(function((x+=dx2)));
        }
      } else {
        x= a+0.5*dx;
        s= function(x);
        for (i=2 ; i<=_trapezoid_i ; ++i) s+= function((x+=dx));
      }
      _trapezoid_i*= 2;
      return _trapezoid_s= 0.5*(_trapezoid_s + dx*s);
    }