End of file
Contents
Index

      SUBROUTINE CFSP3D (N,XN,FN,W,ALPHA,BETA,A,B,C,D,DL1,DL2,
     +                   DU1,DU2,RS,H1,H,IERR)
C
C*****************************************************************
C                                                                *
C  CFSP3D computes the coefficients A(I), B(I), C(I), D(I),      *
C  I=0, 1. ..., N-1, of a cubic fitting spline with prescribed   *
C  third end point derivative.                                   *
C  The spline is represented in the form:                        *
C                                                                *
C  S(X) = A(I) + B(I)(X-XN(I)) + C(I)(X-XN(I))**2 +              *
C                              + D(I)(X-XN(I))**3                *
C                                                                *
C  for X in the interval [XN(I),XN(I+1)], I=0, 1, ..., N-1.      *
C                                                                *
C                                                                *
C  ASSUMPTIONS:    1.         N > 4                              *
C  ============    2.     XN(I) < XN(I+1), I=0, 1, ..., N-1      *
C                  3.      W(I) > 0.0    , I=0, 1, ..., N        *
C                                                                *
C                                                                *
C  REMARK:  CFSP3D should not be called directly, but rather via *
C  =======  the subroutine CFSPNP. The subroutine CFSPNP also    *
C           checks the above assumptions.                        *
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  W  :  vector W(0:N);  W(I) is the weight of FN(I)             *
C                                                                *
C  ALPHA :  third end point derivative at XN(0)                  *
C  BETA  :  third end point derivative at XN(N)                  *
C                                                                *
C                                                                *
C  AUXILIARY VARIABLES:                                          *
C  ====================                                          *
C  H   :]                                                        *
C  H1  :]  N-vectors H(0:N-1), H1(0:N-1)                         *
C                                                                *
C  DL1 :]                                                        *
C  DL2 :]                                                        *
C  DU1 :]  (N-1)-vectors dimensioned as  ..(1:N-1)               *
C  DU2 :]                                                        *
C  RS  :]                                                        *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  A    :  Vector A(0:N) ]  The entries in positions 0 to N-1    *
C  B    :  Vector B(0:N) ]  contain the spline coefficients for  *
C  C    :  Vector C(0:N) ]  S. The entries in A(N), B(N), C(N)   *
C  D    :  Vector D(0:N) ]  and D(N) are auxiliary variables.    *
C                                                                *
C  IERR :  error parameter                                       *
C          =  0 :  All is o.k.                                   *
C          = -1 :  N < 5                                         *
C          =  1 :  FDIAG did not run correctly (matrix singular) *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  required subroutines: FDIAG                                   *
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), W(0:N), A(0:N), B(0:N),
     +                 C(0:N), D(0:N), DL1(1:N-1), DL2(1:N-1),
     +                 DU1(1:N-1), DU2(1:N-1), RS(1:N-1),
     +                 H1(0:N-1), H(0:N-1)
C
C-----Computing the auxiliary variables
C
      DO 10 I=0,N-1,1
        H(I)  = XN(I+1) - XN(I)
        H1(I) = 1.0D0/H(I)
        C(I)  = H1(I)*H1(I)
        B(I)  = 6.0D0/W(I)
   10 CONTINUE
      B(N) = 6.0D0/W(N)
C
      DO 20 I=0,N-2,1
        D(I) = H1(I) + H1(I+1)
   20 CONTINUE
C
C-----Compute the system matrix elements (main and two co-diagonals)
C     and the right-hand side for  A*C=RS with a five-diagonal matrix A.
C
C     second co-diagonal
C
      DO 30 I=3,N-1,1
        DL2(I)   = B(I-1)*H1(I-2)*H1(I-1)
        DU2(I-2) = DL2(I)
   30 CONTINUE
