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