V3FIT
pspline.f
1 C PSPLINE -- modified from SPLINE.FOR -- dmc 3 Oct 1995
2 C
3 C THE CODES (SPLINE & SEVAL) ARE TAKEN FROM:
4 C FORSYTHE,MALCOLM AND MOLER, "COMPUTER METHODS FOR
5 C MATHEMATICAL COMPUTATIONS",PRENTICE-HALL, 1977.
6 c
7 c PSPLINE -- periodic spline -- adaptation of SPLINE.FOR by D. McCune
8 c October 1995: The function to be splined is taken as having periodic
9 C derivatives (it need not be periodic itself), so that
10 c the interpolating function satisfies
11 c y'(x(1))=y'(x(N))
12 c y''(x(1))=y''(x(N))
13 c this results in a fully specified system (no addl BC assumptions
14 c required); it is not a tridiagonal system but a modified NM1xNM1
15 c tridiagonal system with non-zero offdiagonal corner (1,NM1), (NM1,1)
16 c elements. It remains symmetric & diagonally dominant, and is
17 c solved by Gaussian elimination w/o pivoting. NM1=N-1.
18 c
19  SUBROUTINE pspline (N, X, Y, B, C, D, WK)
20  INTEGER N
21  REAL X(N), Y(N), B(N), C(N), D(N), WK(N)
22 C
23 C THE COEFFICIENTS B(I), C(I), AND D(I), I=1,2,...,N ARE COMPUTED
24 C FOR A periodic CUBIC INTERPOLATING SPLINE
25 C
26 C S(X) = Y(I) + B(I)*(X-X(I)) + C(I)*(X-X(I))**2 + D(I)*(X-X(I))**3
27 C
28 C FOR X(I) .LE. X .LE. X(I+1)
29 C
30 C WK(...) is used as a workspace during the Guassian elimination.
31 C it represents the rightmost column of the array
32 C
33 C note B(N),C(N),D(N) give coeffs for a periodic continuation into
34 C the next period, up to X(N)+(X(2)-X(1)) only.
35 C
36 C SEVAL can be used to evaluate the spline, but, it is up to the
37 C SEVAL caller to bring the argument into the normal range X(1) to X(N).
38 C
39 C INPUT..
40 C
41 C N = THE NUMBER OF DATA POINTS OR KNOTS (N.GE.2)
42 C includes a complete period of the data, the last point being
43 C a repeat of the first point.
44 C X = THE ABSCISSAS OF THE KNOTS IN STRICTLY INCREASING ORDER
45 C X(N)-X(1) is the period of the periodic function represented.
46 C Y = THE ORDINATES OF THE KNOTS
47 C
48 C OUTPUT..
49 C
50 C B, C, D = ARRAYS OF SPLINE COEFFICIENTS AS DEFINED ABOVE.
51 C
52 C USING P TO DENOTE DIFFERENTIATION,
53 C
54 C Y(I) = S(X(I))
55 C B(I) = SP(X(I))
56 C C(I) = SPP(X(I))/2
57 C D(I) = SPPP(X(I))/6 (DERIVATIVE FROM THE RIGHT)
58 C
59 CCCCCCCCCCCCCCC
60 C THE ACCOMPANYING FUNCTION SUBPROGRAM SEVAL CAN BE USED
61 C TO EVALUATE THE SPLINE.
62 C
63 C
64  INTEGER NM1, NM2, IB, I
65  REAL T
66 C
67 C-------------------------------------
68 C
69  nm1 = n-1
70  nm2 = nm1-1
71 C
72  IF ( n .LT. 4 ) THEN
73  write(6,9901)
74  9901 format(/
75  > ' ?PSPLINE -- at least 4 pts required for periodic spline.')
76  return
77  ENDIF
78 C
79 C SET UP MODIFIED NM1 x NM1 TRIDIAGONAL SYSTEM:
80 C B = DIAGONAL, D = OFFDIAGONAL, C = RIGHT HAND SIDE.
81 C WK(1:NM2) = rightmost column above diagonal
82 C WK(NM1) = lower left corner element
83 C
84  d(1) = x(2) - x(1)
85  d(nm1) = x(n) - x(nm1)
86  b(1) = 2.0*(d(1)+d(nm1))
87  c(1) = (y(n) - y(nm1))/d(nm1)
88  c(2) = (y(2) - y(1))/d(1)
89  c(1) = c(2) - c(1)
90  wk(1) = d(nm1)
91  DO 10 i = 2, nm1
92  d(i) = x(i+1) - x(i)
93  b(i) = 2.*(d(i-1) + d(i))
94  c(i+1) = (y(i+1) - y(i))/d(i)
95  c(i) = c(i+1) - c(i)
96  wk(i) = 0.0
97  10 CONTINUE
98  wk(nm2) = d(nm2)
99  wk(nm1) = d(nm1)
100 C
101 C END CONDITIONS -- implied by periodicity
102 C C(1)=C(N) B(1)=B(N) D(1)=D(N) -- no additional assumption needed.
103 C
104 C FORWARD ELIMINATION
105 C WK(1)--WK(NM2) represent the rightmost column above the
106 C diagonal; WK(NM1) represents the non-zero lower left corner element
107 C which in each step is moved one column to the right.
108 C
109  15 DO 20 i = 2, nm2
110  t = d(i-1)/b(i-1)
111  b(i) = b(i) - t*d(i-1)
112  c(i) = c(i) - t*c(i-1)
113  wk(i) = wk(i) - t*wk(i-1)
114  q = wk(nm1)/b(i-1)
115  wk(nm1) = -q*d(i-1)
116  b(nm1) = b(nm1) - q*wk(i-1)
117  c(nm1) = c(nm1) - q*c(i-1)
118  20 CONTINUE
119 C
120 C correct the (NM1,NM2) element
121 C
122  wk(nm1) = wk(nm1) + d(nm2)
123 C
124 C complete the forward elimination: now WK(NM1) and WK(NM2) are
125 C the off diagonal elements of the 2x2 at the lower right hand corner
126 C
127  t = wk(nm1)/b(nm2)
128  b(nm1) = b(nm1) - t*wk(nm2)
129  c(nm1) = c(nm1) - t*c(nm2)
130 C
131 C BACK SUBSTITUTION
132 C
133  c(nm1) = c(nm1)/b(nm1)
134  c(nm2) = (c(nm2) - wk(nm2)*c(nm1))/b(nm2)
135 C
136  DO 30 ib = 3, nm1
137  i = n-ib
138  c(i) = (c(i) - d(i)*c(i+1) - wk(i)*c(nm1))/b(i)
139  30 CONTINUE
140 C
141 C PERIODICITY:
142 C
143  c(n)=c(1)
144 C
145 C C(I) IS NOW THE SIGMA(I) OF THE TEXT
146 C
147 C COMPUTE POLYNOMIAL COEFFICIENTS
148 C
149  DO 40 i = 1, nm1
150  b(i) = (y(i+1) - y(i))/d(i) - d(i)*(c(i+1) + 2.*c(i))
151  d(i) = (c(i+1) - c(i))/d(i)
152  c(i) = 3.*c(i)
153  40 CONTINUE
154 C periodic continuation...
155  b(n) = b(1)
156  c(n) = c(1)
157  d(n) = d(1)
158 C
159  RETURN
160  END