45 lines
1.1 KiB
C
45 lines
1.1 KiB
C
|
|
#include <math.h>
|
|
#define NRANSI
|
|
#include "nrutil.h"
|
|
#define SAFETY 0.9
|
|
#define PGROW -0.2
|
|
#define PSHRNK -0.25
|
|
#define ERRCON 1.89e-4
|
|
|
|
void rkqs(float y[], float dydx[], int n, float *x, float htry, float eps,
|
|
float yscal[], float *hdid, float *hnext,
|
|
void (*derivs)(float, float [], float []))
|
|
{
|
|
void rkck(float y[], float dydx[], int n, float x, float h,
|
|
float yout[], float yerr[], void (*derivs)(float, float [], float []));
|
|
int i;
|
|
float errmax,h,htemp,xnew,*yerr,*ytemp;
|
|
|
|
yerr=vector(1,n);
|
|
ytemp=vector(1,n);
|
|
h=htry;
|
|
for (;;) {
|
|
rkck(y,dydx,n,*x,h,ytemp,yerr,derivs);
|
|
errmax=0.0;
|
|
for (i=1;i<=n;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i]));
|
|
errmax /= eps;
|
|
if (errmax <= 1.0) break;
|
|
htemp=SAFETY*h*pow(errmax,PSHRNK);
|
|
h=(h >= 0.0 ? FMAX(htemp,0.1*h) : FMIN(htemp,0.1*h));
|
|
xnew=(*x)+h;
|
|
if (xnew == *x) nrerror("stepsize underflow in rkqs");
|
|
}
|
|
if (errmax > ERRCON) *hnext=SAFETY*h*pow(errmax,PGROW);
|
|
else *hnext=5.0*h;
|
|
*x += (*hdid=h);
|
|
for (i=1;i<=n;i++) y[i]=ytemp[i];
|
|
free_vector(ytemp,1,n);
|
|
free_vector(yerr,1,n);
|
|
}
|
|
#undef SAFETY
|
|
#undef PGROW
|
|
#undef PSHRNK
|
|
#undef ERRCON
|
|
#undef NRANSI
|