Initial commit of this directory. -> f2c option

ext/f2c_recipes/.cvsignore

@@ -0,0 +1,3 @@
+Makefile
+*.d
+.depends

ext/f2c_recipes/Makefile.in

@@ -0,0 +1,75 @@
+#/bin/sh
+#
+# $Source$
+# $Author$
+# $Revision$
+# $Date$
+#
+
+.SUFFIXES :
+.SUFFIXES : .c .d .o
+
+# the directory where the Cantera libraries are located
+CANTERA_LIBDIR=@buildlib@
+
+# the directory where Cantera include files may be found.
+CANTERA_INCDIR=@ctroot@/build/include/cantera
+
+# the C++ compiler
+CXX = @CXX@
+
+# the C compiler
+CC = @CC@
+
+# C++ compile flags
+CXX_FLAGS = @CXXFLAGS@ $(CXX_OPT)
+
+# Local include files
+CXX_INCLUDES=-I../f2c_libs
+
+# How to compile the dependency file
+.c.d:
+	g++ -MM  $(CXX_FLAGS) $(CXX_INCLUDES) $*.c > $*.d
+
+# How to compile a C file
+.c.o:
+	@CC@ -c $< @DEFS@ $(CXX_FLAGS) $(CXX_INCLUDES)
+
+# -----------------------------------------------
+
+LIB = $(CANTERA_LIBDIR)/librecipes.a
+
+all:  $(LIB)
+
+# list of object files
+OBJS = simp1.o simp2.o simp3.o simplx.o splint.o \
+       splie2.o spline.o splin2.o
+
+# list of source files
+SRCS = $(OBJS:.o=.c)
+
+# List of dependency files to be created
+DEPENDS=$(OBJS:.o=.d)
+
+# rule to make library
+$(LIB): $(OBJS)
+	@ARCHIVE@ $(LIB) $(OBJS) > /dev/null
+
+# ------------------------------------------------
+# Utility Targets
+
+clean:
+	$(RM) $(OBJS) $(LIB) *.d .depends
+
+# depends target
+depends:
+	$(RM) *.d .depends
+	@MAKE@ .depends
+
+.depends: $(DEPENDS)
+	cat *.d > .depends
+
+
+ifeq ($(wildcard .depends), .depends)
+include .depends
+endif

ext/f2c_recipes/simp1.c

@@ -0,0 +1,61 @@
+/* simp1.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Subroutine */ int simp1_(doublereal *a, integer *mp, integer *np, integer *
+	mm, integer *ll, integer *nll, integer *iabf, integer *kp, doublereal 
+	*bmax)
+{
+    /* System generated locals */
+    integer a_dim1, a_offset, i__1;
+    doublereal d__1;
+
+    /* Local variables */
+    static integer k;
+    static doublereal test;
+
+    /* Parameter adjustments */
+    --ll;
+    a_dim1 = *mp;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+
+    /* Function Body */
+    *kp = ll[1];
+    *bmax = a[*mm + 1 + (*kp + 1) * a_dim1];
+    if (*nll < 2) {
+	return 0;
+    }
+    i__1 = *nll;
+    for (k = 2; k <= i__1; ++k) {
+	if (*iabf == 0) {
+	    test = a[*mm + 1 + (ll[k] + 1) * a_dim1] - *bmax;
+	} else {
+	    test = (d__1 = a[*mm + 1 + (ll[k] + 1) * a_dim1], abs(d__1)) - 
+		    abs(*bmax);
+	}
+	if (test > (float)0.) {
+	    *bmax = a[*mm + 1 + (ll[k] + 1) * a_dim1];
+	    *kp = ll[k];
+	}
+/* L11: */
+    }
+    return 0;
+} /* simp1_ */
+
+#ifdef __cplusplus
+	}
+#endif

ext/f2c_recipes/simp2.c

