End of file
Contents
Index

      SUBROUTINE PMTAB(N,NTAB,TBEG,TEND,DELT,T,AX,BX,CX,DX,EX,FX,
     &                 AY,BY,CY,DY,EY,FY,XTAB,YTAB,LENTAB,IERR)
C
C*****************************************************************
C                                                                *
C  Tabulates a parametric Hermite spline. The nodes of the       *
C  spline are retained, as long as they lie in the table interval*
C  [TBEG, TEND]. This allows the program to create input data    *
C  for 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   (TEND-TBEG)/DELT+N.                        *
C  TBEG     : ) Parameter interval, where the spline is tabulated*
C  TEND     : ) Necessary condition:                             *
C                     T(1) <= TBEG <= TEND <= T(N)               *
C  DELT     : Step size. The table of values is created for      *
C             T = TBEG, TBEG + DELT, ..., TEND                   *
C  T        : N-vector T(1:N); the nodes of the splineparameter T*
C  AX, BX   : ) N-vectors ..(1:N); the coefficients of the spline*
C  CX, DX   : ) component SX(T)                                  *
C  EX, FX   : )                                                  *
C  AY, BY   : ) N-vectors ..(1:N); the coefficients of the Spline*
C  CY, DY   : ) component SY(T)                                  *
C  EY, FY   : )                                                  *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  =================                                             *
C  XTAB     : ) NTAB-vectors ..(1:NTAB); the table of values     *
C  YTAB     : )                                                  *
C  LENTAB   : length of the table                                *
C  IERR     : = 0, no error                                      *
C             = 1, TBEG > TEND .OR. TBEG < T(1) .OR. TEND > T(N) *
C             = 2, DELT <= 0.                                    *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  Author      : Guido Dubois                                    *
C  Date        : 4.18.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 T(1:N),AX(1:N),BX(1:N),CX(1:N),DX(1:N),
     &                 EX(1:N),FX(1:N),AY(1:N),BY(1:N),CY(1:N),
     &                 DY(1:N),EY(1:N),FY(1:N),XTAB(1:NTAB),
     &                 YTAB(1:NTAB),TBEG,TEND,DELT,FMACHP,
     &                 EPS,T0,T1
C
C  Local storage of the error EPS in case that this subroutine
C  is called repeatedly
C
      SAVE EPS,IFLAG
      DATA IFLAG /0/
      IERR=0
C
C  Check input parameters
C
      IF(TBEG .GT. TEND .OR. TBEG .LT. T(1)
     &                  .OR. TEND .GT. T(N)) THEN
         IERR=1
         RETURN
      END IF
      IF(DELT .LE. 0.0D0) THEN
         IERR=2
         RETURN
      END IF
C
C  Compute 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 starting and terminal intervals of computation
C
      LENTAB=0
      I=1
      K=N
   10 M=(I+K)/2
      IF(M .NE. I) THEN
         IF(TBEG .GE. T(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(TEND .GT. T(M)) THEN
            I=M
         ELSE
            K=M
         END IF
         GOTO 20
      END IF
      IEND=I
C
      T0=TBEG
      T1=T0-T(IBEG)
      IF(IBEG .NE. IEND) THEN
C
C  First interval
C
         LENTAB=INT((T(IBEG+1)-TBEG+EPS)/DELT)+1
         DO 30 J=1,LENTAB
            XTAB(J)=((((FX(IBEG)*T1+EX(IBEG))*T1+DX(IBEG))*T1+
     &                              CX(IBEG))*T1+BX(IBEG))*T1+AX(IBEG)
            YTAB(J)=((((FY(IBEG)*T1+EY(IBEG))*T1+DY(IBEG))*T1+
     &                              CY(IBEG))*T1+BY(IBEG))*T1+AY(IBEG)
            T0=T0+DELT
            T1=T1+DELT
   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(T0-DELT-T(I)) .GT. EPS) THEN
                  LENTAB=LENTAB+1
                  XTAB(LENTAB)=AX(I)
                  YTAB(LENTAB)=AY(I)
               END IF
               LBEG=LENTAB+1
               LENTAB=LENTAB+INT((T(I+1)-T0+EPS)/DELT)+1
               T1=T0-T(I)
               DO 50 J=LBEG,LENTAB
                  XTAB(J)=((((FX(I)*T1+EX(I))*T1+DX(I))*T1+
     &                                 CX(I))*T1+BX(I))*T1+AX(I)
                  YTAB(J)=((((FY(I)*T1+EY(I))*T1+DY(I))*T1+
     &                                 CY(I))*T1+BY(I))*T1+AY(I)
                  T0=T0+DELT
                  T1=T1+DELT
   50          CONTINUE
   40       CONTINUE
         END IF
      ELSE
         LENTAB=LENTAB+1
         XTAB(LENTAB)=((((FX(IBEG)*T1+EX(IBEG))*T1+DX(IBEG))*T1+
     &                                CX(IBEG))*T1+BX(IBEG))*T1+AX(IBEG)
         YTAB(LENTAB)=((((FY(IBEG)*T1+EY(IBEG))*T1+DY(IBEG))*T1+
     &                                CY(IBEG))*T1+BY(IBEG))*T1+AY(IBEG)
         T0=T0+DELT
         T1=T1+DELT
      END IF
CX(IBEG))*T1+BX(IBEG))*T1+AX(IBEG)
      IF(DABS(T0-DELT-T(IEND)) .GT. EPS .AND.
     &                 T(IEND) .GT. TBEG) THEN
         LENTAB=LENTAB+1
         XTAB(LENTAB)=AX(IEND)
         YTAB(LENTAB)=AY(IEND)
      END IF
      LBEG=LENTAB+1
      LENTAB=LENTAB+INT((TEND-T0+EPS)/DELT)+1
      T1=T0-T(IEND)
      IF(LENTAB .GE. LBEG) THEN
         DO 60 J=LBEG,LENTAB
            XTAB(J)=((((FX(I)*T1+EX(I))*T1+DX(I))*T1+
     &                           CX(I))*T1+BX(I))*T1+AX(I)
            YTAB(J)=((((FY(I)*T1+EY(I))*T1+DY(I))*T1+
     &                           CY(I))*T1+BY(I))*T1+AY(I)
            T0=T0+DELT
            T1=T1+DELT
   60    CONTINUE
      END IF
      IF(DABS(T0-DELT-TEND) .GT. EPS) THEN
         LENTAB=LENTAB+1
         T0=TEND
         T1=T0-T(IEND)
         XTAB(LENTAB)=((((FX(I)*T1+EX(I))*T1+DX(I))*T1+
     &                             CX(I))*T1+BX(I))*T1+AX(I)
         YTAB(LENTAB)=((((FY(I)*T1+EY(I))*T1+DY(I))*T1+
     &                             CY(I))*T1+BY(I))*T1+AY(I)
      END IF
      RETURN
      END


Begin of file
Contents
Index