Mercurial > octave-nkf
view libcruft/villad/intrp.f @ 5210:996a08a3eb06 ss-2-9-0
[project @ 2005-03-15 20:46:03 by jwe]
author | jwe |
---|---|
date | Tue, 15 Mar 2005 20:46:03 +0000 |
parents | 30c606bec7a8 |
children |
line wrap: on
line source
SUBROUTINE INTRP ( ND, NT, X, ROOT, DIF1, XINTP ) C INTEGER ND, NT DOUBLE PRECISION ROOT(ND), DIF1(ND), XINTP(ND) C C*********************************************************************** C C LAGRANGE INTERPOLATION C C VILLADSEN AND MICHELSEN, PAGES 132-133, 420 C C INPUT PARAMETERS: C C NT : THE TOTAL NUMBER OF INTERPOLATION POINTS FOR WHICH THE C VALUE OF THE DEPENDENT VARIABLE Y IS KNOWN. NOTE: C C NT = N + N0 + N1 C C X : THE ABCISSA X WHERE Y(X) IS DESIRED C C ROOT : ONE DIMENSIONAL VECTOR CONTAINING ON EXIT THE C N + N0 + N1 ZEROS OF THE NODE POLYNOMIAL USED IN THE C INTERPOLATION ROUTINE C C DIF1 : ONE DIMENSIONAL VECTOR CONTAINING THE FIRST DERIVATIVE C OF THE NODE POLYNOMIAL AT THE ZEROS C C OUTPUT PARAMETERS: C C XINTP : THE VECTOR OF INTERPOLATION WEIGHTS C C Y(X) IS GIVEN BY: C C NT C Y(X) = SUM XINTRP(I) * Y(I) C I=1 C C COMMON BLOCKS: NONE C C REQUIRED ROUTINES: VILERR C C*********************************************************************** C INTEGER I,IER DOUBLE PRECISION POL,Y,X DOUBLE PRECISION ZERO,ONE LOGICAL LSTOP C PARAMETER ( ZERO = 0.0D+00, ONE = 1.0D+00 ) C C -- ERROR CHECKING C IF (ND .LT. NT) THEN IER = 3 LSTOP = .TRUE. CALL VILERR(IER,LSTOP) ELSE END IF C IF (NT .LT. 1) THEN IER = 7 LSTOP = .TRUE. CALL VILERR(IER,LSTOP) ELSE END IF C C -- EVALUATE LAGRANGIAN INTERPOLATION COEFFICIENTS C POL = ONE C DO 5 I = 1,NT C Y = X - ROOT(I) XINTP(I) = ZERO C IF (Y .EQ. ZERO) THEN XINTP(I) = ONE ELSE END IF C POL = POL*Y C 5 CONTINUE C IF (POL .NE. ZERO) THEN DO 6 I = 1,NT XINTP(I) = POL/DIF1(I)/(X - ROOT(I)) 6 CONTINUE ELSE END IF C RETURN END