@@ -0,0 +1,89 @@
+/* simp2.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Subroutine */ int simp2_(doublereal *a, integer *m, integer *n, integer *
+	mp, integer *np, integer *l2, integer *nl2, integer *ip, integer *kp, 
+	doublereal *q1)
+{
+    /* System generated locals */
+    integer a_dim1, a_offset, i__1, i__2;
+
+    /* Local variables */
+    static integer i__, k;
+    static doublereal q, q0;
+    static integer ii;
+    static doublereal qp;
+
+    /* Parameter adjustments */
+    --l2;
+    a_dim1 = *mp;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+
+    /* Function Body */
+    *ip = 0;
+    if (*nl2 < 1) {
+	return 0;
+    }
+    i__1 = *nl2;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	if (a[l2[i__] + 1 + (*kp + 1) * a_dim1] < -1e-6) {
+	    goto L2;
+	}
+/* L11: */
+    }
+    return 0;
+L2:
+    *q1 = -a[l2[i__] + 1 + a_dim1] / a[l2[i__] + 1 + (*kp + 1) * a_dim1];
+    *ip = l2[i__];
+    if (i__ + 1 > *nl2) {
+	return 0;
+    }
+    i__1 = *nl2;
+    for (++i__; i__ <= i__1; ++i__) {
+	ii = l2[i__];
+	if (a[ii + 1 + (*kp + 1) * a_dim1] < -1e-6) {
+	    q = -a[ii + 1 + a_dim1] / a[ii + 1 + (*kp + 1) * a_dim1];
+	    if (q < *q1) {
+		*ip = ii;
+		*q1 = q;
+	    } else if (q == *q1) {
+		i__2 = *n;
+		for (k = 1; k <= i__2; ++k) {
+		    qp = -a[*ip + 1 + (k + 1) * a_dim1] / a[*ip + 1 + (*kp + 
+			    1) * a_dim1];
+		    q0 = -a[ii + 1 + (k + 1) * a_dim1] / a[ii + 1 + (*kp + 1) 
+			    * a_dim1];
+		    if (q0 != qp) {
+			goto L6;
+		    }
+/* L12: */
+		}
+L6:
+		if (q0 < qp) {
+		    *ip = ii;
+		}
+	    }
+	}
+/* L13: */
+    }
+    return 0;
+} /* simp2_ */
+
+#ifdef __cplusplus
+	}
+#endif

ext/f2c_recipes/simp3.c

@@ -0,0 +1,65 @@
+/* simp3.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Subroutine */ int simp3_(doublereal *a, integer *mp, integer *np, integer *
+	i1, integer *k1, integer *ip, integer *kp)
+{
+    /* System generated locals */
+    integer a_dim1, a_offset, i__1, i__2;
+
+    /* Local variables */
+    static integer ii, kk;
+    static doublereal piv;
+
+    /* Parameter adjustments */
+    a_dim1 = *mp;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+
+    /* Function Body */
+    piv = 1. / a[*ip + 1 + (*kp + 1) * a_dim1];
+    if (*i1 >= 0) {
+	i__1 = *i1 + 1;
+	for (ii = 1; ii <= i__1; ++ii) {
+	    if (ii - 1 != *ip) {
+		a[ii + (*kp + 1) * a_dim1] *= piv;
+		i__2 = *k1 + 1;
+		for (kk = 1; kk <= i__2; ++kk) {
+		    if (kk - 1 != *kp) {
+			a[ii + kk * a_dim1] -= a[*ip + 1 + kk * a_dim1] * a[
+				ii + (*kp + 1) * a_dim1];
+		    }
+/* L11: */
+		}
+	    }
+/* L12: */
+	}
+    }
+    i__1 = *k1 + 1;
+    for (kk = 1; kk <= i__1; ++kk) {
+	if (kk - 1 != *kp) {
+	    a[*ip + 1 + kk * a_dim1] = -a[*ip + 1 + kk * a_dim1] * piv;
+	}
+/* L13: */
+    }
+    a[*ip + 1 + (*kp + 1) * a_dim1] = piv;
+    return 0;
+} /* simp3_ */
+
+#ifdef __cplusplus
+	}
+#endif

ext/f2c_recipes/simplx.c

