End of file
Contents
Index
SUBROUTINE SPTAB (N,NL,XBEG,XEND,XN,A,B,C,D,NT,XTAB,YTAB,
+ IERR)
C
C*****************************************************************
C *
C This program produces a table of values for non-parametric *
C cubic spline functions *
C of the form: *
C *
C S := S(X) = A(I) + B(I)(X-XN(I)) + C(I)(X-XN(I))**2 + *
C + D(I)(X-XN(I))**3 *
C *
C for X in the interval [XN(I),XN(I+1)] for I=0,1,...,N-1. *
C *
C This program creates a table of values XTAB and YTAB=S(XTAB), *
C where XTAB lies in [XBEG,XEND]. The following conventions are *
C used: *
C - if XBEG < XN(0), the end polynomial P(0) is evaluated for *
C all values XTAB < XN(0) *
C - if XEND > XN(N), the end polynomial P(N-1) is evaluated for*
C all values XTAB > XN(N) *
C - in every table the interval end points XBEG and XEND and *
C all nodes XN(I) in between will be used in the table *
C - in each subinterval [XN(I),XN(I+1)] the table is created *
C for equidistant steps of size H. Thus H will always depend *
C on the length of the given interval and on the length NL of*
C the table. *
C - the input parameter NL presets an approximate table length;*
C the actual table length is NT+1 (NT denotes the final index*
C of the table of values). We must have 0 < NT < NL+N+3. *
C *
C *
C ASSUMPTIONS: XBEG < XEND *
C ============ NL >= 0 *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C N : Index of the final node XN(N) *
C NL : Table length given for dimensioning of the vectors *
C XTAB and YTAB *
C XBEG : Starting table value *
C XEND : Final table value *
C XN : vector XN(0:N); the nodes XN(I), I=0,1,..,N *
C A : ] N+1-vectors A(0:N); *
C B : ] the elements in positions 0 to N-1 describe the *
C C : ] coefficients of the spline function S(X) *
C D : ] *
C *
C *
C OUTPUT PARAMETERS: *
C ================== *
C NT : Final index for the table; equal to the actual table *
C length - 1 *
C XTAB : vector XTAB(0:NL+N+2) ] The elements in positions 0 *
C YTAB : vector YTAB(0:NL+N+2) ] to NT form the table of values*
C IERR : Error parameter *
C = 0 : Everything o.k. *
C = 1 : Stop because XBEG >= XEND *
C = 2 : Stop because NL < 0 *
C *
C----------------------------------------------------------------*
C *
C Subroutins required: none *
C *
C*****************************************************************
C *
C author : Guenter Palm *
C date : 03.28.1989 *
C source : FORTRAN 77 *
C *
C*****************************************************************
C
C-----declarations------------------------------------------------
C
IMPLICIT DOUBLE PRECISION (A-H, O-Z)
DOUBLE PRECISION XN(0:N), A(0:N), B(0:N), C(0:N), D(0:N),
+ XTAB(0:NL+N+2), YTAB(0:NL+N+2)
C
C-----checking the input data-------------------------------------
C
IF (XEND .LE. XBEG) THEN
IERR = 1
RETURN
ELSEIF (NL .LT. 0) THEN
IERR = 2
RETURN
ENDIF
IERR = 0
C
C-----determine the interval [XN(I),XN(I+1)] ---------------------
C that contains XBEG; label it with IBEG
C
I = 0
K = N
10 M = (I+K)/2
IF (XBEG .LT. XN(M)) THEN
K = M
ELSE
I = M
ENDIF
IF (K .GT. I+1) GOTO 10
IBEG = I
C
C-----determine the interval [XN(I),XN(I+1)] ---------------------
C that contains XEND; label it with IEND
C
K = N
20 M = (I+K)/2
IF (XEND .LT. XN(M)) THEN
K = M
ELSE
I = M
ENDIF
IF (K .GT. I+1) GOTO 20
IEND = I
C
C-----determine the table values XTAB(I), YTAB(I), I=0,1,...,NT---
C
C initialize
C
HP = XEND - XBEG
FC = NL/HP
NT = 0
XTAB(NT) = XBEG
C
IF (IBEG .NE. IEND) THEN
C
IF (XBEG .LT. XN(0)) THEN
IP = 0
ELSE
IP = 1
ENDIF
C
IF (XEND .GT. XN(N)) THEN
IM = 0
ELSE
IM = 1
ENDIF
C
C determine the table values for XBEG to
C XN(IBEG+IP)
C
XD = XTAB(NT) - XN(IBEG)
YTAB(NT) = ((D(IBEG)*XD+C(IBEG))*XD+B(IBEG))*XD+A(IBEG)
DIF = XN(IBEG+IP) - XBEG
TIV = DIF*FC
ITV = INT(TIV)
IF ((TIV-ITV) .GT. 0.0D0) ITV = ITV+1
IF (ITV .GT. 0) H = DIF/ITV
DO 30 J = 1,ITV-1,1
NT = NT + 1
XTAB(NT) = XTAB(NT-1) + H
XD = XTAB(NT) - XN(IBEG)
YTAB(NT) = ((D(IBEG)*XD + C(IBEG))*XD +
+ B(IBEG))*XD + A(IBEG)
30 CONTINUE
NT = NT + 1
IF ((IEND-IBEG) .NE. 1) THEN
C
C determine the table values for XN(IBEG+IP)
C to XN(IEND-IM+1)
C
IBP = IBEG + IP
IEM = IEND - IM
DO 40 I = IBP,IEM,1
XTAB(NT) = XN(I)
YTAB(NT) = A(I)
DIF = XN(I+1) - XN(I)
TIV = DIF*FC
ITV = INT(TIV)
IF ((TIV-ITV) .GT. 0.0D0) ITV = ITV+1
IF (ITV. GT. 0) H = DIF/ITV
DO 50 J = 1,ITV-1,1
NT = NT + 1
XTAB(NT) = XTAB(NT-1) + H
XD = XTAB(NT) - XN(I)
YTAB(NT) = ((D(I)*XD + C(I))*XD + B(I))*XD + A(I)
50 CONTINUE
NT = NT + 1
40 CONTINUE
ENDIF
XTAB(NT) = XN(IEND-IM+1)
ENDIF
C
C determine the table values from the last tabulated
C location to XEND
C
XD = XTAB(NT) - XN(IEND)
YTAB(NT) = ((D(IEND)*XD+C(IEND))*XD+ B(IEND))*XD+A(IEND)
DIF = XEND - XTAB(NT)
TIV = DIF*FC
ITV = INT(TIV)
IF ((TIV-ITV) .GT. 0.0D0) ITV = ITV+1
IF (ITV .GT. 0) H = DIF/ITV
DO 60 J = 1,ITV-1,1
NT = NT + 1
XTAB(NT) = XTAB(NT-1) + H
XD = XTAB(NT) - XN(IEND)
YTAB(NT) = ((D(IEND)*XD + C(IEND))*XD +
+ B(IEND))*XD + A(IEND)
60 CONTINUE
NT = NT + 1
XD = XEND - XN(IEND)
XTAB(NT) = XEND
YTAB(NT) = ((D(IEND)*XD+C(IEND))*XD+B(IEND))*XD+A(IEND)
RETURN
END
Begin of file
Contents
Index