home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP1.ZIP / ITRPAPSM.ZIP / DFRAT.FOR < prev    next >
Text File  |  1985-11-29  |  3KB  |  105 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE DFRAT
  5. C
  6. C        PURPOSE
  7. C           DFRAT IS USED FOR HANDLING OF DATA AND FUNDAMENTAL FUNCTIONS
  8. C           WITH RATIONAL APPROXIMATION. IT IS A SUBSTANTIAL PART OF
  9. C           RATIONAL APPROXIMATION AND HAS NO MEANING INDEPENDENTLY
  10. C
  11. C        USAGE
  12. C           CALL DFRAT(I,N,M,P,DATI,WGT,IER)
  13. C
  14. C        DESCRIPTION OF PARAMETERS
  15. C           I     - SUBSCRIPT OF CURRENT DATA POINT
  16. C           N     - NUMBER OF ALL DATA POINTS
  17. C           M     - NUMBER OF FUNDAMENTAL FUNCTIONS USED
  18. C           P     - ARRAY OF DIMENSION M+1 AT LEAST, WHICH CONTAINS
  19. C                   ON RETURN THE VALUES OF THE M FUNDAMENTAL
  20. C                   FUNCTIONS, FOLLOWED BY CURRENT FUNCTION VALUE
  21. C                   P MUST BE OF DOUBLE PRECISION
  22. C           DATI  - ARRAY CONTAINING GIVEN N ARGUMENTS, FOLLOWED
  23. C                   BY N FUNCTION VALUES AND FINALLY BY 1 RESPECTIVELY
  24. C                   N WEIGHT VALUES
  25. C                   DATI MUST BE OF DOUBLE PRECISION
  26. C           WGT   - RESULTANT WEIGHT FACTOR USED FOR I-TH TERM
  27. C                   WGT MUST BE OF DOUBLE PRECISION
  28. C           IER   - RESULTANT ERROR PARAMETER, COMBINED WITH INPUT
  29. C                   VALUES FOR CONTROL
  30. C                   IER(2) MEANS DIMENSION OF NUMERATOR
  31. C                   IER(3) MEANS DIMENSION OF DENOMINATOR
  32. C                   IER(1) IS USED AS RESULTANT ERROR PARAMETER,
  33. C                   IER(1) = 0 IN CASE OF NO ERRORS
  34. C                   IER(1) = 1 OTHERWISE (ZERO DENOMINATOR)
  35. C
  36. C        REMARKS
  37. C           VECTOR IER IS USED FOR COMMUNICATION BETWEEN DARAT AND DFRAT
  38. C
  39. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  40. C           DCNP
  41. C
  42. C        METHOD
  43. C           CF. MATHEMATICAL DESCRIPTION OF SUBROUTINE ARAT
  44. C
  45. C     ..................................................................
  46. C
  47.       SUBROUTINE DFRAT(I,N,M,P,DATI,WGT,IER)
  48. C
  49. C
  50. C        DIMENSIONED DUMMY VARIABLES
  51.       DIMENSION P(1),DATI(1),IER(1)
  52.       DOUBLE PRECISION P,DATI,WGT,T,F,FNUM,FDEN
  53. C
  54. C        INITIALIZATION
  55.       IP=IER(2)
  56.       IQ=IER(3)
  57.       IQM1=IQ-1
  58.       IPQ=IP+IQ
  59. C
  60. C        LOOK UP ARGUMENT, FUNCTION VALUE AND WEIGHT
  61. C        LOOK UP NUMERATOR AND DENOMINATOR
  62.       T=DATI(I)
  63.       J=I+N
  64.       F=DATI(J)
  65.       FNUM=P(J)
  66.       J=J+N
  67.       WGT=1.D0
  68.       IF(DATI(2*N+1))2,2,1
  69.     1 WGT=DATI(J)
  70.     2 FDEN=P(J)
  71. C
  72. C        CALCULATE FUNCTION VALUE USED
  73.       F=F*FDEN-FNUM
  74. C
  75. C        CHECK FOR ZERO DENOMINATOR
  76.       IF(FDEN)4,3,4
  77. C
  78. C        ERROR RETURN IN CASE OF ZERO DENOMINATOR
  79.     3 IER(1)=1
  80.       RETURN
  81. C
  82. C        CALCULATE WEIGHT FACTORS USED
  83.     4 WGT=WGT/(FDEN*FDEN)
  84.       FNUM=-FNUM/FDEN
  85. C
  86. C        CALCULATE FUNDAMENTAL FUNCTIONS
  87.       J=IQM1
  88.       IF(IP-IQ)6,6,5
  89.     5 J=IP-1
  90.     6 CALL DCNP(P(IQ),T,J)
  91. C
  92. C        STORE VALUES OF DENOMINATOR FUNDAMENTAL FUNCTIONS
  93.     7 IF(IQM1)10,10,8
  94.     8 DO 9 II=1,IQM1
  95.       J=II+IQ
  96.     9 P(II)=P(J)*FNUM
  97. C
  98. C        STORE FUNCTION VALUE
  99.    10 P(IPQ)=F
  100. C
  101. C        NORMAL RETURN
  102.       IER(1)=0
  103.       RETURN
  104.       END
  105.