V3FIT
r8seval.f
1 C******************** START FILE SEVAL.FOR ; GROUP TRKRLIB *************
2 C
3  REAL*8 FUNCTION r8seval(N, U, X, Y, B, C, D)
4  IMPLICIT NONE
5  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
6  INTEGER N
7  real*8 u, x(n), y(n), b(n), c(n), d(n)
8 C
9 CCCCCCCCCCCCCCC
10 CCCCCCCCCCCCCCC
11 C THIS SUBROUTINE EVALUATES THE CUBIC SPLINE FUNCTION
12 C
13 C SEVAL = Y(I) + B(I)*(U-X(I)) + C(I)*(U-X(I))**2 + D(I)*(U-X(I))**3
14 C
15 C WHERE X(I) .LT. U .LT. X(I+1), USING HORNER'S RULE
16 C
17 C IF U .LT. X(1) THEN I = 1 IS USED.
18 C IF U .GE. X(N) THEN I = N IS USED.
19 C
20 C INPUT..
21 C
22 C N = THE NUMBER OF DATA POINTS
23 C U = THE ABSCISSA AT WHICH THE SPLINE IS TO BE EVALUATED
24 C X,Y = THE ARRAYS OF DATA ABSCISSAS AND ORDINATES
25 C B,C,D = ARRAYS OF SPLINE COEFFICIENTS COMPUTED BY SPLINE
26 C
27 C IF U IS NOT IN THE SAME INTERVAL AS THE PREVIOUS CALL, THEN A
28 C BINARY SEARCH IS PERFORMED TO DETERMINE THE PROPER INTERVAL.
29 C
30  INTEGER I, J, K
31  real*8 dx
32  DATA i/1/
33  IF ( i .GE. n ) i = 1
34  IF ( u .LT. x(i) ) GO TO 10
35  IF ( u .LE. x(i+1) ) GO TO 30
36 C
37 C BINARY SEARCH
38 C
39  10 i = 1
40  j = n+1
41  20 k = (i+j)/2
42  IF ( u .LT. x(k) ) j = k
43  IF ( u .GE. x(k) ) i = k
44  IF ( j .GT. i+1 ) GO TO 20
45 C
46 C EVALUATE SPLINE
47 C
48  30 dx = u - x(i)
49  r8seval = y(i) + dx*(b(i) + dx*(c(i) + dx*d(i)))
50 C
51  RETURN
52  END
53 C******************** END FILE SEVAL.FOR ; GROUP TRKRLIB ***************