V3FIT
seval3.f
1 C******************** START FILE SEVAL3.FOR ; GROUP TRKRLIB ************
2 C
3  REAL FUNCTION SEVAL3(N, U, X, Y, B, C, D, deriv, deriv2)
4  INTEGER N
5  REAL U, X(N), Y(N), B(N), C(N), D(N), deriv
6 C
7 CCCCCCCCCCCCCCC
8 CCCCCCCCCCCCCCC
9 C THIS SUBROUTINE EVALUATES THE CUBIC SPLINE FUNCTION
10 C
11 C SEVAL3 = Y(I) + B(I)*(U-X(I)) + C(I)*(U-X(I))**2 + D(I)*(U-X(I))**3
12 C
13 C and the derivative
14 C
15 C deriv = B(i) + 2*C(i)*(U-X(i)) + 3*D(i)*(U-X(i))**2
16 C
17 C and the 2nd derivative
18 C
19 C deriv2 = 2*C(i) + 6*D(i)*(U-X(i))
20 C
21 C WHERE X(I) .LT. U .LT. X(I+1), USING HORNER'S RULE
22 C
23 C IF U .LT. X(1) THEN I = 1 IS USED.
24 C IF U .GE. X(N) THEN I = N IS USED.
25 C
26 C INPUT..
27 C
28 C N = THE NUMBER OF DATA POINTS
29 C U = THE ABSCISSA AT WHICH THE SPLINE IS TO BE EVALUATED
30 C X,Y = THE ARRAYS OF DATA ABSCISSAS AND ORDINATES
31 C B,C,D = ARRAYS OF SPLINE COEFFICIENTS COMPUTED BY SPLINE
32 C
33 C IF U IS NOT IN THE SAME INTERVAL AS THE PREVIOUS CALL, THEN A
34 C BINARY SEARCH IS PERFORMED TO DETERMINE THE PROPER INTERVAL.
35 C
36  INTEGER I, J, K, ILIN
37  REAL DX
38  DATA i/1/
39  DATA ilin/0/
40 C
41  IF ( i .GE. n ) i = 1
42  IF ( u .LT. x(i) ) GO TO 10
43  IF ( u .LE. x(i+1) ) GO TO 30
44 C
45 C BINARY SEARCH
46 C
47  10 i = 1
48  j = n+1
49  20 k = (i+j)/2
50  IF ( u .LT. x(k) ) j = k
51  IF ( u .GE. x(k) ) i = k
52  IF ( j .GT. i+1 ) GO TO 20
53 C
54 C EVALUATE SPLINE
55 C
56  30 dx = u - x(i)
57  IF(ilin.EQ.0) THEN
58  seval3 = y(i) + dx*(b(i) + dx*(c(i) + dx*d(i)))
59  deriv = b(i) + dx*(2.0*c(i) + dx*3.0*d(i))
60  deriv2 = 2.0*c(i) + dx*6.0*d(i)
61  ELSE
62  IF(i.EQ.n) THEN
63  zslop=(y(n)-y(n-1))/(x(n)-x(n-1))
64  ELSE
65  zslop=(y(i+1)-y(i))/(x(i+1)-x(i))
66  ENDIF
67  seval3=y(i)+dx*zslop
68  deriv=zslop
69  deriv2=0.0
70  ENDIF
71 C
72  RETURN
73  END
74 C******************** END FILE SEVAL3.FOR ; GROUP TRKRLIB **************
deriv
Definition: mapout_nc.f:94