File: POLY1.FT of Tape: Various/ETH/eth11-1
(Source file text)
C POLY1.FTN - A PROGRAM TO TEST THE FOLLOWING SUBROUTINES:
C PADDM - ADD A CONSTANT TIMES ONE POLYNOMIAL TO ANOTHER
C PDER - DERIVATIVE OF A POLYNOMIAL
C PDIV - DIVIDE ONE POLYNOMIAL BY ANOTHER
C PINT - INDEFINITE INTEGRAL OF A POLYNOMIAL
C PMPY - MULTIPLY TWO POLYNOMIALS
C PNORM - NORMALIZE THE COEFFICIENT VECTOR OF A POLYNOMIAL
C PVAL - EVALUATE A POLYNOMIAL
C
DIMENSION F1(3),F2(4),F3(2),F4(5),F5(3),F6(4),F7(3)
DIMENSION WORK1(10)
C F1(X)=12X**2+2, F2(X)=X**3+4X**2+4, F3(X)=X
DATA F1/2.,0.,12./,F2/4.,0.,4.,1./,F3/0.,1./
C OUTPUT CHANNEL = IOUT
IOUT=2
WRITE(IOUT,99)
99 FORMAT(//' F1(X)=12X**2+2, F2(X)=X**3+4X**2+4, F3(X)=X'/)
C
C COMPUTE F4(X)=2*F3(X) * F2(X) + F1(X)
C
CALL PMPY(WORK1,IW1,F2,4,F3,2)
CALL PADDM(F4,IF4,F1,3,2.,WORK1,IW1)
WRITE(IOUT,100)
100 FORMAT(' F4(X)=2*F3(X)*F2(X)+F1(X)',3X,'(SHOULD BE 2*(X+1)**4)'/)
101 FORMAT(' COEFFICIENT OF X**',I1,' IS 'F10.4)
DO 1 I=1,IF4
IM1=I-1
1 WRITE(IOUT,101) IM1,F4(I)
C
C COMPUTE F5(X) = F4(X) / (X+1)**2
C
WORK1(1)=1
WORK1(2)=2
WORK1(3)=1
CALL PDIV(F5,IF5,F4,IF4,WORK1,3,1.E-4,IER)
WRITE(IOUT,102)
102 FORMAT(//' F5(X)=F4(X)/(X+1)**2',3X,' (SHOULD BE 2(X+1)**2)'/)
DO 2 I=1,IF5
IM1=I-1
2 WRITE(IOUT,101) IM1,F5(I)
WRITE(IOUT,103)
103 FORMAT(/' REMAINDER POLYNOMIAL (IF ANY)'/)
DO 3 I=1,IF4
IM1=I-1
3 WRITE(IOUT,101) IM1,F4(I)
C
C COMPUTE F6(X)=INDEFINITE INTEGRAL OF F5(X)
C
WRITE(IOUT,104)
104 FORMAT(//' F6(X)=INTEGRAL OF F5(X)',3X,'(SHOULD BE [2(X+1)**3]/3'/
1' CONSTANT TERM SHOULD BE ZERO'/)
CALL PINT(F6,IF6,F5,IF5)
DO 4 I=1,IF6
IM1=I-1
4 WRITE(IOUT,101) IM1,F6(I)
C
C COMPUTE AF6=DEFINITE INTEGRAL OF F5(X) FROM 1 TO 3
C
CALL PVAL(AF6,3.,F6,IF6)
CALL PVAL(TEMP,1.,F6,IF6)
AF6 = AF6 - TEMP
WRITE(IOUT,105) AF6
105 FORMAT(//' AF6=DEFINITE INTEGRAL OF F5(X) ON [1,3]'/
1' VALUE IS',E16.7)
C
C COMPUTE DERIVATIVE OF F2(X)
C
WRITE(IOUT,106)
106 FORMAT(//' DERIVATIVE OF X**3+4X**2+4'/)
CALL PDER(F7,IF7,F2,4)
DO 5 I=1,IF7
IM1=I-1
5 WRITE(IOUT,101) IM1,F7(I)
STOP
END