mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
244 lines
11 KiB
Fortran
244 lines
11 KiB
Fortran
*DECK QAWF
|
|
SUBROUTINE QAWF (F, A, OMEGA, INTEGR, EPSABS, RESULT, ABSERR,
|
|
+ NEVAL, IER, LIMLST, LST, LENIW, MAXP1, LENW, IWORK, WORK)
|
|
C***BEGIN PROLOGUE QAWF
|
|
C***PURPOSE The routine calculates an approximation result to a given
|
|
C Fourier integral
|
|
C I = Integral of F(X)*W(X) over (A,INFINITY)
|
|
C where W(X) = COS(OMEGA*X) or W(X) = SIN(OMEGA*X).
|
|
C Hopefully satisfying following claim for accuracy
|
|
C ABS(I-RESULT).LE.EPSABS.
|
|
C***LIBRARY SLATEC (QUADPACK)
|
|
C***CATEGORY H2A3A1
|
|
C***TYPE SINGLE PRECISION (QAWF-S, DQAWF-D)
|
|
C***KEYWORDS AUTOMATIC INTEGRATOR, CONVERGENCE ACCELERATION,
|
|
C FOURIER INTEGRALS, INTEGRATION BETWEEN ZEROS, QUADPACK,
|
|
C QUADRATURE, SPECIAL-PURPOSE INTEGRAL
|
|
C***AUTHOR Piessens, Robert
|
|
C Applied Mathematics and Programming Division
|
|
C K. U. Leuven
|
|
C de Doncker, Elise
|
|
C Applied Mathematics and Programming Division
|
|
C K. U. Leuven
|
|
C***DESCRIPTION
|
|
C
|
|
C Computation of Fourier integrals
|
|
C Standard fortran subroutine
|
|
C Real version
|
|
C
|
|
C
|
|
C PARAMETERS
|
|
C ON ENTRY
|
|
C F - Real
|
|
C Function subprogram defining the integrand
|
|
C function F(X). The actual name for F needs to be
|
|
C declared E X T E R N A L in the driver program.
|
|
C
|
|
C A - Real
|
|
C Lower limit of integration
|
|
C
|
|
C OMEGA - Real
|
|
C Parameter in the integrand WEIGHT function
|
|
C
|
|
C INTEGR - Integer
|
|
C Indicates which of the WEIGHT functions is used
|
|
C INTEGR = 1 W(X) = COS(OMEGA*X)
|
|
C INTEGR = 2 W(X) = SIN(OMEGA*X)
|
|
C IF INTEGR.NE.1.AND.INTEGR.NE.2, the routine
|
|
C will end with IER = 6.
|
|
C
|
|
C EPSABS - Real
|
|
C Absolute accuracy requested, EPSABS.GT.0.
|
|
C If EPSABS.LE.0, the routine will end with IER = 6.
|
|
C
|
|
C ON RETURN
|
|
C RESULT - Real
|
|
C Approximation to the integral
|
|
C
|
|
C ABSERR - Real
|
|
C Estimate of the modulus of the absolute error,
|
|
C Which should equal or exceed ABS(I-RESULT)
|
|
C
|
|
C NEVAL - Integer
|
|
C Number of integrand evaluations
|
|
C
|
|
C IER - Integer
|
|
C IER = 0 Normal and reliable termination of the
|
|
C routine. It is assumed that the requested
|
|
C accuracy has been achieved.
|
|
C IER.GT.0 Abnormal termination of the routine.
|
|
C The estimates for integral and error are
|
|
C less reliable. It is assumed that the
|
|
C requested accuracy has not been achieved.
|
|
C ERROR MESSAGES
|
|
C If OMEGA.NE.0
|
|
C IER = 1 Maximum number of cycles allowed
|
|
C has been achieved, i.e. of subintervals
|
|
C (A+(K-1)C,A+KC) where
|
|
C C = (2*INT(ABS(OMEGA))+1)*PI/ABS(OMEGA),
|
|
C FOR K = 1, 2, ..., LST.
|
|
C One can allow more cycles by increasing
|
|
C the value of LIMLST (and taking the
|
|
C according dimension adjustments into
|
|
C account). Examine the array IWORK which
|
|
C contains the error flags on the cycles, in
|
|
C order to look for eventual local
|
|
C integration difficulties.
|
|
C If the position of a local difficulty
|
|
C can be determined (e.g. singularity,
|
|
C discontinuity within the interval) one
|
|
C will probably gain from splitting up the
|
|
C interval at this point and calling
|
|
C appropriate integrators on the subranges.
|
|
C = 4 The extrapolation table constructed for
|
|
C convergence acceleration of the series
|
|
C formed by the integral contributions over
|
|
C the cycles, does not converge to within
|
|
C the requested accuracy.
|
|
C As in the case of IER = 1, it is advised
|
|
C to examine the array IWORK which contains
|
|
C the error flags on the cycles.
|
|
C = 6 The input is invalid because
|
|
C (INTEGR.NE.1 AND INTEGR.NE.2) or
|
|
C EPSABS.LE.0 or LIMLST.LT.1 or
|
|
C LENIW.LT.(LIMLST+2) or MAXP1.LT.1 or
|
|
C LENW.LT.(LENIW*2+MAXP1*25).
|
|
C RESULT, ABSERR, NEVAL, LST are set to
|
|
C zero.
|
|
C = 7 Bad integrand behaviour occurs within
|
|
C one or more of the cycles. Location and
|
|
C type of the difficulty involved can be
|
|
C determined from the first LST elements of
|
|
C vector IWORK. Here LST is the number of
|
|
C cycles actually needed (see below).
|
|
C IWORK(K) = 1 The maximum number of
|
|
C subdivisions (=(LENIW-LIMLST)
|
|
C /2) has been achieved on the
|
|
C K th cycle.
|
|
C = 2 Occurrence of roundoff error
|
|
C is detected and prevents the
|
|
C tolerance imposed on the K th
|
|
C cycle, from being achieved
|
|
C on this cycle.
|
|
C = 3 Extremely bad integrand
|
|
C behaviour occurs at some
|
|
C points of the K th cycle.
|
|
C = 4 The integration procedure
|
|
C over the K th cycle does
|
|
C not converge (to within the
|
|
C required accuracy) due to
|
|
C roundoff in the extrapolation
|
|
C procedure invoked on this
|
|
C cycle. It is assumed that the
|
|
C result on this interval is
|
|
C the best which can be
|
|
C obtained.
|
|
C = 5 The integral over the K th
|
|
C cycle is probably divergent
|
|
C or slowly convergent. It must
|
|
C be noted that divergence can
|
|
C occur with any other value of
|
|
C IWORK(K).
|
|
C If OMEGA = 0 and INTEGR = 1,
|
|
C The integral is calculated by means of DQAGIE,
|
|
C and IER = IWORK(1) (with meaning as described
|
|
C for IWORK(K),K = 1).
|
|
C
|
|
C DIMENSIONING PARAMETERS
|
|
C LIMLST - Integer
|
|
C LIMLST gives an upper bound on the number of
|
|
C cycles, LIMLST.GE.3.
|
|
C If LIMLST.LT.3, the routine will end with IER = 6.
|
|
C
|
|
C LST - Integer
|
|
C On return, LST indicates the number of cycles
|
|
C actually needed for the integration.
|
|
C If OMEGA = 0, then LST is set to 1.
|
|
C
|
|
C LENIW - Integer
|
|
C Dimensioning parameter for IWORK. On entry,
|
|
C (LENIW-LIMLST)/2 equals the maximum number of
|
|
C subintervals allowed in the partition of each
|
|
C cycle, LENIW.GE.(LIMLST+2).
|
|
C If LENIW.LT.(LIMLST+2), the routine will end with
|
|
C IER = 6.
|
|
C
|
|
C MAXP1 - Integer
|
|
C MAXP1 gives an upper bound on the number of
|
|
C Chebyshev moments which can be stored, i.e. for
|
|
C the intervals of lengths ABS(B-A)*2**(-L),
|
|
C L = 0,1, ..., MAXP1-2, MAXP1.GE.1.
|
|
C If MAXP1.LT.1, the routine will end with IER = 6.
|
|
C LENW - Integer
|
|
C Dimensioning parameter for WORK
|
|
C LENW must be at least LENIW*2+MAXP1*25.
|
|
C If LENW.LT.(LENIW*2+MAXP1*25), the routine will
|
|
C end with IER = 6.
|
|
C
|
|
C WORK ARRAYS
|
|
C IWORK - Integer
|
|
C Vector of dimension at least LENIW
|
|
C On return, IWORK(K) FOR K = 1, 2, ..., LST
|
|
C contain the error flags on the cycles.
|
|
C
|
|
C WORK - Real
|
|
C Vector of dimension at least
|
|
C On return,
|
|
C WORK(1), ..., WORK(LST) contain the integral
|
|
C approximations over the cycles,
|
|
C WORK(LIMLST+1), ..., WORK(LIMLST+LST) contain
|
|
C the error estimates over the cycles.
|
|
C further elements of WORK have no specific
|
|
C meaning for the user.
|
|
C
|
|
C***REFERENCES (NONE)
|
|
C***ROUTINES CALLED QAWFE, XERMSG
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 800101 DATE WRITTEN
|
|
C 890831 Modified array declarations. (WRB)
|
|
C 891009 Removed unreferenced variable. (WRB)
|
|
C 891009 REVISION DATE from Version 3.2
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
|
|
C***END PROLOGUE QAWF
|
|
C
|
|
REAL A,ABSERR,EPSABS,F,OMEGA,RESULT,WORK
|
|
INTEGER IER,INTEGR,LENIW,LIMIT,LIMLST,LVL,LST,L1,L2,L3,L4,L5,L6,
|
|
1 MAXP1,NEVAL
|
|
C
|
|
DIMENSION IWORK(*),WORK(*)
|
|
C
|
|
EXTERNAL F
|
|
C
|
|
C CHECK VALIDITY OF LIMLST, LENIW, MAXP1 AND LENW.
|
|
C
|
|
C***FIRST EXECUTABLE STATEMENT QAWF
|
|
IER = 6
|
|
NEVAL = 0
|
|
RESULT = 0.0E+00
|
|
ABSERR = 0.0E+00
|
|
IF(LIMLST.LT.3.OR.LENIW.LT.(LIMLST+2).OR.MAXP1.LT.1.OR.LENW.LT.
|
|
1 (LENIW*2+MAXP1*25)) GO TO 10
|
|
C
|
|
C PREPARE CALL FOR QAWFE
|
|
C
|
|
LIMIT = (LENIW-LIMLST)/2
|
|
L1 = LIMLST+1
|
|
L2 = LIMLST+L1
|
|
L3 = LIMIT+L2
|
|
L4 = LIMIT+L3
|
|
L5 = LIMIT+L4
|
|
L6 = LIMIT+L5
|
|
LL2 = LIMIT+L1
|
|
CALL QAWFE(F,A,OMEGA,INTEGR,EPSABS,LIMLST,LIMIT,MAXP1,RESULT,
|
|
1 ABSERR,NEVAL,IER,WORK(1),WORK(L1),IWORK(1),LST,WORK(L2),
|
|
2 WORK(L3),WORK(L4),WORK(L5),IWORK(L1),IWORK(LL2),WORK(L6))
|
|
C
|
|
C CALL ERROR HANDLER IF NECESSARY
|
|
C
|
|
LVL = 0
|
|
10 IF(IER.EQ.6) LVL = 1
|
|
IF (IER .NE. 0) CALL XERMSG ('SLATEC', 'QAWF',
|
|
+ 'ABNORMAL RETURN', IER, LVL)
|
|
RETURN
|
|
END
|