V3FIT
r8spleen.f
1 C-------------------------------------------
2 C derived from Forsyth/Malcolm/Moler SPLINE.FOR -- different BC:
3 C y'=0 at RHS of data interval (high index side)
4 C
5 CCCCCCCCCCCCCCC
6  SUBROUTINE r8spleen (N, X, Y, B, C, D)
7  IMPLICIT NONE
8  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
9  INTEGER N
10  real*8 x(n), y(n), b(n), c(n), d(n)
11 C
12 C THE COEFFICIENTS B(I), C(I), AND D(I), I=1,2,...,N ARE COMPUTED
13 C FOR A CUBIC INTERPOLATING SPLINE FOR WHICH S'(XN)=0.
14 C
15 C S(X) = Y(I) + B(I)*(X-X(I)) + C(I)*(X-X(I))**2 + D(I)*(X-X(I))**3
16 C
17 C FOR X(I) .LE. X .LE. X(I+1)
18 C
19 C INPUT..
20 C
21 C N = THE NUMBER OF DATA POINTS OR KNOTS (N.GE.2)
22 C X = THE ABSCISSAS OF THE KNOTS IN STRICTLY INCREASING ORDER
23 C Y = THE ORDINATES OF THE KNOTS
24 C
25 C OUTPUT..
26 C
27 C B, C, D = ARRAYS OF SPLINE COEFFICIENTS AS DEFINED ABOVE.
28 C
29 C USING P TO DENOTE DIFFERENTIATION,
30 C
31 C Y(I) = S(X(I))
32 C B(I) = SP(X(I))
33 C C(I) = SPP(X(I))/2
34 C D(I) = SPPP(X(I))/6 (DERIVATIVE FROM THE RIGHT)
35 C
36 CCCCCCCCCCCCCCC
37 C THE ACCOMPANYING FUNCTION SUBPROGRAM SEVAL CAN BE USED
38 C TO EVALUATE THE SPLINE.
39 C
40 C
41  INTEGER NM1, IB, I
42  real*8 t
43 C
44  nm1 = n-1
45  IF ( n .LT. 2 ) RETURN
46  IF ( n .LT. 3 ) GO TO 50
47 C
48 C SET UP TRIDIAGONAL SYSTEM
49 C
50 C B = DIAGONAL, D = OFFDIAGONAL, C = RIGHT HAND SIDE.
51 C
52  d(1) = x(2) - x(1)
53  c(2) = (y(2) - y(1))/d(1)
54  DO 10 i = 2, nm1
55  d(i) = x(i+1) - x(i)
56  b(i) = 2._r8*(d(i-1) + d(i))
57  c(i+1) = (y(i+1) - y(i))/d(i)
58  c(i) = c(i+1) - c(i)
59  10 CONTINUE
60 C
61 C END CONDITIONS. THIRD DERIVATIVES AT X(1) AND X(N)
62 C OBTAINED FROM DIVIDED DIFFERENCES
63 C
64  b(1) = -d(1)
65  b(n) = +2._r8*d(n-1)
66  c(1) = 0._r8
67  c(n) = 0._r8
68  IF ( n .EQ. 3 ) GO TO 15
69  c(1) = c(3)/(x(4)-x(2)) - c(2)/(x(3)-x(1))
70  c(1) = c(1)*d(1)**2/(x(4)-x(1))
71  c(n)= -(y(n)-y(n-1))/d(n-1)
72 C
73 C FORWARD ELIMINATION
74 C
75  15 DO 20 i = 2, n
76  t = d(i-1)/b(i-1)
77  b(i) = b(i) - t*d(i-1)
78  c(i) = c(i) - t*c(i-1)
79  20 CONTINUE
80 C
81 C BACK SUBSTITUTION
82 C
83  c(n) = c(n)/b(n)
84  DO 30 ib = 1, nm1
85  i = n-ib
86  c(i) = (c(i) - d(i)*c(i+1))/b(i)
87  30 CONTINUE
88 C
89 C C(I) IS NOW THE SIGMA(I) OF THE TEXT
90 C
91 C COMPUTE POLYNOMIAL COEFFICIENTS
92 C
93  b(n) = (y(n) - y(nm1))/d(nm1) + d(nm1)*(c(nm1) + 2._r8*c(n))
94  DO 40 i = 1, nm1
95  b(i) = (y(i+1) - y(i))/d(i) - d(i)*(c(i+1) + 2._r8*c(i))
96  d(i) = (c(i+1) - c(i))/d(i)
97  c(i) = 3._r8*c(i)
98  40 CONTINUE
99  c(n) = 3._r8*c(n)
100  d(n) = d(n-1)
101  RETURN
102 C
103  50 b(1) = (y(2)-y(1))/(x(2)-x(1))
104  c(1) = 0._r8
105  d(1) = 0._r8
106  b(2) = b(1)
107  c(2) = 0._r8
108  d(2) = 0._r8
109  RETURN
110  END