Added missing libsw library

external/libsdf/libsw/qromod.c

@@ -0,0 +1,111 @@
+#include <math.h>
+#include "Malloc.h"
+#include "error.h"
+#include "qromo.h"
+
+#define NR_END 1
+
+static double *vector(long nl, long nh)
+/* allocate a double vector with subscript range v[nl..nh] */
+{
+    double *v;
+
+    v = Malloc((nh-nl+1+NR_END)*sizeof(double));
+    return v-nl+NR_END;
+}
+
+static void free_vector(v,nl,nh)
+double *v;
+long nh,nl;
+/* free a double vector allocated with vector() */
+{
+    Free(v+nl-NR_END);
+}
+
+void polintd(double xa[], double ya[], int n, double x, double *y, double *dy)
+{
+    int i,m,ns=1;
+    double den,dif,dift,ho,hp,w;
+    double *c,*d;
+
+    dif=fabs(x-xa[1]);
+    c=vector(1,n);
+    d=vector(1,n);
+    for (i=1;i<=n;i++) {
+	if ( (dift=fabs(x-xa[i])) < dif) {
+	    ns=i;
+	    dif=dift;
+	}
+	c[i]=ya[i];
+	d[i]=ya[i];
+    }
+    *y=ya[ns--];
+    for (m=1;m<n;m++) {
+	for (i=1;i<=n-m;i++) {
+	    ho=xa[i]-x;
+	    hp=xa[i+m]-x;
+	    w=c[i+1]-d[i];
+	    if ( (den=ho-hp) == 0.0) Error("Error in routine polint");
+	    den=w/den;
+	    d[i]=hp*den;
+	    c[i]=ho*den;
+	}
+	*y += (*dy=(2*ns < (n-m) ? c[ns+1] : d[ns--]));
+    }
+    free_vector(d,1,n);
+    free_vector(c,1,n);
+}
+
+#define FUNC(x) ((*func)(x))
+
+double midpntd(double (*func)(double), double a, double b, int n)
+{
+    double x,tnm,sum,del,ddel;
+    static double s;
+    int it,j;
+
+    if (n == 1) {
+	return (s=(b-a)*FUNC(0.5*(a+b)));
+    } else {
+	for(it=1,j=1;j<n-1;j++) it *= 3;
+	tnm=it;
+	del=(b-a)/(3.0*tnm);
+	ddel=del+del;
+	x=a+0.5*del;
+	sum=0.0;
+	for (j=1;j<=it;j++) {
+	    sum += FUNC(x);
+	    x += ddel;
+	    sum += FUNC(x);
+	    x += del;
+	}
+	s=(s+(b-a)*sum/tnm)/3.0;
+	return s;
+    }
+}
+
+#define EPS 1.0e-12
+#define JMAX 20
+#define JMAXP (JMAX+1)
+#define K 5
+
+double qromod(double (*func)(double), double a, double b,
+	double (*choose)(double(*)(double), double, double, int))
+{
+
+    int j;
+    double ss,dss,h[JMAXP+1],s[JMAXP+1];
+
+    h[1]=1.0;
+    for (j=1;j<=JMAX;j++) {
+	s[j]=(*choose)(func,a,b,j);
+	if (j >= K) {
+	    polintd(&h[j-K],&s[j-K],K,0.0,&ss,&dss);
+	    if (fabs(dss) < EPS*fabs(ss)) return ss;
+	}
+	s[j+1]=s[j];
+	h[j+1]=h[j]/9.0;
+    }
+    Error("Too many steps in routine qromod\n");
+    return 0.0;
+}