End of file
Contents
Index



F 11.4 Parametric Cubic Fitting Splines


      SUBROUTINE CFSPPA (N,XN,FN,WX,WY,T,MT,IB,ALPHA,BETA,MW,
     +                   AX,BX,CX,DX,AY,BY,CY,DY,AUXF,IERR)
C
C*****************************************************************
C                                                                *
C  CFSPPA computes the coefficients AX(I), BX(I), CX(I), DX(I),  *
C  AY(I), BY(I), CY(I), DY(I) for I=0, 1, ..., N-1 of a          *
C  parametric cubic fitting spline for various end point con-    *
C  ditions. The end point conditions are prescribed via the      *
C  parameter IB.                                                 *
C  The parametric spline S with parameters T(I) for I=0, 1, ..., *
C  N, has two component functions SX and SY of the following form*
C                                                                *
C  SX := SX(T) = AX(I) + BX(I)(T-T(I)) + CX(I)(T-T(I))**2 +      *
C                                      + DX(I)(T-T(I))**3        *
C                                                                *
C  SY := SY(T) = AY(I) + BY(I)(T-T(I)) + CY(I)(T-T(I))**2 +      *
C                                      + DY(I)(T-T(I))**3        *
C                                                                *
C  for T in the interval [T(I),T(I+1)], I=0, 1, ..., N-1.        *
C                                                                *
C  SX and SY are nonparametric cubic splines.                    *
C                                                                *
C                                                                *
C  ASSUMPTIONS:    1.         N > 4     , for IB = 1, 2 or 3     *
C  ============               N > 5     , for IB =  4            *
C                  2.      T(I) < T(I+1), I=0, 1, ..., N-1       *
C                  3.     WX(I) > 0.0   ] I=0, 1, ..., N         *
C                  3.     WY(I) > 0.0   ]                        *
C                  4.     WX(0) = WX(N) ] for IB = 4             *
C                         WY(0) = WY(N) ]                        *
C                  5.     FN(0) = FN(N) , for IB = 4             *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N  :  Index of the last node                                  *
C  XN :  vector XN(0:N); XN(I) is the Ith node, I = 0, ..., N    *
C  FN :  vector FN(0:N); FN(I) is the data at the node XN(I)     *
C  WX :  vector WX(0:N); weight for the node XN(I), I=0, ..., N  *
C  WY :  vector WXY0:N); weight for the data point FN(I),        *
C        I = 0, 1, ..., N                                        *
C  T  :  vector T(0:N); the parameter value corresponding to     *
C        XN(I),FN(I)                                             *
C  MT :  label for the assignment of the parameter T(I)          *
C        MT = 0 : The user will prescribe the parameter values   *
C                 T(I) for I=0, 1, ..., N.                       *
C        MT = 1 : The parameter values shall be computed in sub- *
C                 routine PSPPV from the chordal lengths.        *
C        MT = 2 : The parameter values shall be computed in sub- *
C                 routine PSPPV from the arc length.             *
C                                                                *
C  IB : determines the end point condition:                      *
C       IB = 1: first end point derivative with respect to the   *
C               parameter prescribed                             *
C       IB = 2: second end point derivative with respect to the  *
C               parameter prescribed                             *
C       IB = 3: first end point derivative DY/DX prescribed      *
C       IB = 4: periodic spline                                  *
C                                                                *
C  ALPHA :  vector ALPHA(1:2)                                    *
C  BETA  :  vector BETA(1:2)                                     *
C           for IB = 1 or 2 : first or second derivative wrt     *
C                             parameter:                         *
C                             ALPHA(1)=SX(IB)(T(0))              *
C                             ALPHA(2)=SY(IB)(T(0))              *
C                             BETA(1) =SX(IB)(T(N))              *
C                             BETA(2) =SY(IB)(T(N))              *
C           for IB = 3 :  first end point derivative DY/DX       *
C                           ALPHA(1) = DY/DX (XN(0))             *
C                           BETA(1)  = DY/DX (XN(N))             *
C                           ALPHA(2) : not needed                *
C                           BETA(2)  : not needed                *
C                If the magnitude of ALPHA(1) or BETA(1) exceeds *
C                1.E10, then the corresponding tangent vector is *
C                computed as follows:                            *
C                 . .                                            *
C                (X,Y) = (0,SIGN(1,FN(1)-FN(0))  (left end point)*
C                 . .                                            *
C                (X,Y) = (0,SIGN(1,FN(N)-FN(N-1)) (right end     *
C                                                        point)  *
C                                                                *
C           for IB = 4 : not needed                              *
C                                                                *
C  (A natural parametric fitting spline can be obtained for IB=2 *
C   and ALPHA(1) = ALPHA(2) = BETA(1) = BETA(2) = 0.0.)          *
C                                                                *
C  MW : label for preassignment of weights WX(I),WY(I), I=0,...,N*
C       MW < 1: weights not preassigned,                         *
C               CFSPPA uses  WX(I) = WY(I) = 1.0                 *
C       MW = 1: the user preassigns the weights WY(I),           *
C               CFSPPA uses WX(I) = WY(I)                        *
C       MW > 1: the user preassigns both WX(I) and WY(I)         *
C                                                                *
C                                                                *
C  AUXILIARY VARIABLES:                                          *
C  ====================                                          *
C  AUXF :  vector AUXF(1:14*N-10)                                *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  AX :  vector  AX(0:N) ]   The elements in positions 0 to N-1  *
C  BX :  vector  BX(0:N) ]   are the coefficients of the com-    *
C  CX :  vector  CX(0:N) ]   component spline function SX        *
C  DX :  vector  DX(0:N) ]                                       *
C                                                                *
C  AY :  vector  AY(0:N) ]   The elements in positions 0 to N-1  *
C  BY :  vector  BY(0:N) ]   are the coefficients of the com-    *
C  CY :  vector  CY(0:N) ]   component spline function SY        *
C  DY :  vector  DY(0:N) ]                                       *
C                            The elements in position N are      *
C                            auxiliary variables                 *
C  IERR :  error parameter                                       *
C          =  0 :  All is o.k                                    *
C          = -1 :  N < 5  (for IB = 1, 2, 3)                     *
C                  N < 6  (for IB =  4 )                         *
C          = -2 :  IB < 1  or  IB > 4                            *
C          = -3 :  Inadmissable weight WX or WY                  *
C          = -4 :  parameter values T(I) not ordered monotonical-*
C                  ly, i.e., T(I) >= T(I+1) for some I=0,..., N-1*
C          = -5 :  IB = 4 and FN(0) not equal to FN(N) or        *
C                  WX(0) not equal to WX(N) or                   *
C                  WY(0) not equal to WY(N)                      *
C          =  1 :  error in FDISY or NCYFSY (system matrix       *
C                  numerically singular)                         *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: CFSP1D, CFSP2D, CFSPPE, PSPPV           *
C                                                                *
C                                                                *
C  Reference : Engeln-Müllges, G.; Reutter, F., [ENGE87].        *
C                                                                *
C*****************************************************************
C                                                                *
C  Author   : Günter Palm                                        *
C  Date     : 04.18.1988                                         *
C  Source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION XN(0:N), FN(0:N), WX(0:N), WY(0:N), T(0:N),
     +                 AX(0:N), BX(0:N), CX(0:N), DX(0:N),
     +                 AY(0:N), BY(0:N), CY(0:N), DY(0:N),
     +                 ALPHA(2), BETA(2), AUXF(1:14*N-10)
