dqawf.f 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243
  1. *DECK DQAWF
  2. SUBROUTINE DQAWF (F, A, OMEGA, INTEGR, EPSABS, RESULT, ABSERR,
  3. + NEVAL, IER, LIMLST, LST, LENIW, MAXP1, LENW, IWORK, WORK)
  4. C***BEGIN PROLOGUE DQAWF
  5. C***PURPOSE The routine calculates an approximation result to a given
  6. C Fourier integral I=Integral of F(X)*W(X) over (A,INFINITY)
  7. C where W(X) = COS(OMEGA*X) or W(X) = SIN(OMEGA*X).
  8. C Hopefully satisfying following claim for accuracy
  9. C ABS(I-RESULT).LE.EPSABS.
  10. C***LIBRARY SLATEC (QUADPACK)
  11. C***CATEGORY H2A3A1
  12. C***TYPE DOUBLE PRECISION (QAWF-S, DQAWF-D)
  13. C***KEYWORDS AUTOMATIC INTEGRATOR, CONVERGENCE ACCELERATION,
  14. C FOURIER INTEGRALS, INTEGRATION BETWEEN ZEROS, QUADPACK,
  15. C QUADRATURE, SPECIAL-PURPOSE INTEGRAL
  16. C***AUTHOR Piessens, Robert
  17. C Applied Mathematics and Programming Division
  18. C K. U. Leuven
  19. C de Doncker, Elise
  20. C Applied Mathematics and Programming Division
  21. C K. U. Leuven
  22. C***DESCRIPTION
  23. C
  24. C Computation of Fourier integrals
  25. C Standard fortran subroutine
  26. C Double precision version
  27. C
  28. C
  29. C PARAMETERS
  30. C ON ENTRY
  31. C F - Double precision
  32. C Function subprogram defining the integrand
  33. C function F(X). The actual name for F needs to be
  34. C declared E X T E R N A L in the driver program.
  35. C
  36. C A - Double precision
  37. C Lower limit of integration
  38. C
  39. C OMEGA - Double precision
  40. C Parameter in the integrand WEIGHT function
  41. C
  42. C INTEGR - Integer
  43. C Indicates which of the WEIGHT functions is used
  44. C INTEGR = 1 W(X) = COS(OMEGA*X)
  45. C INTEGR = 2 W(X) = SIN(OMEGA*X)
  46. C IF INTEGR.NE.1.AND.INTEGR.NE.2, the routine
  47. C will end with IER = 6.
  48. C
  49. C EPSABS - Double precision
  50. C Absolute accuracy requested, EPSABS.GT.0.
  51. C If EPSABS.LE.0, the routine will end with IER = 6.
  52. C
  53. C ON RETURN
  54. C RESULT - Double precision
  55. C Approximation to the integral
  56. C
  57. C ABSERR - Double precision
  58. C Estimate of the modulus of the absolute error,
  59. C Which should equal or exceed ABS(I-RESULT)
  60. C
  61. C NEVAL - Integer
  62. C Number of integrand evaluations
  63. C
  64. C IER - Integer
  65. C IER = 0 Normal and reliable termination of the
  66. C routine. It is assumed that the requested
  67. C accuracy has been achieved.
  68. C IER.GT.0 Abnormal termination of the routine.
  69. C The estimates for integral and error are
  70. C less reliable. It is assumed that the
  71. C requested accuracy has not been achieved.
  72. C ERROR MESSAGES
  73. C If OMEGA.NE.0
  74. C IER = 1 Maximum number of cycles allowed
  75. C has been achieved, i.e. of subintervals
  76. C (A+(K-1)C,A+KC) where
  77. C C = (2*INT(ABS(OMEGA))+1)*PI/ABS(OMEGA),
  78. C FOR K = 1, 2, ..., LST.
  79. C One can allow more cycles by increasing
  80. C the value of LIMLST (and taking the
  81. C according dimension adjustments into
  82. C account). Examine the array IWORK which
  83. C contains the error flags on the cycles, in
  84. C order to look for eventual local
  85. C integration difficulties.
  86. C If the position of a local difficulty
  87. C can be determined (e.g. singularity,
  88. C discontinuity within the interval) one
  89. C will probably gain from splitting up the
  90. C interval at this point and calling
  91. C appropriate integrators on the subranges.
  92. C = 4 The extrapolation table constructed for
  93. C convergence acceleration of the series
  94. C formed by the integral contributions over
  95. C the cycles, does not converge to within
  96. C the requested accuracy.
  97. C As in the case of IER = 1, it is advised
  98. C to examine the array IWORK which contains
  99. C the error flags on the cycles.
  100. C = 6 The input is invalid because
  101. C (INTEGR.NE.1 AND INTEGR.NE.2) or
  102. C EPSABS.LE.0 or LIMLST.LT.1 or
  103. C LENIW.LT.(LIMLST+2) or MAXP1.LT.1 or
  104. C LENW.LT.(LENIW*2+MAXP1*25).
  105. C RESULT, ABSERR, NEVAL, LST are set to
  106. C zero.
  107. C = 7 Bad integrand behaviour occurs within
  108. C one or more of the cycles. Location and
  109. C type of the difficulty involved can be
  110. C determined from the first LST elements of
  111. C vector IWORK. Here LST is the number of
  112. C cycles actually needed (see below).
  113. C IWORK(K) = 1 The maximum number of
  114. C subdivisions (=(LENIW-LIMLST)
  115. C /2) has been achieved on the
  116. C K th cycle.
  117. C = 2 Occurrence of roundoff error
  118. C is detected and prevents the
  119. C tolerance imposed on the K th
  120. C cycle, from being achieved
  121. C on this cycle.
  122. C = 3 Extremely bad integrand
  123. C behaviour occurs at some
  124. C points of the K th cycle.
  125. C = 4 The integration procedure
  126. C over the K th cycle does
  127. C not converge (to within the
  128. C required accuracy) due to
  129. C roundoff in the extrapolation
  130. C procedure invoked on this
  131. C cycle. It is assumed that the
  132. C result on this interval is
  133. C the best which can be
  134. C obtained.
  135. C = 5 The integral over the K th
  136. C cycle is probably divergent
  137. C or slowly convergent. It must
  138. C be noted that divergence can
  139. C occur with any other value of
  140. C IWORK(K).
  141. C If OMEGA = 0 and INTEGR = 1,
  142. C The integral is calculated by means of DQAGIE,
  143. C and IER = IWORK(1) (with meaning as described
  144. C for IWORK(K),K = 1).
  145. C
  146. C DIMENSIONING PARAMETERS
  147. C LIMLST - Integer
  148. C LIMLST gives an upper bound on the number of
  149. C cycles, LIMLST.GE.3.
  150. C If LIMLST.LT.3, the routine will end with IER = 6.
  151. C
  152. C LST - Integer
  153. C On return, LST indicates the number of cycles
  154. C actually needed for the integration.
  155. C If OMEGA = 0, then LST is set to 1.
  156. C
  157. C LENIW - Integer
  158. C Dimensioning parameter for IWORK. On entry,
  159. C (LENIW-LIMLST)/2 equals the maximum number of
  160. C subintervals allowed in the partition of each
  161. C cycle, LENIW.GE.(LIMLST+2).
  162. C If LENIW.LT.(LIMLST+2), the routine will end with
  163. C IER = 6.
  164. C
  165. C MAXP1 - Integer
  166. C MAXP1 gives an upper bound on the number of
  167. C Chebyshev moments which can be stored, i.e. for
  168. C the intervals of lengths ABS(B-A)*2**(-L),
  169. C L = 0,1, ..., MAXP1-2, MAXP1.GE.1.
  170. C If MAXP1.LT.1, the routine will end with IER = 6.
  171. C LENW - Integer
  172. C Dimensioning parameter for WORK
  173. C LENW must be at least LENIW*2+MAXP1*25.
  174. C If LENW.LT.(LENIW*2+MAXP1*25), the routine will
  175. C end with IER = 6.
  176. C
  177. C WORK ARRAYS
  178. C IWORK - Integer
  179. C Vector of dimension at least LENIW
  180. C On return, IWORK(K) FOR K = 1, 2, ..., LST
  181. C contain the error flags on the cycles.
  182. C
  183. C WORK - Double precision
  184. C Vector of dimension at least
  185. C On return,
  186. C WORK(1), ..., WORK(LST) contain the integral
  187. C approximations over the cycles,
  188. C WORK(LIMLST+1), ..., WORK(LIMLST+LST) contain
  189. C the error estimates over the cycles.
  190. C further elements of WORK have no specific
  191. C meaning for the user.
  192. C
  193. C***REFERENCES (NONE)
  194. C***ROUTINES CALLED DQAWFE, XERMSG
  195. C***REVISION HISTORY (YYMMDD)
  196. C 800101 DATE WRITTEN
  197. C 890831 Modified array declarations. (WRB)
  198. C 891009 Removed unreferenced variable. (WRB)
  199. C 891009 REVISION DATE from Version 3.2
  200. C 891214 Prologue converted to Version 4.0 format. (BAB)
  201. C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
  202. C***END PROLOGUE DQAWF
  203. C
  204. DOUBLE PRECISION A,ABSERR,EPSABS,F,OMEGA,RESULT,WORK
  205. INTEGER IER,INTEGR,IWORK,LENIW,LENW,LIMIT,LIMLST,LL2,LVL,
  206. 1 LST,L1,L2,L3,L4,L5,L6,MAXP1,NEVAL
  207. C
  208. DIMENSION IWORK(*),WORK(*)
  209. C
  210. EXTERNAL F
  211. C
  212. C CHECK VALIDITY OF LIMLST, LENIW, MAXP1 AND LENW.
  213. C
  214. C***FIRST EXECUTABLE STATEMENT DQAWF
  215. IER = 6
  216. NEVAL = 0
  217. RESULT = 0.0D+00
  218. ABSERR = 0.0D+00
  219. IF(LIMLST.LT.3.OR.LENIW.LT.(LIMLST+2).OR.MAXP1.LT.1.OR.LENW.LT.
  220. 1 (LENIW*2+MAXP1*25)) GO TO 10
  221. C
  222. C PREPARE CALL FOR DQAWFE
  223. C
  224. LIMIT = (LENIW-LIMLST)/2
  225. L1 = LIMLST+1
  226. L2 = LIMLST+L1
  227. L3 = LIMIT+L2
  228. L4 = LIMIT+L3
  229. L5 = LIMIT+L4
  230. L6 = LIMIT+L5
  231. LL2 = LIMIT+L1
  232. CALL DQAWFE(F,A,OMEGA,INTEGR,EPSABS,LIMLST,LIMIT,MAXP1,RESULT,
  233. 1 ABSERR,NEVAL,IER,WORK(1),WORK(L1),IWORK(1),LST,WORK(L2),
  234. 2 WORK(L3),WORK(L4),WORK(L5),IWORK(L1),IWORK(LL2),WORK(L6))
  235. C
  236. C CALL ERROR HANDLER IF NECESSARY
  237. C
  238. LVL = 0
  239. 10 IF(IER.EQ.6) LVL = 1
  240. IF (IER .NE. 0) CALL XERMSG ('SLATEC', 'DQAWF',
  241. + 'ABNORMAL RETURN', IER, LVL)
  242. RETURN
  243. END