home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP2.ZIP / POLYOPS.ZIP / DPECN.FOR next >
Text File  |  1985-11-29  |  3KB  |  101 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE DPECN
  5. C
  6. C        PURPOSE
  7. C           ECONOMIZE A POLYNOMIAL FOR SYMMETRIC RANGE
  8. C
  9. C        USAGE
  10. C           CALL DPECN(P,N,BOUND,EPS,TOL,WORK)
  11. C
  12. C        DESCRIPTION OF PARAMETERS
  13. C           P     - DOUBLE PRECISION COEFFICIENT VECTOR OF GIVEN
  14. C                   POLYNOMIAL
  15. C                   ON RETURN P CONTAINS THE ECONOMIZED POLYNOMIAL
  16. C           N     - DIMENSION OF COEFFICIENT VECTOR P
  17. C                   ON RETURN N CONTAINS DIMENSION OF ECONOMIZED
  18. C                   POLYNOMIAL
  19. C           BOUND - SINGLE PRECISION RIGHT HAND BOUNDARY OF RANGE
  20. C           EPS   - SINGLE PRECISION INITIAL ERROR BOUND
  21. C                   ON RETURN EPS CONTAINS AN ERROR BOUND FOR THE
  22. C                   ECONOMIZED POLYNOMIAL
  23. C           TOL   - SINGLE PRECISION TOLERANCE FOR ERROR
  24. C                   FINAL VALUE OF EPS MUST BE LESS THAN TOL
  25. C           WORK  - DOUBLE PRECISION WORKING STORAGE OF DIMENSION N
  26. C                   (STARTING VALUE OF N RATHER THAN FINAL VALUE)
  27. C
  28. C        REMARKS
  29. C           THE OPERATION IS BYPASSED IN CASE OF N LESS THAN 1.
  30. C           IN CASE OF AN ARBITRARY INTERVAL (XL,XR) IT IS NECESSARY
  31. C           FIRST TO CALCULATE THE EXPANSION OF THE GIVEN POLYNOMIAL
  32. C           WITH ARGUMENT X IN POWERS OF T = (X-(XR-XL)/2).
  33. C           THIS IS ACCOMPLISHED THROUGH SUBROUTINE DPCLD.
  34. C
  35. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  36. C           NONE
  37. C
  38. C        METHOD
  39. C           SUBROUTINE DPECN TAKES AN (N-1)ST DEGREE POLYNOMIAL
  40. C           APPROXIMATION TO A FUNCTION F(X) VALID WITHIN A TOLERANCE
  41. C           EPS OVER THE INTERVAL (-BOUND,BOUND) AND REDUCES IT IF
  42. C           POSSIBLE TO A POLYNOMIAL OF LOWER DEGREE VALID WITHIN
  43. C           THE GIVEN TOLERANCE TOL.
  44. C           THE INITIAL COEFFICIENT VECTOR P IS REPLACED BY THE FINAL
  45. C           VECTOR. THE INITIAL ERROR BOUND EPS IS REPLACED BY A FINAL
  46. C           ERROR BOUND.
  47. C           N IS REPLACED BY THE DIMENSION OF THE REDUCED POLYNOMIAL.
  48. C           THE COEFFICIENT VECTOR OF THE N-TH CHEBYSHEV POLYNOMIAL
  49. C           IS CALCULATED FROM THE RECURSION FORMULA
  50. C           A(K-1)=-A(K+1)*K*L*L*(K-1)/((N+K-2)*(N-K+2))
  51. C           REFERENCE
  52. C           K. A. BRONS, ALGORITHM 38, TELESCOPE 2, CACM VOL. 4, 1961,
  53. C           NO. 3, PP. 151-152.
  54. C
  55. C     ..................................................................
  56. C
  57.       SUBROUTINE DPECN(P,N,BOUND,EPS,TOL,WORK)
  58. C
  59.       DIMENSION P(1),WORK(1)
  60.       DOUBLE PRECISION P,WORK
  61. C
  62.       FL=BOUND*BOUND
  63. C
  64. C        TEST OF DIMENSION
  65. C
  66.     1 IF(N-1)2,3,6
  67.     2 RETURN
  68. C
  69.     3 IF(EPS+ABS(SNGL(P(1)))-TOL)4,4,5
  70.     4 N=0
  71.       EPS=EPS+ABS(SNGL(P(1)))
  72.     5 RETURN
  73. C
  74. C        CALCULATE EXPANSION OF CHEBYSHEV POLYNOMIAL
  75. C
  76.     6 NEND=N-2
  77.       WORK(N)=-P(N)
  78.       DO 7 J=1,NEND,2
  79.       K=N-J
  80.       FN=(NEND-1+K)*(NEND+3-K)
  81.       FK=K*(K-1)
  82.     7 WORK(K-1)=-WORK(K+1)*DBLE(FK*FL/FN)
  83. C
  84. C        TEST FOR FEASIBILITY OF REDUCTION
  85. C
  86.       IF(K-2)8,8,9
  87.     8 FN=DABS(WORK(1))
  88.       GOTO 10
  89.     9 FN=N-1
  90.       FN=ABS(SNGL(WORK(2))/FN)
  91.    10 IF(EPS+FN-TOL)11,11,5
  92. C
  93. C        REDUCE POLYNOMIAL
  94. C
  95.    11 EPS=EPS+FN
  96.       N=N-1
  97.       DO 12 J=K,N,2
  98.    12 P(J-1)=P(J-1)+WORK(J-1)
  99.       GOTO 1
  100.       END
  101.