-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathspline.f
30 lines (30 loc) · 816 Bytes
/
spline.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
SUBROUTINE SPLINE(X,Y,N,YP1,YPN,Y2)
PARAMETER (NMAX=100)
DIMENSION X(N),Y(N),Y2(N),U(NMAX)
IF (YP1.GT..99E30) THEN
Y2(1)=0.
U(1)=0.
ELSE
Y2(1)=-0.5
U(1)=(3./(X(2)-X(1)))*((Y(2)-Y(1))/(X(2)-X(1))-YP1)
ENDIF
DO 11 I=2,N-1
SIG=(X(I)-X(I-1))/(X(I+1)-X(I-1))
P=SIG*Y2(I-1)+2.
Y2(I)=(SIG-1.)/P
U(I)=(6.*((Y(I+1)-Y(I))/(X(I+1)-X(I))-(Y(I)-Y(I-1))
* /(X(I)-X(I-1)))/(X(I+1)-X(I-1))-SIG*U(I-1))/P
11 CONTINUE
IF (YPN.GT..99E30) THEN
QN=0.
UN=0.
ELSE
QN=0.5
UN=(3./(X(N)-X(N-1)))*(YPN-(Y(N)-Y(N-1))/(X(N)-X(N-1)))
ENDIF
Y2(N)=(UN-QN*U(N-1))/(QN*Y2(N-1)+1.)
DO 12 K=N-1,1,-1
Y2(K)=Y2(K)*Y2(K+1)+U(K)
12 CONTINUE
RETURN
END