End of file
Contents
Index

      SUBROUTINE TSPTAB (N,NL,PBEG,PEND,PHIN,A,B,C,D,PHIR,PX,PY,
     +                   NT,XTAB,YTAB,IERR)
C
C*****************************************************************
C                                                                *
C  This program creates a table of values for a transformed      *
C  parametric cubic spline function                              *
C  given in the form:                                            *
C                                                                *
C  S(PHI) = A(I) + B(I)(PHI-PHIN(I)) + C(I)(PHI-PHIN(I))**2 +    *
C                                    + D(I)(PHI-PHIN(I))**3      *
C                                                                *
C  for PHI in the interval [PHIN(I),PHIN(I+1)], I=0,1,...,N-1.   *
C                                                                *
C  The program creates a table containing                        *
C      XTAB := XTAB(PHI) = S(PHI)*COS(PHI+PHIR) + PX, and        *
C      YTAB := YTAB(PHI) = S(PHI)*SIN(PHI+PHIR) + PY.            *
C  Here PHI lies in [PBEG,PEND] and the following conventions    *
C  are used:                                                     *
C   - if PBEG < PHIN(0), the end polynomial P(0) is evaluated    *
C     for all values XTAB < PHIN(0)                              *
C   - if PEND > PHIN(N) the end polynomial P(N-1) is evaluated   *
C     for all values XTAB > PHIN(N)                              *
C   - in every table the interval end points PBEG and PEND and   *
C     all nodes PHIN(I) in between will be used in the table     *
C   - in each subinterval [PHIN(I),PHIN(I+1)] the table is       *
C     created for equidistant steps of size H. Thus H will always*
C     depend on the length of the given interval and on the      *
C     length NL of 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:   PBEG <  PEND                                   *
C  ============   NL   >= 0                                      *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N    :  Index of the final node PHIN(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  PHIN :  vector PHIN(0:N); the nodes PHIN(I), I=0,1,..,N       *
C  A    :  ] N+1-vectors ..(0:N);                                *
C  B    :  ] the elements in positions 0 to N-1 describe the     *
C  C    :  ] coefficients of the spline function S(PHI)          *
C  D    :  ]                                                     *
C                                                                *
C  PHIR :  ] the rotation angle PHIR and the translation vector  *
C  PX   :  ] (PX,PY) are outputs of the subroutine ISPLTR for    *
C  PY   :  ] interpolating splines and of CFSPTR for fitting     *
C          ] splines.                                            *
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 PBEG >= PEND                       *
C          = 2 : Stop because NL < 0                             *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Subroutines 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 PHIN(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 (PEND .LE. PBEG) THEN
        IERR = 1
        RETURN
      ELSEIF (NL .LT. 0) THEN
        IERR = 2
        RETURN
      ENDIF
      IERR = 0
C
C-----determine the interval [PHIN(I),PHIN(I+1)] ----------------
C     which includes PBEG; label it IBEG
C
      I = 0
      K = N
   10 M = (I+K)/2
      IF (PBEG .LT. PHIN(M)) THEN
        K = M
      ELSE
        I = M
      ENDIF
      IF (K .GT. I+1) GOTO 10
      IBEG = I
C
C-----determine the interval [PHIN(I),PHIN(I+1)] ----------
C     which includes PEND; label it IEND
C
      K = N
   20 M = (I+K)/2
      IF (PEND .LT. PHIN(M)) THEN
        K = M
      ELSE
        I = M
      ENDIF
      IF (K .GT .I+1) GOTO 20
      IEND = I
C
C-----determine the values XTAB(I), YTAB(I), I=0,1,...,NT ------
C
C     initialize
C
      HP = PEND - PBEG
      FC = NL/HP
      NT = 0
      PW = PBEG
C
      IF (IBEG .NE. IEND) THEN
C
        IF (PBEG .LT. PHIN(0)) THEN
          IP = 0
        ELSE
          IP = 1
        ENDIF
C
        IF (PEND .GT. PHIN(N)) THEN
          IM = 0
        ELSE
          IM = 1
        ENDIF
C
C        determine the table values from PBEG to
C        PHIN(IBEG+IP)
C
        I = IBEG
        PD = PW - PHIN(I)
        S = ((D(I)*PD + C(I))*PD + B(I))*PD + A(I)
        RHO = PW + PHIR
        XTAB(NT) = S*DCOS(RHO) + PX
        YTAB(NT) = S*DSIN(RHO) + PY
        DIF = PHIN(IBEG+IP) - PBEG
        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
          PW = PW + H
          PD = PW - PHIN(I)
          S = ((D(I)*PD + C(I))*PD + B(I))*PD + A(I)
          RHO = PW + PHIR
          XTAB(NT) = S*DCOS(RHO) + PX
          YTAB(NT) = S*DSIN(RHO) + PY
   30   CONTINUE
        NT = NT + 1
        IF ((IEND-IBEG) .NE. 1) THEN
C
C           determine the table values from PHIN(IBEG+IP)
C           to PHIN(IEND-IM+1)
C
          IBP = IBEG + IP
          IEM = IEND - IM
          DO 40 I = IBP,IEM,1
            PW = PHIN(I)
            RHO = PW + PHIR
            XTAB(NT) = A(I)*DCOS(RHO) + PX
            YTAB(NT) = A(I)*DSIN(RHO) + PY
            DIF = PHIN(I+1) - PHIN(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
              PW = PW + H
              PD = PW - PHIN(I)
              S = ((D(I)*PD + C(I))*PD + B(I))*PD + A(I)
              RHO = PW + PHIR
              XTAB(NT) = S*DCOS(RHO) + PX
              YTAB(NT) = S*DSIN(RHO) + PY
   50       CONTINUE
            NT = NT + 1
   40     CONTINUE
        ENDIF
        PW = PHIN(IEND-IM+1)
      ENDIF
C
C     determine the table values from the location which
C     was tabulated last to PEND
C
      PD = PW - PHIN(IEND)
      S = ((D(IEND)*PD + C(IEND))*PD + B(IEND))*PD + A(IEND)
      RHO = PW + PHIR
      XTAB(NT) = S*DCOS(RHO) + PX
      YTAB(NT) = S*DSIN(RHO) + PY
      DIF = PEND - PW
      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
        PW = PW + H
        PD = PW - PHIN(IEND)
        S = ((D(IEND)*PD + C(IEND))*PD + B(IEND))*PD + A(IEND)
        RHO = PW + PHIR
        XTAB(NT) = S*DCOS(RHO) + PX
        YTAB(NT) = S*DSIN(RHO) + PY
   60 CONTINUE
      NT = NT + 1
      PD = PEND - PHIN(IEND)
      S = ((D(IEND)*PD + C(IEND))*PD + B(IEND))*PD + A(IEND)
      RHO = PEND + PHIR
      XTAB(NT) = S*DCOS(RHO) + PX
      YTAB(NT) = S*SIN(RHO) + PY
      RETURN
      END


Begin of file
Contents
Index