End of file
Contents
Index



F 9.7 Rational Interpolation


      SUBROUTINE RALGIP(X,A,N,L,L1,IERR,NLEFT,Z)
C
C*****************************************************************
C                                                                *
C     Rational Lagrange interpolation. The interpolation         *
C     function defined by the nodes X1, X2, X3, ...  and the     *
C     functional values is the ratio of two polynomials. The     *
C     degree of the nominator polynomial can be chosen by the    *
C     user.                                                      *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     X      : (N+1)-vector X(0:N); the nodes X(I) for I=0,...,N *
C     A      : (N+1)-vector A(0:N); the functional values at     *
C              the nodes  X(I)                                   *
C     N      : largest index used for the nodes                  *
C     L      : degree of the denominator polynomial; L < N       *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     X      : as above, but possibly reordered                  *
C     A      : (N+1)-vector A(0:N); the coefficients of the      *
C              rational interpolation function                   *
C     L1     : (N+1)-vector L1(0:N); contains information about  *
C              the coefficients. This is needed for use in the   *
C              FUNCTION RLIFCT.                                  *
C     IERR   : = 0  everything o.k.                              *
C              = 1  problem not solvable (check the nodes)       *
C     NLEFT  : final index of the nodes for which we still have  *
C              to interpolate                                    *
C                                                                *
C                                                                *
C     AUXILIARY VARIABLES:                                       *
C     ====================                                       *
C     Z      : N-vector Z(0:N-1)                                 *
C                                                                *
C     The interpolating function has the continued fraction form:*
C                                                                *
C     F(X) =  A(N)  +                                            *
C                                                                *
C             + (X-X(N)) * A(N-1) +                              *
C                                                                *
C                          (X-X(N)) * (X-X(N-1))                 *
C             + ------------------------------------------------ *
C                                          (X-X(N-2))*(X-X(N-3)) *
C               A(N-2) + (X-X(N-2))*A(N-3)+--------------------- *
C                                          A(N-4)  +   . . .     *
C                                                                *
C     F(X) can be evaluated using the FUNCTION RLIFCT.           *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: RLIFCT, RLIORD                          *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Helmut Werner                                      *
C  editor   : Christiane Beer                                    *
C  date     : 1983                                               *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION X(0:N),A(0:N),Z(0:N-1)
      INTEGER L1(0:N)
      IERR=0
      EPS=1.0D-11
C
C     determine the degree of the denominator polynomial
C
      L2=L
      M1=N-L
      NLEFT=N
      IF(M1 .LE. 0) THEN
         IERR=1
         RETURN
      ENDIF
C
C     the degree of the numerator polynomial exceeds that of the denominator:
C     a number of nodes equal to the difference between the denominator and
C     the numerator degree is interpolated by forming divided differences
C
  100 DO 10  K=1,(L2-M1)
         CALL RLIORD(X,A,NLEFT,XJ,AJ)
         DO 20  I=0,NLEFT-1
C
C   stop if two nodes are identical
C
            IF((X(I)-XJ) .EQ. 0.0D0) THEN
               IERR=1
               RETURN
            ENDIF
            A(I)=(A(I)-AJ)/(X(I)-XJ)
   20    CONTINUE
         L1(NLEFT-1)=1
         NLEFT=NLEFT-1
   10 CONTINUE
      IF(NLEFT .LT. 0) GOTO 200
C
C   the subsequent node is interpolated by forming
C   inverse divided differences
C
      CALL RLIORD (X,A,NLEFT,XJ,AJ)
      I1=0
      DO 30  I=0,NLEFT-1
         A2=A(I)-AJ
         X2=X(I)-XJ
C
C   test for automatically interpolated nodes
C
         IF(DABS(A2) .LE. DABS(X2)*EPS) THEN
            Z(I1)=X(I)
            I1=I1+1
         ELSE
            A(I-I1)=X2/A2
            X(I-I1)=X(I)
         ENDIF
   30 CONTINUE