C
C-----Check assumptions
C
      IERR = -1
      IF (N .LT. 5) RETURN
      IF (IB .LT. 1  .OR.  IB .GT. 4) THEN
        IERR = -2
        RETURN
      ENDIF
      IERR = -3
C
C-----Check or compute the weights
C
      IF (MW .GT. 1) THEN
C
C       Check the prescribed weights
C
        DO 10 I=0,N,1
          IF (WX(I) .LE. 0.0D0  .OR.  WY(I) .LE. 0.0D0) RETURN
   10   CONTINUE
        MREP = 1
      ELSE
        IF (MW .EQ. 1) THEN
C
C         Check the prescribed weights WY
C
          DO 20 I=0,N,1
            IF (WY(I) .LE. 0.0D0) RETURN
   20     CONTINUE
        ELSE
C
C         If not prescribed, assign 1.0 to all weights WY
C
          DO 30 I=0,N,1
            WY(I) = 1.0D0
   30     CONTINUE
        ENDIF
C
C       Set the weights  WX equal to the weights WY
C
        DO 40 I=0,N,1
          WX(I) = WY(I)
   40   CONTINUE
        MREP = 2
      ENDIF
C
C-----Compute and/or check the parameter values
C
      IF (MT .GT. 0) THEN
C
C       Compute the parameter values in subroutine PSPPV
C
        CALL PSPPV (N,XN,FN,T,MT,IERR)
        IF (IERR .NE. 0) THEN
          IERR = -4
          RETURN
        ENDIF
      ELSE
