End of file
Contents
Index
SUBROUTINE HMTAB(N,NTAB,XBEG,XEND,DELTX,X,A,B,C,D,E,F,
& XTAB,YTAB,LENTAB,IERR)
C
C*****************************************************************
C *
C Constructs a value table for a hermitian polynomial spline of *
C degree five over an arbitrary interval inside the interval of *
C definition (X(1),X(N)). *
C The nodes for the spline inside the *
C subinterval are also tabulated. *
C This allows the program to be used to create input data for *
C graphics subroutines. *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C N : Number of nodes for the spline *
C NTAB : Maximal length of the table. NTAB should be at *
C least (XEND-XBEG)/DELTX+N *
C XBEG : ) Interval, where the spline is to be tabulated *
C XEND : ) with the necessary inclusion condition: *
C X(1) <= XBEG <= XEND <= X(N) *
C DELTX : Step size. The values are created for x-ordinates *
C X = XBEG, XBEG + DELTX, ..., XEND *
C X : N-vector X(1:N); the nodes for the spline *
C A, B, C : ) N-vectors ..(1:N); the spline coefficients *
C D, E, F : ) *
C *
C *
C OUTPUT PARAMETERS: *
C ================= *
C XTAB : ) NTAB-vectors ..(1:NTAB); the value table *
C YTAB : ) Specifically, YTAB(I) = S(XTAB(I)) for *
C ) I = 1, ..., LENTAB *
C LENTAB : size of the table *
C IERR : = 0, no error *
C = 1, XBEG > XEND .OR. XBEG < X(1) .OR. XEND > X(N) *
C = 2, DELTX <= 0. *
C *
C----------------------------------------------------------------*
C *
C Required subroutines: MACHPD *
C *
C*****************************************************************
C *
C Author : Guido Dubois *
C Date : 1.30.1993 *
C Source code : FORTRAN 77 *
C *
C*****************************************************************
C
INTEGER N,NTAB,LENTAB,IERR,I,J,K,M,IBEG,IEND,LBEG,IFLAG,
& MACHPD,IBP1,IEM1
DOUBLE PRECISION X(1:N),A(1:N),B(1:N),C(1:N),D(1:N),E(1:N),
& F(1:N),XTAB(1:NTAB),YTAB(1:NTAB),XBEG,XEND,
& DELTX,X0,X1,FMACHP,EPS
C
C Local storage of the error EPS in case this subroutine is
C called repeatedly.
C
SAVE EPS,IFLAG
DATA IFLAG /0/
IERR=0
C
C Check input parameters
C
IF(XBEG .GT. XEND .OR. XBEG .LT. X(1)
& .OR. XEND .GT. X(N)) THEN
IERR=1
RETURN
END IF
IF(DELTX .LE. 0.0D0) THEN
IERR=2
RETURN
END IF
C
C Find the machine constant
C
IF(IFLAG .EQ. 0) THEN
IFLAG=1
FMACHP=1.0D0
5 FMACHP=0.5D0*FMACHP
IF(MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 5
FMACHP=2.0D0*FMACHP
EPS=1000.0D0*FMACHP
ENDIF
C
C Determine the initial and terminal intervals for the computations
C
LENTAB=0
I=1
K=N
10 M=(I+K)/2
IF(M .NE. I) THEN
IF(XBEG .GE. X(M)) THEN
I=M
ELSE
K=M
END IF
GOTO 10
END IF
IBEG=I
K=N
20 M=(I+K)/2
IF(M .NE. I) THEN
IF(XEND .GT. X(M)) THEN
I=M
ELSE
K=M
END IF
GOTO 20
END IF
IEND=I
C
X0=XBEG
X1=X0-X(IBEG)
IF(IBEG .NE. IEND) THEN
C
C First interval
C
LENTAB=INT((X(IBEG+1)-XBEG+EPS)/DELTX)+1
DO 30 J=1,LENTAB
XTAB(J)=X0
YTAB(J)=((((F(IBEG)*X1+E(IBEG))*X1+D(IBEG))*X1+
& C(IBEG))*X1+B(IBEG))*X1+A(IBEG)
X0=X0+DELTX
X1=X1+DELTX
30 CONTINUE
C
C Second to (N-1)st interval
C
IF((IEND-IBEG) .NE. 1) THEN
IBP1=IBEG+1
IEM1=IEND-1
DO 40 I=IBP1,IEM1
IF(DABS(X0-DELTX-X(I)) .GT. EPS) THEN
LENTAB=LENTAB+1
XTAB(LENTAB)=X(I)
YTAB(LENTAB)=A(I)
END IF
LBEG=LENTAB+1
LENTAB=LENTAB+INT((X(I+1)-X0+EPS)/DELTX)+1
X1=X0-X(I)
DO 50 J=LBEG,LENTAB
XTAB(J)=X0
YTAB(J)=((((F(I)*X1+E(I))*X1+D(I))*X1+
& C(I))*X1+B(I))*X1+A(I)
X0=X0+DELTX
X1=X1+DELTX
50 CONTINUE
40 CONTINUE
END IF
ELSE
LENTAB=LENTAB+1
XTAB(LENTAB)=X0
YTAB(LENTAB)=((((F(IBEG)*X1+E(IBEG))*X1+D(IBEG))*X1+
& C(IBEG))*X1+B(IBEG))*X1+A(IBEG)
X0=X0+DELTX
X1=X1+DELTX
END IF
C
C Nth interval
C
IF(DABS(X0-DELTX-X(IEND)) .GT. EPS .AND.
& X(IEND) .GT. XBEG) THEN
LENTAB=LENTAB+1
XTAB(LENTAB)=X(IEND)
YTAB(LENTAB)=A(IEND)
END IF
LBEG=LENTAB+1
LENTAB=LENTAB+INT((XEND-X0+EPS)/DELTX)+1
X1=X0-X(IEND)
IF(LENTAB .GE. LBEG) THEN
DO 60 J=LBEG,LENTAB
XTAB(J)=X0
YTAB(J)=((((F(IEND)*X1+E(IEND))*X1+D(IEND))*X1+
& C(IEND))*X1+B(IEND))*X1+A(IEND)
X0=X0+DELTX
X1=X1+DELTX
60 CONTINUE
END IF
IF(DABS(X0-DELTX-XEND) .GT. EPS) THEN
LENTAB=LENTAB+1
X0=XEND
X1=X0-X(IEND)
XTAB(LENTAB)=X0
YTAB(LENTAB)=((((F(IEND)*X1+E(IEND))*X1+D(IEND))*X1+
& C(IEND))*X1+B(IEND))*X1+A(IEND)
END IF
RETURN
END
Begin of file
Contents
Index