int main(void)
{
int i;
float b1,b2,b3,b4,xf=X1+HTOT,*y,*yout,*dydx;
y=vector(1,NVAR);
yout=vector(1,NVAR);
dydx=vector(1,NVAR);
y[1]=bessj0(X1);
y[2]=bessj1(X1);
y[3]=bessj(2,X1);
y[4]=bessj(3,X1);
derivs(X1,y,dydx);
b1=bessj0(xf);
b2=bessj1(xf);
b3=bessj(2,xf);
b4=bessj(3,xf);
printf("First four Bessel functions:\n");
for (i=5;i<=50;i+=5) {
mmid(y,dydx,NVAR,X1,HTOT,i,yout,derivs);
printf("\n%s %5.2f %s %5.2f %s %2d %s \n",
"x=",X1," to ",X1+HTOT," in ",i," steps");
printf("%14s %9s\n","integration","bessj");
printf("%12.6f %12.6f\n",yout[1],b1);
printf("%12.6f %12.6f\n",yout[2],b2);
printf("%12.6f %12.6f\n",yout[3],b3);
printf("%12.6f %12.6f\n",yout[4],b4);
printf("\nPress RETURN to continue...\n");
(void) getchar();
}
free_vector(dydx,1,NVAR);
free_vector(yout,1,NVAR);
free_vector(y,1,NVAR);
return 0;
}
void bsstep(double y[], double dydx[], int nv, double *xx, double htry, double eps,
double yscal[], double *hdid, double *hnext,
void (*derivs)(double, double [], double []))
{
void mmid(double y[], double dydx[], int nvar, double xs, double htot,
int nstep, double yout[], void (*derivs)(double, double[], double[]));
void pzextr(int iest, double xest, double yest[], double yz[], double dy[],
int nv);
int i,iq,k,kk,km;
static int first=1,kmax,kopt;
static double epsold = -1.0,xnew;
double eps1,errmax,fact,h,red,scale,work,wrkmin,xest;
double *err,*yerr,*ysav,*yseq;
static double a[IMAXX+1];
static double alf[KMAXX+1][KMAXX+1];
static int nseq[IMAXX+1]={0,2,4,6,8,10,12,14,16,18};
int reduct,exitflag=0;
d=dmatrix(1,nv,1,KMAXX);
err=dvector(1,KMAXX);
x=dvector(1,KMAXX);
yerr=dvector(1,nv);
ysav=dvector(1,nv);
yseq=dvector(1,nv);
if (eps != epsold) {
*hnext = xnew = -1.0e29;
eps1=SAFE1*eps;
a[1]=nseq[1]+1;
for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1];
for (iq=2;iq<=KMAXX;iq++) {
for (k=1;k<iq;k++)
alf[k][iq]=pow(eps1,(a[k+1]-a[iq+1])/
((a[iq+1]-a[1]+1.0)*(2*k+1)));
}
epsold=eps;
for (kopt=2;kopt<KMAXX;kopt++)
if (a[kopt+1] > a[kopt]*alf[kopt-1][kopt]) break;
kmax=kopt;
}
h=htry;
for (i=1;i<=nv;i++) ysav[i]=y[i];
if (*xx != xnew || h != (*hnext)) {
first=1;
kopt=kmax;
}
reduct=0;
for (;;) {
for (k=1;k<=kmax;k++) {
xnew=(*xx)+h;
if (xnew == (*xx)) nrerror("step size underflow in bsstep");
mmid(ysav,dydx,nv,*xx,h,nseq[k],yseq,derivs);
xest=SQR(h/nseq[k]);
pzextr(k,xest,yseq,y,yerr,nv);
if (k != 1) {
errmax=TINY;
for (i=1;i<=nv;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i]));
errmax /= eps;
km=k-1;
err[km]=pow(errmax/SAFE1,1.0/(2*km+1));
}
if (k != 1 && (k >= kopt-1 || first)) {
if (errmax < 1.0) {
exitflag=1;
break;
}
if (k == kmax || k == kopt+1) {
red=SAFE2/err[km];
break;
}
else if (k == kopt && alf[kopt-1][kopt] < err[km]) {
red=1.0/err[km];
break;
}
else if (kopt == kmax && alf[km][kmax-1] < err[km]) {
red=alf[km][kmax-1]*SAFE2/err[km];
break;
}
else if (alf[km][kopt] < err[km]) {
red=alf[km][kopt-1]/err[km];
break;
}
}
}
if (exitflag) break;
red=FMIN(red,REDMIN);
red=FMAX(red,REDMAX);
h *= red;
reduct=1;
}
*xx=xnew;
*hdid=h;
first=0;
wrkmin=1.0e35;
for (kk=1;kk<=km;kk++) {
fact=FMAX(err[kk],SCALMX);
work=fact*a[kk+1];
if (work < wrkmin) {
scale=fact;
wrkmin=work;
kopt=kk+1;
}
}
*hnext=h/scale;
if (kopt >= k && kopt != kmax && !reduct) {
fact=FMAX(scale/alf[kopt-1][kopt],SCALMX);
if (a[kopt+1]*fact <= wrkmin) {
*hnext=h/fact;
kopt++;
}
}
free_dvector(yseq,1,nv);
free_dvector(ysav,1,nv);
free_dvector(yerr,1,nv);
free_dvector(x,1,KMAXX);
free_dvector(err,1,KMAXX);
free_dmatrix(d,1,nv,1,KMAXX);
}