End of file
Contents
Index

      SUBROUTINE TSPANA (PHI,N,PHIN,A,B,C,D,PHIR,PX,PY,S,S1,S2,S3,
     +                   XK,YK,C1,CCR,IERR1,IERR2)
C
C*****************************************************************
C                                                                *
C  Evaluation program for transformed parametric cubic spline    *
C  functions                                                     *
C  formatted as follows                                          *
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  This program determines the functional value and that of the  *
C  1st, 2nd and 3rd derivative of a spline function S(PHI), as   *
C  well as the values XK=F(S(PHI)), YK=F(S(PHI)), and the 1st    *
C  derivative and the curvature of the curve K at a given PHI.   *
C                                                                *
C                                                                *
C  NOTE:  This evaluation program is not well suited for making  *
C  =====  a table of values for S(PHI) or the curve determined   *
C         by the points XK, YK.                                  *
C         If one only wants to evaluate the spline function      *
C         S(PHI), we recommend the subroutine SPVAL instead.     *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  PHI  :  Position (in radians) where we want to evaluate the   *
C          spline                                                *
C  N    :  Number of the final node PHIN(N)                      *
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  S  :  Function value of the spline function at PHI            *
C  S1 :  1st derivative "   "     "      "     "   "             *
C  S2 :  2nd derivative "   "     "      "     "   "             *
C  S3 :  3rd derivative "   "     "      "     "   "             *
C  XK : ] Coordinates of curve K at PHI                          *
C  YK : ]                                                        *
C  C1 :  1st derivative of curve K at PHI                        *
C        It is determined by the equation:                       *
C        C1 = (S1*SIN(RHO)+S*COS(RHO))/(S1*COS(RHO)-S*SIN(RHO)), *
C              with RHO = PHI + PHIR.                            *
C  CCR:  Curvature of curve K at location PHI.                   *
C        It is determined by the equation:                       *
C        CCR = (2*S1**2 - S*S2 + S**2)/((S1**2 + S**2)**1.5).    *
C                                                                *
C  IERR1 :  Error parameter for determining C1                   *
C           = 0 : Everything o.k.                                *
C           = 1 : The denominator of the equation for C1 is zero;*
C                 C1 was not determined                          *
C           = 2 : The magnitude of the denominator in the        *
C                 equation for C1 is not zero; but it is less    *
C                 than four times the machine constant.          *
C                 A value for C1 cannot be accurately determined.*
C  IERR2 :  Error parameter for determining CCR                  *
C           = 0 : Everything o.k.                                *
C           = 1 : The denominator of the equation for CCR is zero*
C                 CCR was not determined                         *
C           = 2 : The magnitude of the denominator in the        *
C                 equation for CCR is not zero, but it is less   *
C                 than four times the machine constant.          *
C                 A value for CCR could not be accurately        *
C                 determined.                                    *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Subroutines required: SPLFVD, MACHPD                          *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Guenter Palm                                       *
C  date     : 04.15.1988                                         *
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)
      LOGICAL FLAG
      SAVE FMACHP,FLAG
C
C-----initializing------------------------------------------------
C
      DATA FLAG /.TRUE./
      TWOPI = 8.0D0*DATAN(1.0D0)
      IERR1 = 0
      IERR2 = 0
C
C-----determine the machine constant (only on 1st call)----------
C
      IF (FLAG) THEN
        FMACHP = 1.0D0
   10   FMACHP = 0.5D0*FMACHP
        IF (MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 10
        FMACHP = 8.0D0*FMACHP
        FLAG = .FALSE.
      ENDIF
C
C-----assign PHI to the auxiliary variable PHIX, -----------------
C     if necessary convert PHIX so that PHIX lies
C     in the interval [0,2*PI]
C
      IF (PHI .LT. 0.0D0) THEN
        L = ABS(INT(PHI/TWOPI)) + 1
        PHIX = L*TWOPI - PHI
      ELSEIF (PHI .GT. TWOPI) THEN
        L = INT(PHI/TWOPI)
        PHIX = PHI - L*TWOPI
      ELSE
        PHIX = PHI
      ENDIF
C
C-----determine the functional value S and that of the derivatives-
C     at PHIX in SUBROUTINE SPLFVD
C
      CALL SPLFVD (PHIX,N,PHIN,A,B,C,D,S,S1,S2,S3)
C
C-----Determine the coordinates XK, YK of the curve, ------------
C     as well as the 1st derivative and the curvature
C
      RHO  = PHIX + PHIR
      COSA = DCOS(RHO)
      SINA = DSIN(RHO)
      XK   = S*COSA + PX
      YK   = S*SINA + PY
      HZ   = S1*SINA + S*COSA
      HN   = S1*COSA - S*SINA
      IF (HN .EQ. 0.0D0) THEN
        IERR1 = 1
      ELSE
        IF (DABS(HN) .LE. FMACHP) IERR1 = 2
        C1 = HZ/HN
      ENDIF
      HZ = 2.0D0*S1*S1 - S*S2 + S*S
      HN = (S1*S1 + S*S)**1.5D0
      IF (HN .EQ. 0.0D0) THEN
        IERR2 = 1
      ELSE
        IF (DABS(HN). LE. FMACHP) IERR2 = 2
        CCR = HZ/HN
      ENDIF
      RETURN
      END


Begin of file
Contents
Index