@@ -0,0 +1,197 @@
+/* simplx.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Table of constant values */
+
+static integer c__0 = 0;
+static integer c__1 = 1;
+
+/* Subroutine */ int simplx_(doublereal *a, integer *m, integer *n, integer *
+	mp, integer *np, integer *m1, integer *m2, integer *m3, integer *
+	icase, integer *izrov, integer *iposv)
+{
+    /* System generated locals */
+    integer a_dim1, a_offset, i__1, i__2;
+
+    /* Builtin functions */
+    /* Subroutine */ int s_paus(char *, ftnlen);
+
+    /* Local variables */
+    static integer i__, k, l1[1000], l2[1000], l3[1000];
+    static doublereal q1;
+    static integer m12, kh, ip, ir, kp, is, nl1, nl2;
+    static doublereal bmax;
+    extern /* Subroutine */ int simp1_(doublereal *, integer *, integer *, 
+	    integer *, integer *, integer *, integer *, integer *, doublereal 
+	    *), simp2_(doublereal *, integer *, integer *, integer *, integer 
+	    *, integer *, integer *, integer *, integer *, doublereal *), 
+	    simp3_(doublereal *, integer *, integer *, integer *, integer *, 
+	    integer *, integer *);
+
+    /* Parameter adjustments */
+    --iposv;
+    --izrov;
+    a_dim1 = *mp;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+
+    /* Function Body */
+    if (*m != *m1 + *m2 + *m3) {
+	s_paus("Bad input constraint counts.", (ftnlen)28);
+    }
+    nl1 = *n;
+    i__1 = *n;
+    for (k = 1; k <= i__1; ++k) {
+	l1[k - 1] = k;
+	izrov[k] = k;
+/* L11: */
+    }
+    nl2 = *m;
+    i__1 = *m;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	if (a[i__ + 1 + a_dim1] < 0.) {
+/*          write(*,*) 'The A matrix input to SIMPLX is invalid.' */
+	    s_paus("Bad input tableau.", (ftnlen)18);
+	}
+	l2[i__ - 1] = i__;
+	iposv[i__] = *n + i__;
+/* L12: */
+    }
+    i__1 = *m2;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	l3[i__ - 1] = 1;
+/* L13: */
+    }
+    ir = 0;
+    if (*m2 + *m3 == 0) {
+	goto L30;
+    }
+    ir = 1;
+    i__1 = *n + 1;
+    for (k = 1; k <= i__1; ++k) {
+	q1 = (float)0.;
+	i__2 = *m;
+	for (i__ = *m1 + 1; i__ <= i__2; ++i__) {
+	    q1 += a[i__ + 1 + k * a_dim1];
+/* L14: */
+	}
+	a[*m + 2 + k * a_dim1] = -q1;
+/* L15: */
+    }
+L10:
+    i__1 = *m + 1;
+    simp1_(&a[a_offset], mp, np, &i__1, l1, &nl1, &c__0, &kp, &bmax);
+    if (bmax <= 1e-6 && a[*m + 2 + a_dim1] < -1e-6) {
+	*icase = -1;
+	return 0;
+    } else if (bmax <= 1e-6 && a[*m + 2 + a_dim1] <= 1e-6) {
+	m12 = *m1 + *m2 + 1;
+	if (m12 <= *m) {
+	    i__1 = *m;
+	    for (ip = m12; ip <= i__1; ++ip) {
+		if (iposv[ip] == ip + *n) {
+		    simp1_(&a[a_offset], mp, np, &ip, l1, &nl1, &c__1, &kp, &
+			    bmax);
+		    if (bmax > (float)0.) {
+			goto L1;
+		    }
+		}
+/* L16: */
+	    }
+	}
+	ir = 0;
+	--m12;
+	if (*m1 + 1 > m12) {
+	    goto L30;
+	}
+	i__1 = m12;
+	for (i__ = *m1 + 1; i__ <= i__1; ++i__) {
+	    if (l3[i__ - *m1 - 1] == 1) {
+		i__2 = *n + 1;
+		for (k = 1; k <= i__2; ++k) {
+		    a[i__ + 1 + k * a_dim1] = -a[i__ + 1 + k * a_dim1];
+/* L17: */
+		}
+	    }
+/* L18: */
+	}
+	goto L30;
+    }
+    simp2_(&a[a_offset], m, n, mp, np, l2, &nl2, &ip, &kp, &q1);
+    if (ip == 0) {
+	*icase = -1;
+	return 0;
+    }
+L1:
+    i__1 = *m + 1;
+    simp3_(&a[a_offset], mp, np, &i__1, n, &ip, &kp);
+    if (iposv[ip] >= *n + *m1 + *m2 + 1) {
+	i__1 = nl1;
+	for (k = 1; k <= i__1; ++k) {
+	    if (l1[k - 1] == kp) {
+		goto L2;
+	    }
+/* L19: */
+	}
+L2:
+	--nl1;
+	i__1 = nl1;
+	for (is = k; is <= i__1; ++is) {
+	    l1[is - 1] = l1[is];
+/* L21: */
+	}
+    } else {
+	if (iposv[ip] < *n + *m1 + 1) {
+	    goto L20;
+	}
+	kh = iposv[ip] - *m1 - *n;
+	if (l3[kh - 1] == 0) {
+	    goto L20;
+	}
+	l3[kh - 1] = 0;
+    }
+    a[*m + 2 + (kp + 1) * a_dim1] += (float)1.;
+    i__1 = *m + 2;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	a[i__ + (kp + 1) * a_dim1] = -a[i__ + (kp + 1) * a_dim1];
+/* L22: */
+    }
+L20:
+    is = izrov[kp];
+    izrov[kp] = iposv[ip];
+    iposv[ip] = is;
+    if (ir != 0) {
+	goto L10;
+    }
+L30:
+    simp1_(&a[a_offset], mp, np, &c__0, l1, &nl1, &c__0, &kp, &bmax);
+    if (bmax <= (float)0.) {
+	*icase = 0;
+	return 0;
+    }
+    simp2_(&a[a_offset], m, n, mp, np, l2, &nl2, &ip, &kp, &q1);
+    if (ip == 0) {
+	*icase = 1;
+	return 0;
+    }
+    simp3_(&a[a_offset], mp, np, m, n, &ip, &kp);
+    goto L20;
+} /* simplx_ */
+
+#ifdef __cplusplus
+	}
+#endif

