cantera/ext/f2c_math/pvalue.c

/* pvalue.f -- translated by f2c (version 20030320).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "f2c.h"

/* DECK PVALUE */
/* Subroutine */ int pvalue_(integer *l, integer *nder, real *x, real *yfit, 
	real *yp, real *a)
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    integer i__, n, k1, k2, k3, k4;
    real cc;
    integer ic, kc, in, k1i, lm1, lp1;
    real dif;
    integer k3p1, k4p1, ndo;
    real val;
    integer ilo, iup, ndp1, inp1, k3pn, k4pn, nord, maxord;

/* ***BEGIN PROLOGUE  PVALUE */
/* ***PURPOSE  Use the coefficients generated by POLFIT to evaluate the */
/*            polynomial fit of degree L, along with the first NDER of */
/*            its derivatives, at a specified point. */
/* ***LIBRARY   SLATEC */
/* ***CATEGORY  K6 */
/* ***TYPE      SINGLE PRECISION (PVALUE-S, DP1VLU-D) */
/* ***KEYWORDS  CURVE FITTING, LEAST SQUARES, POLYNOMIAL APPROXIMATION */
/* ***AUTHOR  Shampine, L. F., (SNLA) */
/*           Davenport, S. M., (SNLA) */
/* ***DESCRIPTION */

/*     Written by L. F. Shampine and S. M. Davenport. */

/*     Abstract */

/*     The subroutine  PVALUE  uses the coefficients generated by  POLFIT */
/*     to evaluate the polynomial fit of degree  L , along with the first */
/*     NDER  of its derivatives, at a specified point.  Computationally */
/*     stable recurrence relations are used to perform this task. */

/*     The parameters for  PVALUE  are */

/*     Input -- */
/*         L -      the degree of polynomial to be evaluated.  L  may be */
/*                  any non-negative integer which is less than or equal */
/*                  to  NDEG , the highest degree polynomial provided */
/*                  by  POLFIT . */
/*         NDER -   the number of derivatives to be evaluated.  NDER */
/*                  may be 0 or any positive value.  If NDER is less */
/*                  than 0, it will be treated as 0. */
/*         X -      the argument at which the polynomial and its */
/*                  derivatives are to be evaluated. */
/*         A -      work and output array containing values from last */
/*                  call to  POLFIT . */

/*     Output -- */
/*         YFIT -   value of the fitting polynomial of degree  L  at  X */
/*         YP -     array containing the first through  NDER  derivatives */
/*                  of the polynomial of degree  L .  YP  must be */
/*                  dimensioned at least  NDER  in the calling program. */

/* ***REFERENCES  L. F. Shampine, S. M. Davenport and R. E. Huddleston, */
/*                 Curve fitting by polynomials in one variable, Report */
/*                 SLA-74-0270, Sandia Laboratories, June 1974. */
/* ***ROUTINES CALLED  XERMSG */
/* ***REVISION HISTORY  (YYMMDD) */
/*   740601  DATE WRITTEN */
/*   890531  Changed all specific intrinsics to generic.  (WRB) */
/*   890531  REVISION DATE from Version 3.2 */
/*   891214  Prologue converted to Version 4.0 format.  (BAB) */
/*   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ) */
/*   900510  Convert XERRWV calls to XERMSG calls.  (RWC) */
/*   920501  Reformatted the REFERENCES section.  (WRB) */
/* ***END PROLOGUE  PVALUE */
/* ***FIRST EXECUTABLE STATEMENT  PVALUE */
    /* Parameter adjustments */
    --a;
    --yp;

    /* Function Body */
    if (*l < 0) {
	goto L12;
    }
    ndo = max(*nder,0);
    ndo = min(ndo,*l);
    maxord = (integer) (a[1] + .5f);
    k1 = maxord + 1;
    k2 = k1 + maxord;
    k3 = k2 + maxord + 2;
    nord = (integer) (a[k3] + .5f);
    if (*l > nord) {
	goto L11;
    }
    k4 = k3 + *l + 1;
    if (*nder < 1) {
	goto L2;
    }
    i__1 = *nder;
    for (i__ = 1; i__ <= i__1; ++i__) {
/* L1: */
	yp[i__] = 0.f;
    }
L2:
    if (*l >= 2) {
	goto L4;
    }
    if (*l == 1) {
	goto L3;
    }

/* L IS 0 */

    val = a[k2 + 1];
    goto L10;

/* L IS 1 */

L3:
    cc = a[k2 + 2];
    val = a[k2 + 1] + (*x - a[2]) * cc;
    if (*nder >= 1) {
	yp[1] = cc;
    }
    goto L10;

/* L IS GREATER THAN 1 */

L4:
    ndp1 = ndo + 1;
    k3p1 = k3 + 1;
    k4p1 = k4 + 1;
    lp1 = *l + 1;
    lm1 = *l - 1;
    ilo = k3 + 3;
    iup = k4 + ndp1;
    i__1 = iup;
    for (i__ = ilo; i__ <= i__1; ++i__) {
/* L5: */
	a[i__] = 0.f;
    }
    dif = *x - a[lp1];
    kc = k2 + lp1;
    a[k4p1] = a[kc];
    a[k3p1] = a[kc - 1] + dif * a[k4p1];
    a[k3 + 2] = a[k4p1];

/* EVALUATE RECURRENCE RELATIONS FOR FUNCTION VALUE AND DERIVATIVES */

    i__1 = lm1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	in = *l - i__;
	inp1 = in + 1;
	k1i = k1 + inp1;
	ic = k2 + in;
	dif = *x - a[inp1];
	val = a[ic] + dif * a[k3p1] - a[k1i] * a[k4p1];
	if (ndo <= 0) {
	    goto L8;
	}
	i__2 = ndo;
	for (n = 1; n <= i__2; ++n) {
	    k3pn = k3p1 + n;
	    k4pn = k4p1 + n;
/* L6: */
	    yp[n] = dif * a[k3pn] + n * a[k3pn - 1] - a[k1i] * a[k4pn];
	}

/* SAVE VALUES NEEDED FOR NEXT EVALUATION OF RECURRENCE RELATIONS */

	i__2 = ndo;
	for (n = 1; n <= i__2; ++n) {
	    k3pn = k3p1 + n;
	    k4pn = k4p1 + n;
	    a[k4pn] = a[k3pn];
/* L7: */
	    a[k3pn] = yp[n];
	}
L8:
	a[k4p1] = a[k3p1];
/* L9: */
	a[k3p1] = val;
    }

/* NORMAL RETURN OR ABORT DUE TO ERROR */

L10:
    *yfit = val;
    return 0;

L11:
    return 0;
/* WRITE (XERN1, '(I8)') L */
/*      WRITE (XERN2, '(I8)') NORD */
/*      CALL XERMSG ('SLATEC', 'PVALUE', */
/*     *   'THE ORDER OF POLYNOMIAL EVALUATION, L = ' // XERN1 // */
/*     *   ' REQUESTED EXCEEDS THE HIGHEST ORDER FIT, NORD = ' // XERN2 // */
/*     *   ', COMPUTED BY POLFIT -- EXECUTION TERMINATED.', 8, 2) */
/*     RETURN */

L12:
    return 0;
/* CALL XERMSG ('SLATEC', 'PVALUE', */
/*     +   'INVALID INPUT PARAMETER.  ORDER OF POLYNOMIAL EVALUATION ' // */
/*     +   'REQUESTED IS NEGATIVE -- EXECUTION TERMINATED.', 2, 2) */
/*      RETURN */
} /* pvalue_ */