dqmomo.f 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137
  1. *DECK DQMOMO
  2. SUBROUTINE DQMOMO (ALFA, BETA, RI, RJ, RG, RH, INTEGR)
  3. C***BEGIN PROLOGUE DQMOMO
  4. C***PURPOSE This routine computes modified Chebyshev moments. The K-th
  5. C modified Chebyshev moment is defined as the integral over
  6. C (-1,1) of W(X)*T(K,X), where T(K,X) is the Chebyshev
  7. C polynomial of degree K.
  8. C***LIBRARY SLATEC (QUADPACK)
  9. C***CATEGORY H2A2A1, C3A2
  10. C***TYPE DOUBLE PRECISION (QMOMO-S, DQMOMO-D)
  11. C***KEYWORDS MODIFIED CHEBYSHEV MOMENTS, QUADPACK, QUADRATURE
  12. C***AUTHOR Piessens, Robert
  13. C Applied Mathematics and Programming Division
  14. C K. U. Leuven
  15. C de Doncker, Elise
  16. C Applied Mathematics and Programming Division
  17. C K. U. Leuven
  18. C***DESCRIPTION
  19. C
  20. C MODIFIED CHEBYSHEV MOMENTS
  21. C STANDARD FORTRAN SUBROUTINE
  22. C DOUBLE PRECISION VERSION
  23. C
  24. C PARAMETERS
  25. C ALFA - Double precision
  26. C Parameter in the weight function W(X), ALFA.GT.(-1)
  27. C
  28. C BETA - Double precision
  29. C Parameter in the weight function W(X), BETA.GT.(-1)
  30. C
  31. C RI - Double precision
  32. C Vector of dimension 25
  33. C RI(K) is the integral over (-1,1) of
  34. C (1+X)**ALFA*T(K-1,X), K = 1, ..., 25.
  35. C
  36. C RJ - Double precision
  37. C Vector of dimension 25
  38. C RJ(K) is the integral over (-1,1) of
  39. C (1-X)**BETA*T(K-1,X), K = 1, ..., 25.
  40. C
  41. C RG - Double precision
  42. C Vector of dimension 25
  43. C RG(K) is the integral over (-1,1) of
  44. C (1+X)**ALFA*LOG((1+X)/2)*T(K-1,X), K = 1, ..., 25.
  45. C
  46. C RH - Double precision
  47. C Vector of dimension 25
  48. C RH(K) is the integral over (-1,1) of
  49. C (1-X)**BETA*LOG((1-X)/2)*T(K-1,X), K = 1, ..., 25.
  50. C
  51. C INTEGR - Integer
  52. C Input parameter indicating the modified
  53. C Moments to be computed
  54. C INTEGR = 1 compute RI, RJ
  55. C = 2 compute RI, RJ, RG
  56. C = 3 compute RI, RJ, RH
  57. C = 4 compute RI, RJ, RG, RH
  58. C
  59. C***REFERENCES (NONE)
  60. C***ROUTINES CALLED (NONE)
  61. C***REVISION HISTORY (YYMMDD)
  62. C 820101 DATE WRITTEN
  63. C 891009 Removed unreferenced statement label. (WRB)
  64. C 891009 REVISION DATE from Version 3.2
  65. C 891214 Prologue converted to Version 4.0 format. (BAB)
  66. C***END PROLOGUE DQMOMO
  67. C
  68. DOUBLE PRECISION ALFA,ALFP1,ALFP2,AN,ANM1,BETA,BETP1,BETP2,RALF,
  69. 1 RBET,RG,RH,RI,RJ
  70. INTEGER I,IM1,INTEGR
  71. C
  72. DIMENSION RG(25),RH(25),RI(25),RJ(25)
  73. C
  74. C
  75. C***FIRST EXECUTABLE STATEMENT DQMOMO
  76. ALFP1 = ALFA+0.1D+01
  77. BETP1 = BETA+0.1D+01
  78. ALFP2 = ALFA+0.2D+01
  79. BETP2 = BETA+0.2D+01
  80. RALF = 0.2D+01**ALFP1
  81. RBET = 0.2D+01**BETP1
  82. C
  83. C COMPUTE RI, RJ USING A FORWARD RECURRENCE RELATION.
  84. C
  85. RI(1) = RALF/ALFP1
  86. RJ(1) = RBET/BETP1
  87. RI(2) = RI(1)*ALFA/ALFP2
  88. RJ(2) = RJ(1)*BETA/BETP2
  89. AN = 0.2D+01
  90. ANM1 = 0.1D+01
  91. DO 20 I=3,25
  92. RI(I) = -(RALF+AN*(AN-ALFP2)*RI(I-1))/(ANM1*(AN+ALFP1))
  93. RJ(I) = -(RBET+AN*(AN-BETP2)*RJ(I-1))/(ANM1*(AN+BETP1))
  94. ANM1 = AN
  95. AN = AN+0.1D+01
  96. 20 CONTINUE
  97. IF(INTEGR.EQ.1) GO TO 70
  98. IF(INTEGR.EQ.3) GO TO 40
  99. C
  100. C COMPUTE RG USING A FORWARD RECURRENCE RELATION.
  101. C
  102. RG(1) = -RI(1)/ALFP1
  103. RG(2) = -(RALF+RALF)/(ALFP2*ALFP2)-RG(1)
  104. AN = 0.2D+01
  105. ANM1 = 0.1D+01
  106. IM1 = 2
  107. DO 30 I=3,25
  108. RG(I) = -(AN*(AN-ALFP2)*RG(IM1)-AN*RI(IM1)+ANM1*RI(I))/
  109. 1 (ANM1*(AN+ALFP1))
  110. ANM1 = AN
  111. AN = AN+0.1D+01
  112. IM1 = I
  113. 30 CONTINUE
  114. IF(INTEGR.EQ.2) GO TO 70
  115. C
  116. C COMPUTE RH USING A FORWARD RECURRENCE RELATION.
  117. C
  118. 40 RH(1) = -RJ(1)/BETP1
  119. RH(2) = -(RBET+RBET)/(BETP2*BETP2)-RH(1)
  120. AN = 0.2D+01
  121. ANM1 = 0.1D+01
  122. IM1 = 2
  123. DO 50 I=3,25
  124. RH(I) = -(AN*(AN-BETP2)*RH(IM1)-AN*RJ(IM1)+
  125. 1 ANM1*RJ(I))/(ANM1*(AN+BETP1))
  126. ANM1 = AN
  127. AN = AN+0.1D+01
  128. IM1 = I
  129. 50 CONTINUE
  130. DO 60 I=2,25,2
  131. RH(I) = -RH(I)
  132. 60 CONTINUE
  133. 70 DO 80 I=2,25,2
  134. RJ(I) = -RJ(I)
  135. 80 CONTINUE
  136. RETURN
  137. END