ext/f2c_recipes/splie2.c

@@ -0,0 +1,65 @@
+/* splie2.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Table of constant values */
+
+static doublereal c_b4 = 1e30;
+
+/* Subroutine */ int splie2_(doublereal *x1a, doublereal *x2a, doublereal *ya,
+	 integer *m, integer *n, doublereal *y2a)
+{
+    /* System generated locals */
+    integer ya_dim1, ya_offset, y2a_dim1, y2a_offset, i__1, i__2;
+
+    /* Local variables */
+    static integer j, k;
+    static doublereal ytmp[100], y2tmp[100];
+    extern /* Subroutine */ int spline_(doublereal *, doublereal *, integer *,
+	     doublereal *, doublereal *, doublereal *);
+
+    /* Parameter adjustments */
+    --x1a;
+    y2a_dim1 = *m;
+    y2a_offset = 1 + y2a_dim1;
+    y2a -= y2a_offset;
+    ya_dim1 = *m;
+    ya_offset = 1 + ya_dim1;
+    ya -= ya_offset;
+    --x2a;
+
+    /* Function Body */
+    i__1 = *m;
+    for (j = 1; j <= i__1; ++j) {
+	i__2 = *n;
+	for (k = 1; k <= i__2; ++k) {
+	    ytmp[k - 1] = ya[j + k * ya_dim1];
+/* L11: */
+	}
+	spline_(&x2a[1], ytmp, n, &c_b4, &c_b4, y2tmp);
+	i__2 = *n;
+	for (k = 1; k <= i__2; ++k) {
+	    y2a[j + k * y2a_dim1] = y2tmp[k - 1];
+/* L12: */
+	}
+/* L13: */
+    }
+    return 0;
+} /* splie2_ */
+
+#ifdef __cplusplus
+	}
+#endif

ext/f2c_recipes/splin2.c

@@ -0,0 +1,66 @@
+/* splin2.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Table of constant values */
+
+static doublereal c_b4 = 1e30;
+
+/* Subroutine */ int splin2_(doublereal *x1a, doublereal *x2a, doublereal *ya,
+	 doublereal *y2a, integer *m, integer *n, doublereal *x1, doublereal *
+	x2, doublereal *y)
+{
+    /* System generated locals */
+    integer ya_dim1, ya_offset, y2a_dim1, y2a_offset, i__1, i__2;
+
+    /* Local variables */
+    static integer j, k;
+    static doublereal ytmp[100], y2tmp[100], yytmp[100];
+    extern /* Subroutine */ int spline_(doublereal *, doublereal *, integer *,
+	     doublereal *, doublereal *, doublereal *), splint_(doublereal *, 
+	    doublereal *, doublereal *, integer *, doublereal *, doublereal *)
+	    ;
+
+    /* Parameter adjustments */
+    --x1a;
+    y2a_dim1 = *m;
+    y2a_offset = 1 + y2a_dim1;
+    y2a -= y2a_offset;
+    ya_dim1 = *m;
+    ya_offset = 1 + ya_dim1;
+    ya -= ya_offset;
+    --x2a;
+
+    /* Function Body */
+    i__1 = *m;
+    for (j = 1; j <= i__1; ++j) {
+	i__2 = *n;
+	for (k = 1; k <= i__2; ++k) {
+	    ytmp[k - 1] = ya[j + k * ya_dim1];
+	    y2tmp[k - 1] = y2a[j + k * y2a_dim1];
+/* L11: */
+	}
+	splint_(&x2a[1], ytmp, y2tmp, n, x2, &yytmp[j - 1]);
+/* L12: */
+    }
+    spline_(&x1a[1], yytmp, m, &c_b4, &c_b4, y2tmp);
+    splint_(&x1a[1], yytmp, y2tmp, m, x1, y);
+    return 0;
+} /* splin2_ */
+
+#ifdef __cplusplus
+	}
+#endif