C
C       Check the prescribed parameter values
C
        IERR = -4
        DO 50 I=0,N-1,1
          IF (T(I+1) .LE. T(I)) RETURN
   50   CONTINUE
      ENDIF
C
C-----Compute the spline coefficients
C
      IF (IB .EQ. 1) THEN
        CALL CFSP1D (N,T,XN,WX,ALPHA(1),BETA(1),1,AX,BX,CX,DX,
     +               AUXF(1),AUXF(N+1),AUXF(2*N+1),AUXF(3*N+1),
     +               AUXF(4*N),AUXF(5*N-1),AUXF(6*N-2),IERR)
        IF (IERR .NE. 0) RETURN
        CALL CFSP1D (N,T,FN,WY,ALPHA(2),BETA(2),MREP,AY,BY,CY,DY,
     +               AUXF(1),AUXF(N+1),AUXF(2*N+1),AUXF(3*N+1),
     +               AUXF(4*N),AUXF(5*N-1),AUXF(6*N-2),IERR)
      ELSEIF (IB .EQ. 2) THEN
        CALL CFSP2D (N,T,XN,WX,ALPHA(1),BETA(1),1,AX,BX,CX,DX,
     +               AUXF(1),AUXF(N+1),AUXF(2*N+1),AUXF(3*N+1),
     +               AUXF(4*N),AUXF(5*N-1),AUXF(6*N-2),IERR)
        IF (IERR .NE. 0) RETURN
        CALL CFSP2D (N,T,FN,WY,ALPHA(2),BETA(2),MREP,AY,BY,CY,DY,
     +               AUXF(1),AUXF(N+1),AUXF(2*N+1),AUXF(3*N+1),
     +               AUXF(4*N),AUXF(5*N-1),AUXF(6*N-2),IERR)
      ELSEIF (IB .EQ. 3) THEN
C
C       Compute the tangent vectors of the first derivatives
C       for SX and SY
C
        UB = 1.0D10
        IF (DABS(ALPHA(1)) .GE. UB) THEN
          ALPHAX = 0.0D0
          ALPHAY = DSIGN(1.0D0,FN(1)-FN(0))
        ELSE
          ROOT   = DSQRT(1.0D0/(1.0D0 + ALPHA(1)*ALPHA(1)))
          ALPHAX = DSIGN(ROOT,XN(1)-XN(0))
          ALPHAY = ALPHAX*ALPHA(1)
        ENDIF
        IF (DABS(BETA(1)) .GE. UB) THEN
          BETAX = 0.0D0
          BETAY = DSIGN(1.0D0,FN(N)-FN(N-1))
        ELSE
          ROOT  = DSQRT(1.0D0/(1.0D0 + BETA(1)*BETA(1)))
          BETAX = DSIGN(ROOT,XN(N)-XN(N-1))
          BETAY = BETAX*BETA(1)
        ENDIF
        CALL CFSP1D (N,T,XN,WX,ALPHAX,BETAX,1,AX,BX,CX,DX,
     +               AUXF(1),AUXF(N+1),AUXF(2*N+1),AUXF(3*N+1),
     +               AUXF(4*N),AUXF(5*N-1),AUXF(6*N-2),IERR)
        IF (IERR .NE. 0) RETURN
        CALL CFSP1D (N,T,FN,WY,ALPHAY,BETAY,MREP,AY,BY,CY,DY,
     +               AUXF(1),AUXF(N+1),AUXF(2*N+1),AUXF(3*N+1),
     +               AUXF(4*N),AUXF(5*N-1),AUXF(6*N-2),IERR)
      ELSE
        IERR = -1
        IF (N .LT. 6) RETURN
        CALL CFSPPE (N,T,XN,WX,1,AX,BX,CX,DX,AUXF(1),AUXF(N+2),
     +               AUXF(2*N+3),AUXF(3*N+4),AUXF(4*N+5),
     +               AUXF(5*N+5),IERR)
        IF (IERR .NE. 0) RETURN
        CALL CFSPPE (N,T,FN,WY,MREP,AY,BY,CY,DY,AUXF(1),AUXF(N+2),
     +               AUXF(2*N+3),AUXF(3*N+4),AUXF(4*N+5),
     +               AUXF(5*N+5),IERR)
      ENDIF
      RETURN
      END


Begin of file
Contents
Index