End of file
Contents
Index
SUBROUTINE CFSP2D (N,XN,FN,W,ALPHA,BETA,MREP,A,B,C,D,
+ H,H1,H2,DM,DU1,DU2,RS,IERR)
C
C*****************************************************************
C *
C CFSP2D 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 second 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: CFSP2D should not be called directly, but rather via *
C ======= the subroutine CFSPNP, or in case of parametric *
C splines via the subroutine CFSPPA. The subroutines *
C CFSPNP and CFSPPA also check 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 : second end point derivative at XN(0) *
C BETA : second end point derivative at XN(N) *
C *
C (For ALPHA = BETA = 0.0 one will obtain a natural *
C fitting spline.) *
C *
C MREP : indicator used for repeated call of the subroutine: *
C MREP = 1: The system matrix elements must be computed*
C This matrix must be factored via subroutine*
C FDISY in order to find C(I). *
C MREP = 2: The right-hand side only needs to be com- *
C puted. We can use the vectors DM, DU1 and *
C DU2 computed during the first pass of sub- *
C routine FDISYS to find the solution. *
C This avoids a repeat factorization in case *
C of parametric splines. *
C The elements in H, H1, H2, DM, DU1 and DU2 *
C must not be altered after the first call. *
C REMARK: For parametric splines with differing weights WX(I) *
C not equal to WY(I) for at least one index I, one *
C must work with MREP = 1. *
C *
C *
C AUXILIARY VARIABLES: *
C ==================== *
C H :] *
C H1 :] N-vectors H(0:N-1), H1(0:N-1), H2(0:N-1) *
C H2 :] *
C *
C DM :] *
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 : FDISY did not run correctly (matrix singular) *
C = -6 : Wrong input for MREP *
C *
C----------------------------------------------------------------*
C *
C required subroutines: FDISY, FDISYS *
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), H(0:N-1), H1(0:N-1),
+ H2(0:N-1), DM(1:N-1), DU1(1:N-1),
+ DU2(1:N-1), RS(1:N-1)
C
C-----Check MREP for repeated calls
C
IERR = -6
IF (MREP .NE. 1 .AND. MREP .NE. 2) RETURN
C
C-----Compute auxiliary values and system matrix elements
C i.e., its main and two co-diagonals, if in the first pass
C
IF (MREP .EQ. 1) THEN
C
C 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
H2(I) = H1(I) + H1(I+1)
20 CONTINUE
C
C second co-diagonal
C
DO 30 I=1,N-3,1
DU2(I) = B(I+1)*H1(I)*H1(I+1)
30 CONTINUE
C
C first co-diagonal
C
DO 40 I=1,N-2,1
DU1(I) = H(I) - B(I)*H1(I)*H2(I-1) -B(I+1)*H1(I)*H2(I)
40 CONTINUE
C
C main diagonal
C
DO 50 I=1,N-1,1
K = I-1
DM(I) = 2.0D0*(H(K)+H(I)) + B(K)*C(K) +
+ B(I)*H2(K)*H2(K) + B(I+1)*C(I)
50 CONTINUE
ENDIF
C
C-----Compute the 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) -
+ 6.0D0/W(0)*H1(0)*H1(0) - 6.0D0/W(1)*H1(0)*H2(0))
RS(2) = 3.0D0*(DUMMY1 - DUMMY2) - C(0)*(6.0D0/W(1))*H1(0)*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)*(6.0D0/W(N-1))*H1(N-2)*H1(N-1)
RS(N-1) = 3.0D0*((FN(N) - FN(N-1))*H1(N-1) - DUMMY2) - C(N)*
+ (H(N-1)-6.0D0/W(N-1)*H1(N-1)*H2(N-2)-6.0D0/W(N)*C(N))
C
C-----Compute the coefficients C(1) to C(N-1) from
C the system of equations
C
IF (MREP .EQ. 1) THEN
C
C In case we must decompose the system matrix
C
CALL FDISY (N-1,DM,DU1,DU2,RS,C(1),IFLAG)
IF (IFLAG .NE. 1) THEN
IF (IFLAG .EQ. -2) THEN
IERR = -1
ELSE
IERR = 1
ENDIF
RETURN
ENDIF
ELSE
C
C When no factorization is necessary
C
CALL FDISYS (N-1,DM,DU1,DU2,RS,C(1))
ENDIF
IERR = 0
C
C-----Compute the remaining spline coefficients
C
A(0) = FN(0) + 2.0D0/W(0)*H1(0)*(C(0)-C(1))
DO 70 I=1,N-1,1
A(I) = FN(I) - 2.0D0/W(I)*(C(I-1)*H1(I-1) - H2(I-1)*C(I) +
+ C(I+1)*H1(I))
70 CONTINUE
A(N) = FN(N) - 2.0D0/W(N)*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