ext/f2c_recipes/spline.c

@@ -0,0 +1,69 @@
+/* spline.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Subroutine */ int spline_(doublereal *x, doublereal *y, integer *n, 
+	doublereal *yp1, doublereal *ypn, doublereal *y2)
+{
+    /* System generated locals */
+    integer i__1;
+
+    /* Local variables */
+    static integer i__, k;
+    static doublereal p, u[100], qn, un, sig;
+
+    /* Parameter adjustments */
+    --y2;
+    --y;
+    --x;
+
+    /* Function Body */
+    if (*yp1 > 9.9e29) {
+	y2[1] = (float)0.;
+	u[0] = (float)0.;
+    } else {
+	y2[1] = -.5;
+	u[0] = 3. / (x[2] - x[1]) * ((y[2] - y[1]) / (x[2] - x[1]) - *yp1);
+    }
+    i__1 = *n - 1;
+    for (i__ = 2; i__ <= i__1; ++i__) {
+	sig = (x[i__] - x[i__ - 1]) / (x[i__ + 1] - x[i__ - 1]);
+	p = sig * y2[i__ - 1] + 2.;
+	y2[i__] = (sig - (float)1.) / p;
+	u[i__ - 1] = (((y[i__ + 1] - y[i__]) / (x[i__ + 1] - x[i__]) - (y[i__]
+		 - y[i__ - 1]) / (x[i__] - x[i__ - 1])) * 6. / (x[i__ + 1] - 
+		x[i__ - 1]) - sig * u[i__ - 2]) / p;
+/* L11: */
+    }
+    if (*ypn > 9.9e29) {
+	qn = 0.;
+	un = 0.;
+    } else {
+	qn = .5;
+	un = 3. / (x[*n] - x[*n - 1]) * (*ypn - (y[*n] - y[*n - 1]) / (x[*n] 
+		- x[*n - 1]));
+    }
+    y2[*n] = (un - qn * u[*n - 2]) / (qn * y2[*n - 1] + 1.);
+    for (k = *n - 1; k >= 1; --k) {
+	y2[k] = y2[k] * y2[k + 1] + u[k - 1];
+/* L12: */
+    }
+    return 0;
+} /* spline_ */
+
+#ifdef __cplusplus
+	}
+#endif

ext/f2c_recipes/splint.c

@@ -0,0 +1,68 @@
+/* splint.f -- translated by f2c (version 20031025).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "f2c.h"
+
+/* Subroutine */ int splint_(doublereal *xa, doublereal *ya, doublereal *y2a, 
+	integer *n, doublereal *x, doublereal *y)
+{
+    /* System generated locals */
+    doublereal d__1, d__2, d__3;
+
+    /* Builtin functions */
+    /* Subroutine */ int s_paus(char *, ftnlen);
+
+    /* Local variables */
+    static doublereal a, b, h__;
+    static integer k, khi, klo;
+
+    /* Parameter adjustments */
+    --y2a;
+    --ya;
+    --xa;
+
+    /* Function Body */
+    klo = 1;
+    khi = *n;
+L1:
+    if (khi - klo > 1) {
+	k = (khi + klo) / 2;
+	if (xa[k] > *x) {
+	    khi = k;
+	} else {
+	    klo = k;
+	}
+	goto L1;
+    }
+    h__ = xa[khi] - xa[klo];
+    if (h__ == (float)0.) {
+	s_paus("Bad XA input.", (ftnlen)13);
+    }
+    a = (xa[khi] - *x) / h__;
+    b = (*x - xa[klo]) / h__;
+/* Computing 3rd power */
+    d__1 = a;
+/* Computing 3rd power */
+    d__2 = b;
+/* Computing 2nd power */
+    d__3 = h__;
+    *y = a * ya[klo] + b * ya[khi] + ((d__1 * (d__1 * d__1) - a) * y2a[klo] + 
+	    (d__2 * (d__2 * d__2) - b) * y2a[khi]) * (d__3 * d__3) / 6.;
+    return 0;
+} /* splint_ */
+
+#ifdef __cplusplus
+	}
+#endif