Sindbad~EG File Manager

/* code from Numerical Recipes for erf  and incomplete gamma function */
/* 2.16.92 file created, importing some Num Rec code but with changed prototypes
   and error handling, and floats changed to doubles; wrote my own
   incomplete_gamma and incomplete_gammap calling NumRec code.
*/
#include <math.h>

#include "special.h"   /* for gammln */

static int gcf(double *gammcf,double a, double x, double *gln);
static int gser(double *gamser,double a,double x,double *gln);
static int betacf(double a,double b,double x,double *ans);
/*_______________________________________________________________*/
double erfcc(double x)
/* computes Erfc to within 1.0e-7 */
{
        double t,z,ans;
        z=fabs(x);
        t=1.0/(1.0+0.5*z);
        ans=t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+
                t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+
                t*(-0.82215223+t*0.17087277)))))))));
        return  x >= 0.0 ? ans : 2.0-ans;
}
/*_______________________________________________________________*/
#define ITMAX 100
#define EPS 3.0e-10   /* sharper than in NumRec */

static int gcf(double *gammcf,double a, double x, double *gln)
{
   int n;
   double gold=0.0,g,fac=1.0,b1=1.0;
   double b0=0.0,anf,ana,an,a1,a0=1.0;
   *gln=gammln(a);
   a1=x;
   for (n=1;n<=ITMAX;n++)
     { an=(double) n;
       ana=an-a;
       a0=(a1+a0*ana)*fac;
       b0=(b1+b0*ana)*fac;
       anf=an*fac;
       a1=x*a0+anf*a1;
       b1=x*b0+anf*b1;
       if (a1)
         { fac=1.0/a1;
           g=b1*fac;
           if (fabs((g-gold)/g) < EPS)
              { *gammcf=exp(-x+a*log(x)-(*gln))*g;
                return 0;
              }
           gold=g;
         }
     }
   return 1;
}
/*________________________________________________________________*/
int gser(double *gamser,double a,double x,double *gln)
{ int n;
  double sum,del,ap;
  *gln=gammln(a);
  if (x <= 0.0)
    { if (x < 0.0) return 1;
      *gamser=0.0;
      return 0;
    }
  else
    { ap=a;
      del=sum=1.0/a;
      for (n=1;n<=ITMAX;n++)
        { ap += 1.0;
          del *= x/ap;
          sum += del;
          if (fabs(del) < fabs(sum)*EPS)
           { *gamser=sum*exp(-x+a*log(x)-(*gln));
             return 0;
           }
        }
      return 1;
    }
}

/*___________________________________________________________________________*/
int incomplete_gammap(double a,double x,double *ans)
{ double gammcf,gln;
  int err;
  if (x < 0.0 || a <= 0.0) return 1;
  if (x < (a+1.0))
    return gser(ans,a,x,&gln);
  else
    { err = gcf(&gammcf,a,x,&gln);
      if(err) return 1;
      *ans =  1.0 - gammcf;
    }
  return 0;
}
/*___________________________________________________________________________*/
int incomplete_gamma(double a,double x,double *ans)
{ double gammcf,gamser,gln;
  int err;
  if (x < 0.0 || a <= 0.0) return 1;
  if (x < (a+1.0))
     { err = gser(&gamser,a,x,&gln);
       if(err) return err;
       *ans = exp(gln) * (1.0-gamser);
     }
  else
    { err = gcf(&gammcf,a,x,&gln);
      if(err) return 1;
      *ans =  exp(gln) * gammcf;
    }
  return 0;
}
/*__________________________________________________________________________*/
int incomplete_beta(double x, double a, double b, double *ans)
{ double bt,temp;
  int err;
  if (x < 0.0 || x > 1.0) return 1;
  if (x == 0.0 || x == 1.0) bt=0.0;
  else
    bt=exp(gammln(a+b)-gammln(a)-gammln(b)+a*log(x)+b*log(1.0-x));
  if (x < (a+1.0)/(a+b+2.0))
     { err = betacf(a,b,x,&temp);
       if(err) return 1;
       *ans = bt * temp/a;
       return 0;
     }
  else
     { err = betacf(b,a,1.0-x,&temp);
       if(err) return 1;
       *ans = 1.0 - bt*temp/b;
       return 0;
     }
}
/*______________________________________________________________*/
int betacf(double a,double b,double x,double *ans)
/* return 0 for success */

{ double qap,qam,qab,em,tem,d;
  double bz,bm=1.0,bp,bpp;
  double az=1.0,am=1.0,ap,app,aold;
  int m;
  qab=a+b;
  qap=a+1.0;
  qam=a-1.0;
  bz=1.0-qab*x/qap;
  for (m=1;m<=ITMAX;m++)
    { em=(float) m;
      tem=em+em;
      d=em*(b-em)*x/((qam+tem)*(a+tem));
      ap=az+d*am;
      bp=bz+d*bm;
      d = -(a+em)*(qab+em)*x/((qap+tem)*(a+tem));
      app=ap+d*az;
      bpp=bp+d*bz;
      aold=az;
      am=ap/bpp;
      bm=bp/bpp;
      az=app/bpp;
      bz=1.0;
      if (fabs(az-aold) < (EPS*fabs(az)))
         { *ans = az;
           return 0;
         }
   }
  return 1;
}

#undef ITMAX
#undef EPS