qmomo.f 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139
  1. *DECK QMOMO
  2. SUBROUTINE QMOMO (ALFA, BETA, RI, RJ, RG, RH, INTEGR)
  3. C***BEGIN PROLOGUE QMOMO
  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 SINGLE 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 REAL VERSION
  23. C
  24. C PARAMETERS
  25. C ALFA - Real
  26. C Parameter in the weight function W(X), ALFA.GT.(-1)
  27. C
  28. C BETA - Real
  29. C Parameter in the weight function W(X), BETA.GT.(-1)
  30. C
  31. C RI - Real
  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 - Real
  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 - Real
  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 - Real
  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 810101 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 QMOMO
  67. C
  68. REAL ALFA,ALFP1,ALFP2,AN,ANM1,BETA,BETP1,
  69. 1 BETP2,RALF,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 QMOMO
  76. ALFP1 = ALFA+0.1E+01
  77. BETP1 = BETA+0.1E+01
  78. ALFP2 = ALFA+0.2E+01
  79. BETP2 = BETA+0.2E+01
  80. RALF = 0.2E+01**ALFP1
  81. RBET = 0.2E+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.2E+01
  90. ANM1 = 0.1E+01
  91. DO 20 I=3,25
  92. RI(I) = -(RALF+AN*(AN-ALFP2)*RI(I-1))/
  93. 1 (ANM1*(AN+ALFP1))
  94. RJ(I) = -(RBET+AN*(AN-BETP2)*RJ(I-1))/
  95. 1 (ANM1*(AN+BETP1))
  96. ANM1 = AN
  97. AN = AN+0.1E+01
  98. 20 CONTINUE
  99. IF(INTEGR.EQ.1) GO TO 70
  100. IF(INTEGR.EQ.3) GO TO 40
  101. C
  102. C COMPUTE RG USING A FORWARD RECURRENCE RELATION.
  103. C
  104. RG(1) = -RI(1)/ALFP1
  105. RG(2) = -(RALF+RALF)/(ALFP2*ALFP2)-RG(1)
  106. AN = 0.2E+01
  107. ANM1 = 0.1E+01
  108. IM1 = 2
  109. DO 30 I=3,25
  110. RG(I) = -(AN*(AN-ALFP2)*RG(IM1)-AN*RI(IM1)+ANM1*RI(I))/
  111. 1 (ANM1*(AN+ALFP1))
  112. ANM1 = AN
  113. AN = AN+0.1E+01
  114. IM1 = I
  115. 30 CONTINUE
  116. IF(INTEGR.EQ.2) GO TO 70
  117. C
  118. C COMPUTE RH USING A FORWARD RECURRENCE RELATION.
  119. C
  120. 40 RH(1) = -RJ(1)/BETP1
  121. RH(2) = -(RBET+RBET)/(BETP2*BETP2)-RH(1)
  122. AN = 0.2E+01
  123. ANM1 = 0.1E+01
  124. IM1 = 2
  125. DO 50 I=3,25
  126. RH(I) = -(AN*(AN-BETP2)*RH(IM1)-AN*RJ(IM1)+
  127. 1 ANM1*RJ(I))/(ANM1*(AN+BETP1))
  128. ANM1 = AN
  129. AN = AN+0.1E+01
  130. IM1 = I
  131. 50 CONTINUE
  132. DO 60 I=2,25,2
  133. RH(I) = -RH(I)
  134. 60 CONTINUE
  135. 70 DO 80 I=2,25,2
  136. RJ(I) = -RJ(I)
  137. 80 CONTINUE
  138. RETURN
  139. END