C
C   automatically interpolated nodes are included in the
C   divided differences
C
      DO 40  K=0,I1-1
         X(NLEFT-1)=Z(K)
         A(NLEFT-1)=0.0D0
         DO 50  I=0,NLEFT-1
            A(I)=A(I)*(X(I)-X(NLEFT))
   50    CONTINUE
         L1(NLEFT-1)=1
         NLEFT=NLEFT-1
   40 CONTINUE
C
C   determine the degrees of the factors of the interpolating
C   rational function that still must be determined
C
      IF(NLEFT .GT. 0) THEN
         NLEFT=NLEFT-1
         L1(NLEFT)=-1
         L2=M1
         M1=NLEFT-L2
      ENDIF
  200 IF(M1 .LT. 0) THEN
         IERR=1
         RETURN
      ENDIF
C
C   check whether interpolation is complete
C
      IF(NLEFT .GT. 0) GOTO 100
C
C   finish interpolation
C   The following tests whether all nodes have been
C   used in the interpolation
C
      FM=DABS(A(N))
      DO 60  I=0,N-1
         FM=FM+DABS(A(I))
   60 CONTINUE
      K=0
      DO 70  I=0,N-1
         IF(L1(I) .LT. 0) K=I+1
         IF(K .NE. 0) THEN
            F=RLIFCT(X(I+1),X,A,L1,I)
            IF(DABS(F) .LE. FM*EPS) THEN
               IERR=1
               RETURN
            ENDIF
         ENDIF
   70 CONTINUE
      RETURN
      END
C
C

      DOUBLE PRECISION FUNCTION RLIFCT(XW,X,A,L1,N)
C
C*****************************************************************
C                                                                *
C     Evaluate the rational interpolation function               *
C     (see SUBROUTINE RALGIP)                                    *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     XW     : point where the rational interpolation function   *
C              is to be evaluated                                *
C     X      : (N+1)-vector X(0:N); the nodes, I=0,...,N         *
C     A      : (N+1)-vector A(0:N); the coefficients of the      *
C              rational interpolating function                   *
C     L1     : (N+1)-vector L1(0:N); labels indicating whether   *
C              we need to divide or mulptiply after evaluation   *
C              of a Horner scheme                                *
C     N      : final index of the nodes                          *
C                                                                *
C                                                                *
C     OUTPUT PARAMETER:                                          *
C     =================                                          *
C     RLIFCT : functional value at XW                            *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Helmut Werner                                      *
C  editor   : Christiane Beer                                    *
C  date     : 1983                                               *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION X(0:N),A(0:N)
      INTEGER L1(0:N)
      F=A(0)
      DO 10  I=1,N
         IF(L1(I-1) .GE. 0) THEN
            F=A(I)+(XW-X(I))*F
         ELSE
            F=A(I)+(XW-X(I))/F
         ENDIF
   10 CONTINUE
      RLIFCT=F
      RETURN
      END
C
C

      SUBROUTINE RLIORD (X,A,N,XJ,AJ)
C
C*****************************************************************
C                                                                *
C     Determines the functional value of least magnitude         *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     X      : (N+1)-vector X(0:N); the nodes X(I), I=0,...,N    *
C     A      : (N+1)-vector A(0:N); the functional values at X(I)*
C     N      : final index of the nodes                          *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     X      : as above, permutation of the node to be           *
C              interpolated next with the last one used          *
C     A      : see above, swap A(I) analogous to the X(I)        *
C     XJ     : node with the functional value of smallest        *
C              magnitude                                         *
C     AJ     : largest absolute functional value                 *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Helmut Werner                                      *
C  editor   : Christiane Beer                                    *
C  date     : 1983                                               *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION X(0:N), A(0:N)
      AJ=A(N)
      J1=N
      DO 10 I=0,N-1
         IF(DABS(AJ) .GT. DABS(A(I))) THEN
            J1=I
            AJ=A(I)
         ENDIF
   10 CONTINUE
      XJ=X(J1)
      X(J1)=X(N)
      A(J1)=A(N)
      X(N)=XJ
      A(N)=AJ
      RETURN
      END


Begin of file
Contents
Index