C
C     first co-diagonal
C
      DUMMY1 = H(1) - B(2)*H1(1)*D(1)
      DL1(2) = DUMMY1 - B(1)*C(1)
      DU1(1) = DUMMY1 - B(1)*H1(1)*D(0)
      DO 40 I=3,N-2,1
        K = I-1
        DL1(I) = H(K) - B(K)*H1(K)*D(K-1) - B(I)*H1(K)*D(K)
        DU1(K) = DL1(I)
   40 CONTINUE
      DUMMY1   = H(N-2) - B(N-2)*H1(N-2)*D(N-3)
      DL1(N-1) = DUMMY1 - B(N-1)*H1(N-2)*D(N-2)
      DU1(N-2) = DUMMY1 - B(N-1)*C(N-2)
C
C     main diagonal
C
      A(1) = 3.0D0*H(0) + 2.0D0*H(1) + B(1)*H1(1)*D(0) + B(2)*C(1)
      DO 50 I=2,N-2,1
        K = I-1
        A(I) = 2.0D0*(H(K)+H(I)) + B(K)*C(K) + B(I)*D(K)*D(K) +
     +         B(I+1)*C(I)
   50 CONTINUE
      A(N-1) = 2.0D0*H(N-2) + 3.0D0*H(N-1) + B(N-2)*C(N-2) +
     +         B(N-1)*H1(N-2)*D(N-2)
C
C     right-hand side
C
      C(0) = 0.5D0*ALPHA
      C(N) = 0.5D0*BETA
C
      DUMMY2 = (FN(2)-FN(1))*H1(1)
      DUMMY1 = (FN(3)-FN(2))*H1(2)
      RS(1)  = 3.0D0*(DUMMY2 - (FN(1)-FN(0))*H1(0)) +
     +         C(0)*(H(0)*H(0) - B(0)*H1(0) - B(1)*D(0))
      RS(2)  = 3.0D0*(DUMMY1 - DUMMY2) + C(0)*B(1)*H1(1)
      DO 60 I=3,N-3,1
        DUMMY2 = (FN(I+1) - FN(I)) * H1(I)
        RS(I)  = 3.0D0*(DUMMY2 - DUMMY1)
        DUMMY1 = DUMMY2
   60 CONTINUE
      DUMMY2  = (FN(N-1) - FN(N-2))*H1(N-2)
      RS(N-2) = 3.0D0*(DUMMY2 - DUMMY1) - C(N)*B(N-1)*H1(N-2)
      RS(N-1) = 3.0D0*((FN(N) - FN(N-1))*H1(N-1) - DUMMY2) - C(N)*
     +          (H(N-1)*H(N-1) - B(N-1)*D(N-2) - B(N)*H1(N-1))
C
C-----Compute the coefficients C(1) to C(N-1) by
C     solving the linear system
C
      CALL FDIAG (N-1,DL2,DL1,A(1),DU1,DU2,RS,C(1),IFLAG)
      IF (IFLAG .NE. 1) THEN
        IF (IFLAG .EQ. 0) THEN
          IERR = 1
        ELSE
          IERR = -1
        ENDIF
        RETURN
      ENDIF
      IERR = 0
C
C-----Computing the remaining spline coefficients
C
      C(0) = C(1) - C(0)*H(0)
      C(N) = C(N-1) + C(N)*H(N-1)
C
      A(0) = FN(0) + B(0)/3.0D0*H1(0)*(C(0)-C(1))
      DO 70 I=1,N-1,1
        A(I) = FN(I) - B(I)/3.0D0*(C(I-1)*H1(I-1) - D(I-1)*C(I) +
     +         C(I+1)*H1(I))
   70 CONTINUE
      A(N) = FN(N) - B(N)/3.0D0*H1(N-1)*(C(N-1)-C(N))
C
      DO 80 I=0,N-1,1
        B(I) = H1(I)*(A(I+1)-A(I)) -
     +         H(I)/3.0D0*(C(I+1)+2.0D0*C(I))
        D(I) = H1(I)/3.0D0*(C(I+1)-C(I))
   80 CONTINUE
      RETURN
      END


Begin of file
Contents
Index