add numerical recipes library

lib/nr/ansi/recipes/rkqs.c

@@ -0,0 +1,44 @@
+
+#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