view libcruft/villad/dif.f @ 7948:af10baa63915 ss-3-1-50

3.1.50 snapshot
author John W. Eaton <jwe@octave.org>
date Fri, 18 Jul 2008 17:42:48 -0400
parents 30c606bec7a8
children
line wrap: on
line source

      SUBROUTINE DIF ( NT, ROOT, DIF1, DIF2, DIF3 )
C
      INTEGER           NT
      DOUBLE PRECISION  ROOT(NT), DIF1(NT), DIF2(NT), DIF3(NT)

C
C***********************************************************************
C
C     SUBROUTINE DIF
C
C     THIS ROUTINE IS NOT GIVEN SEPARATELY BY VILLADSEN AND MICHELSEN
C     BUT AS PART OF JCOBI
C
C     DIF COMPUTES THE FIRST THREE DERIVATIVES OF THE NODE POLYNOMIAL
C
C                     N0     (ALPHA,BETA)           N1
C       P  (X)  =  (X)   *  P (X)         *  (1 - X)
C        NT                   N
C
C     AT THE INTERPOLATION POINTS.  EACH OF THE PARAMETERS N0 AND N1
C     MAY BE GIVEN THE VALUE 0 OR 1.  NT = N + N0 + N1
C
C     THE VALUES OF ROOT MUST BE KNOWN BEFORE A CALL TO DIF IS POSSIBLE.
C     THEY MAY BE COMPUTED USING JCOBI.
C
C     PARAMETER LIST:     SEE THE SUBROUTINE JCOBI
C
C     COMMON BLOCKS:      NONE
C
C     REQUIRED ROUTINES:  VILERR
C
C***********************************************************************
C
      INTEGER           I,J,IER
      DOUBLE PRECISION  X,Y
      DOUBLE PRECISION  ZERO,ONE,TWO,THREE
      LOGICAL           LSTOP
C
      PARAMETER ( ZERO = 0.0D+00, ONE   = 1.0D+00,
     +            TWO  = 2.0D+00, THREE = 3.0D+00 )
C
C -- ERROR CHECKING
C
      IF (NT .LT. 1) THEN
        IER   = 7
        LSTOP = .TRUE.
        CALL VILERR(IER,LSTOP)
      ELSE
      END IF
C
C -- EVALUATE DERIVATIVES OF NODE POLYNOMIAL USING RECURSION FORMULAS
C
      DO 40 I = 1,NT
C
        X       = ROOT(I)
        DIF1(I) = ONE
        DIF2(I) = ZERO
        DIF3(I) = ZERO
C
        DO 30 J = 1,NT
C
          IF (J .NE. I) THEN
            Y       = X - ROOT(J)
            DIF3(I) = Y*DIF3(I) + THREE*DIF2(I)
            DIF2(I) = Y*DIF2(I) + TWO  *DIF1(I)
            DIF1(I) = Y*DIF1(I)
          ELSE
          END IF
C
   30   CONTINUE
   40 CONTINUE
C
      RETURN
      END