/* DECK DQAGIE */
/* Subroutine */ int dqagie_(D_fp f, doublereal *bound, integer *inf,
doublereal *epsabs, doublereal *epsrel, integer *limit, doublereal *
result, doublereal *abserr, integer *neval, integer *ier, doublereal *
alist__, doublereal *blist, doublereal *rlist, doublereal *elist,
integer *iord, integer *last)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Local variables */
static integer k;
static doublereal a1, a2, b1, b2;
static integer id;
static doublereal area, dres;
static integer ksgn;
static doublereal boun;
static integer nres;
static doublereal area1, area2, area12;
extern /* Subroutine */ int dqelg_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *), dqk15i_(D_fp, doublereal *
, integer *, doublereal *, doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
static doublereal small, erro12;
static integer ierro;
static doublereal defab1, defab2;
static integer ktmin, nrmax;
static doublereal oflow, uflow;
extern doublereal d1mach_(integer *);
static logical noext;
static integer iroff1, iroff2, iroff3;
static doublereal res3la[3], error1, error2, rlist2[52];
static integer numrl2;
static doublereal defabs, epmach, erlarg, abseps, correc, errbnd, resabs;
static integer jupbnd;
static doublereal erlast, errmax;
static integer maxerr;
static doublereal reseps;
static logical extrap;
static doublereal ertest, errsum;
extern /* Subroutine */ int dqpsrt_(integer *, integer *, integer *,
doublereal *, doublereal *, integer *, integer *);
/* ***BEGIN PROLOGUE DQAGIE */
/* ***PURPOSE The routine calculates an approximation result to a given */
/* integral I = Integral of F over (BOUND,+INFINITY) */
/* or I = Integral of F over (-INFINITY,BOUND) */
/* or I = Integral of F over (-INFINITY,+INFINITY), */
/* hopefully satisfying following claim for accuracy */
/* ABS(I-RESULT).LE.MAX(EPSABS,EPSREL*ABS(I)) */
/* ***LIBRARY SLATEC (QUADPACK) */
/* ***CATEGORY H2A3A1, H2A4A1 */
/* ***TYPE DOUBLE PRECISION (QAGIE-S, DQAGIE-D) */
/* ***KEYWORDS AUTOMATIC INTEGRATOR, EXTRAPOLATION, GENERAL-PURPOSE, */
/* GLOBALLY ADAPTIVE, INFINITE INTERVALS, QUADPACK, */
/* QUADRATURE, TRANSFORMATION */
/* ***AUTHOR Piessens, Robert */
/* Applied Mathematics and Programming Division */
/* K. U. Leuven */
/* de Doncker, Elise */
/* Applied Mathematics and Programming Division */
/* K. U. Leuven */
/* ***DESCRIPTION */
/* Integration over infinite intervals */
/* Standard fortran subroutine */
/* F - Double precision */
/* Function subprogram defining the integrand */
/* function F(X). The actual name for F needs to be */
/* declared E X T E R N A L in the driver program. */
/* BOUND - Double precision */
/* Finite bound of integration range */
/* (has no meaning if interval is doubly-infinite) */
/* INF - Double precision */
/* Indicating the kind of integration range involved */
/* INF = 1 corresponds to (BOUND,+INFINITY), */
/* INF = -1 to (-INFINITY,BOUND), */
/* INF = 2 to (-INFINITY,+INFINITY). */
/* EPSABS - Double precision */
/* Absolute accuracy requested */
/* EPSREL - Double precision */
/* Relative accuracy requested */
/* If EPSABS.LE.0 */
/* and EPSREL.LT.MAX(50*REL.MACH.ACC.,0.5D-28), */
/* the routine will end with IER = 6. */
/* LIMIT - Integer */
/* Gives an upper bound on the number of subintervals */
/* in the partition of (A,B), LIMIT.GE.1 */
/* ON RETURN */
/* RESULT - Double precision */
/* Approximation to the integral */
/* ABSERR - Double precision */
/* Estimate of the modulus of the absolute error, */
/* which should equal or exceed ABS(I-RESULT) */
/* NEVAL - Integer */
/* Number of integrand evaluations */
/* IER - Integer */
/* IER = 0 Normal and reliable termination of the */
/* routine. It is assumed that the requested */
/* accuracy has been achieved. */
/* - IER.GT.0 Abnormal termination of the routine. The */
/* estimates for result and error are less */
/* reliable. It is assumed that the requested */
/* accuracy has not been achieved. */
/* ERROR MESSAGES */
/* IER = 1 Maximum number of subdivisions allowed */
/* has been achieved. One can allow more */
/* subdivisions by increasing the value of */
/* LIMIT (and taking the according dimension */
/* adjustments into account). However, if */
/* this yields no improvement it is advised */
/* to analyze the integrand in order to */
/* determine the integration difficulties. */
/* If the position of a local difficulty can */
/* be determined (e.g. SINGULARITY, */
/* DISCONTINUITY within the interval) one */
/* will probably gain from splitting up the */
/* interval at this point and calling the */
/* integrator on the subranges. If possible, */
/* an appropriate special-purpose integrator */
/* should be used, which is designed for */
/* handling the type of difficulty involved. */
/* = 2 The occurrence of roundoff error is */
/* detected, which prevents the requested */
/* tolerance from being achieved. */
/* The error may be under-estimated. */
/* = 3 Extremely bad integrand behaviour occurs */
/* at some points of the integration */
/* interval. */
/* = 4 The algorithm does not converge. */
/* Roundoff error is detected in the */
/* extrapolation table. */
/* It is assumed that the requested tolerance */
/* cannot be achieved, and that the returned */
/* result is the best which can be obtained. */
/* = 5 The integral is probably divergent, or */
/* slowly convergent. It must be noted that */
/* divergence can occur with any other value */
/* of IER. */
/* = 6 The input is invalid, because */
/* (EPSABS.LE.0 and */
/* EPSREL.LT.MAX(50*REL.MACH.ACC.,0.5D-28), */
/* RESULT, ABSERR, NEVAL, LAST, RLIST(1), */
/* ELIST(1) and IORD(1) are set to zero. */
/* ALIST(1) and BLIST(1) are set to 0 */
/* and 1 respectively. */
/* ALIST - Double precision */
/* Vector of dimension at least LIMIT, the first */
/* LAST elements of which are the left */
/* end points of the subintervals in the partition */
/* of the transformed integration range (0,1). */
/* BLIST - Double precision */
/* Vector of dimension at least LIMIT, the first */
/* LAST elements of which are the right */
/* end points of the subintervals in the partition */
/* of the transformed integration range (0,1). */
/* RLIST - Double precision */
/* Vector of dimension at least LIMIT, the first */
/* LAST elements of which are the integral */
/* approximations on the subintervals */
/* ELIST - Double precision */
/* Vector of dimension at least LIMIT, the first */
/* LAST elements of which are the moduli of the */
/* absolute error estimates on the subintervals */
/* IORD - Integer */
/* Vector of dimension LIMIT, the first K */
/* elements of which are pointers to the */
/* error estimates over the subintervals, */
/* such that ELIST(IORD(1)), ..., ELIST(IORD(K)) */
/* form a decreasing sequence, with K = LAST */
/* If LAST.LE.(LIMIT/2+2), and K = LIMIT+1-LAST */
/* otherwise */
/* LAST - Integer */
/* Number of subintervals actually produced */
/* in the subdivision process */
/* ***REFERENCES (NONE) */
/* ***ROUTINES CALLED D1MACH, DQELG, DQK15I, DQPSRT */
/* ***REVISION HISTORY (YYMMDD) */
/* 800101 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890831 Modified array declarations. (WRB) */
/* 890831 REVISION DATE from Version 3.2 */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* ***END PROLOGUE DQAGIE */
/* THE DIMENSION OF RLIST2 IS DETERMINED BY THE VALUE OF */
/* LIMEXP IN SUBROUTINE DQELG. */
/* LIST OF MAJOR VARIABLES */
/* ----------------------- */
/* ALIST - LIST OF LEFT END POINTS OF ALL SUBINTERVALS */
/* CONSIDERED UP TO NOW */
/* BLIST - LIST OF RIGHT END POINTS OF ALL SUBINTERVALS */
/* CONSIDERED UP TO NOW */
/* RLIST(I) - APPROXIMATION TO THE INTEGRAL OVER */
/* (ALIST(I),BLIST(I)) */
/* RLIST2 - ARRAY OF DIMENSION AT LEAST (LIMEXP+2), */
/* CONTAINING THE PART OF THE EPSILON TABLE */
/* WHICH IS STILL NEEDED FOR FURTHER COMPUTATIONS */
/* ELIST(I) - ERROR ESTIMATE APPLYING TO RLIST(I) */
/* MAXERR - POINTER TO THE INTERVAL WITH LARGEST ERROR */
/* ESTIMATE */
/* ERRMAX - ELIST(MAXERR) */
/* ERLAST - ERROR ON THE INTERVAL CURRENTLY SUBDIVIDED */
/* (BEFORE THAT SUBDIVISION HAS TAKEN PLACE) */
/* AREA - SUM OF THE INTEGRALS OVER THE SUBINTERVALS */
/* ERRSUM - SUM OF THE ERRORS OVER THE SUBINTERVALS */
/* ERRBND - REQUESTED ACCURACY MAX(EPSABS,EPSREL* */
/* ABS(RESULT)) */
/* *****1 - VARIABLE FOR THE LEFT SUBINTERVAL */
/* *****2 - VARIABLE FOR THE RIGHT SUBINTERVAL */
/* LAST - INDEX FOR SUBDIVISION */
/* NRES - NUMBER OF CALLS TO THE EXTRAPOLATION ROUTINE */
/* NUMRL2 - NUMBER OF ELEMENTS CURRENTLY IN RLIST2. IF AN */
/* APPROPRIATE APPROXIMATION TO THE COMPOUNDED */
/* INTEGRAL HAS BEEN OBTAINED, IT IS PUT IN */
/* RLIST2(NUMRL2) AFTER NUMRL2 HAS BEEN INCREASED */
/* BY ONE. */
/* SMALL - LENGTH OF THE SMALLEST INTERVAL CONSIDERED UP */
/* TO NOW, MULTIPLIED BY 1.5 */
/* ERLARG - SUM OF THE ERRORS OVER THE INTERVALS LARGER */
/* THAN THE SMALLEST INTERVAL CONSIDERED UP TO NOW */
/* EXTRAP - LOGICAL VARIABLE DENOTING THAT THE ROUTINE */
/* IS ATTEMPTING TO PERFORM EXTRAPOLATION. I.E. */
/* BEFORE SUBDIVIDING THE SMALLEST INTERVAL WE */
/* TRY TO DECREASE THE VALUE OF ERLARG. */
/* NOEXT - LOGICAL VARIABLE DENOTING THAT EXTRAPOLATION */
/* IS NO LONGER ALLOWED (TRUE-VALUE) */
/* MACHINE DEPENDENT CONSTANTS */
/* --------------------------- */
/* EPMACH IS THE LARGEST RELATIVE SPACING. */
/* UFLOW IS THE SMALLEST POSITIVE MAGNITUDE. */
/* OFLOW IS THE LARGEST POSITIVE MAGNITUDE. */
/* ***FIRST EXECUTABLE STATEMENT DQAGIE */
/* Parameter adjustments */
--iord;
--elist;
--rlist;
--blist;
--alist__;
/* Function Body */
epmach = d1mach_(&c__4);
/* TEST ON VALIDITY OF PARAMETERS */
/* ----------------------------- */
*ier = 0;
*neval = 0;
*last = 0;
*result = 0.;
*abserr = 0.;
alist__[1] = 0.;
blist[1] = 1.;
rlist[1] = 0.;
elist[1] = 0.;
iord[1] = 0;
/* Computing MAX */
d__1 = epmach * 50.;
if (*epsabs <= 0. && *epsrel < max(d__1,5e-29)) {
*ier = 6;
}
if (*ier == 6) {
goto L999;
}
/* FIRST APPROXIMATION TO THE INTEGRAL */
/* ----------------------------------- */
/* DETERMINE THE INTERVAL TO BE MAPPED ONTO (0,1). */
/* IF INF = 2 THE INTEGRAL IS COMPUTED AS I = I1+I2, WHERE */
/* I1 = INTEGRAL OF F OVER (-INFINITY,0), */
/* I2 = INTEGRAL OF F OVER (0,+INFINITY). */
boun = *bound;
if (*inf == 2) {
boun = 0.;
}
dqk15i_((D_fp)f, &boun, inf, &c_b4, &c_b5, result, abserr, &defabs, &
resabs);
/* TEST ON ACCURACY */
*last = 1;
rlist[1] = *result;
elist[1] = *abserr;
iord[1] = 1;
dres = abs(*result);
/* Computing MAX */
d__1 = *epsabs, d__2 = *epsrel * dres;
errbnd = max(d__1,d__2);
if (*abserr <= epmach * 100. * defabs && *abserr > errbnd) {
*ier = 2;
}
if (*limit == 1) {
*ier = 1;
}
if (*ier != 0 || *abserr <= errbnd && *abserr != resabs || *abserr == 0.)
{
goto L130;
}
/* INITIALIZATION */
/* -------------- */
uflow = d1mach_(&c__1);
oflow = d1mach_(&c__2);
rlist2[0] = *result;
errmax = *abserr;
maxerr = 1;
area = *result;
errsum = *abserr;
*abserr = oflow;
nrmax = 1;
nres = 0;
ktmin = 0;
numrl2 = 2;
extrap = FALSE_;
noext = FALSE_;
ierro = 0;
iroff1 = 0;
iroff2 = 0;
iroff3 = 0;
ksgn = -1;
if (dres >= (1. - epmach * 50.) * defabs) {
ksgn = 1;
}
/* MAIN DO-LOOP */
/* ------------ */
i__1 = *limit;
for (*last = 2; *last <= i__1; ++(*last)) {
/* BISECT THE SUBINTERVAL WITH NRMAX-TH LARGEST ERROR ESTIMATE. */
a1 = alist__[maxerr];
b1 = (alist__[maxerr] + blist[maxerr]) * .5;
a2 = b1;
b2 = blist[maxerr];
erlast = errmax;
dqk15i_((D_fp)f, &boun, inf, &a1, &b1, &area1, &error1, &resabs, &
defab1);
dqk15i_((D_fp)f, &boun, inf, &a2, &b2, &area2, &error2, &resabs, &
defab2);
/* IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL */
/* AND ERROR AND TEST FOR ACCURACY. */
area12 = area1 + area2;
erro12 = error1 + error2;
errsum = errsum + erro12 - errmax;
area = area + area12 - rlist[maxerr];
if (defab1 == error1 || defab2 == error2) {
goto L15;
}
if ((d__1 = rlist[maxerr] - area12, abs(d__1)) > abs(area12) * 1e-5 ||
erro12 < errmax * .99) {
goto L10;
}
if (extrap) {
++iroff2;
}
if (! extrap) {
++iroff1;
}
L10:
if (*last > 10 && erro12 > errmax) {
++iroff3;
}
L15:
rlist[maxerr] = area1;
rlist[*last] = area2;
/* Computing MAX */
d__1 = *epsabs, d__2 = *epsrel * abs(area);
errbnd = max(d__1,d__2);
/* TEST FOR ROUNDOFF ERROR AND EVENTUALLY SET ERROR FLAG. */
if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
*ier = 2;
}
if (iroff2 >= 5) {
ierro = 3;
}
/* SET ERROR FLAG IN THE CASE THAT THE NUMBER OF */
/* SUBINTERVALS EQUALS LIMIT. */
if (*last == *limit) {
*ier = 1;
}
/* SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR */
/* AT SOME POINTS OF THE INTEGRATION RANGE. */
/* Computing MAX */
d__1 = abs(a1), d__2 = abs(b2);
if (max(d__1,d__2) <= (epmach * 100. + 1.) * (abs(a2) + uflow * 1e3))
{
*ier = 4;
}
/* APPEND THE NEWLY-CREATED INTERVALS TO THE LIST. */
if (error2 > error1) {
goto L20;
}
alist__[*last] = a2;
blist[maxerr] = b1;
blist[*last] = b2;
elist[maxerr] = error1;
elist[*last] = error2;
goto L30;
L20:
alist__[maxerr] = a2;
alist__[*last] = a1;
blist[*last] = b1;
rlist[maxerr] = area2;
rlist[*last] = area1;
elist[maxerr] = error2;
elist[*last] = error1;
/* CALL SUBROUTINE DQPSRT TO MAINTAIN THE DESCENDING ORDERING */
/* IN THE LIST OF ERROR ESTIMATES AND SELECT THE SUBINTERVAL */
/* WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE BISECTED NEXT). */
L30:
dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
if (errsum <= errbnd) {
goto L115;
}
if (*ier != 0) {
goto L100;
}
if (*last == 2) {
goto L80;
}
if (noext) {
goto L90;
}
erlarg -= erlast;
if ((d__1 = b1 - a1, abs(d__1)) > small) {
erlarg += erro12;
}
if (extrap) {
goto L40;
}
/* TEST WHETHER THE INTERVAL TO BE BISECTED NEXT IS THE */
/* SMALLEST INTERVAL. */
if ((d__1 = blist[maxerr] - alist__[maxerr], abs(d__1)) > small) {
goto L90;
}
extrap = TRUE_;
nrmax = 2;
L40:
if (ierro == 3 || erlarg <= ertest) {
goto L60;
}
/* THE SMALLEST INTERVAL HAS THE LARGEST ERROR. */
/* BEFORE BISECTING DECREASE THE SUM OF THE ERRORS OVER THE */
/* LARGER INTERVALS (ERLARG) AND PERFORM EXTRAPOLATION. */
id = nrmax;
jupbnd = *last;
if (*last > *limit / 2 + 2) {
jupbnd = *limit + 3 - *last;
}
i__2 = jupbnd;
for (k = id; k <= i__2; ++k) {
maxerr = iord[nrmax];
errmax = elist[maxerr];
if ((d__1 = blist[maxerr] - alist__[maxerr], abs(d__1)) > small) {
goto L90;
}
++nrmax;
/* L50: */
}
/* PERFORM EXTRAPOLATION. */
L60:
++numrl2;
rlist2[numrl2 - 1] = area;
dqelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
++ktmin;
if (ktmin > 5 && *abserr < errsum * .001) {
*ier = 5;
}
if (abseps >= *abserr) {
goto L70;
}
ktmin = 0;
*abserr = abseps;
*result = reseps;
correc = erlarg;
/* Computing MAX */
d__1 = *epsabs, d__2 = *epsrel * abs(reseps);
ertest = max(d__1,d__2);
if (*abserr <= ertest) {
goto L100;
}
/* PREPARE BISECTION OF THE SMALLEST INTERVAL. */
L70:
if (numrl2 == 1) {
noext = TRUE_;
}
if (*ier == 5) {
goto L100;
}
maxerr = iord[1];
errmax = elist[maxerr];
nrmax = 1;
extrap = FALSE_;
small *= .5;
erlarg = errsum;
goto L90;
L80:
small = .375;
erlarg = errsum;
ertest = errbnd;
rlist2[1] = area;
L90:
;
}
/* SET FINAL RESULT AND ERROR ESTIMATE. */
/* ------------------------------------ */
L100:
if (*abserr == oflow) {
goto L115;
}
if (*ier + ierro == 0) {
goto L110;
}
if (ierro == 3) {
*abserr += correc;
}
if (*ier == 0) {
*ier = 3;
}
if (*result != 0. && area != 0.) {
goto L105;
}
if (*abserr > errsum) {
goto L115;
}
if (area == 0.) {
goto L130;
}
goto L110;
L105:
if (*abserr / abs(*result) > errsum / abs(area)) {
goto L115;
}
/* TEST ON DIVERGENCE */
L110:
/* Computing MAX */
d__1 = abs(*result), d__2 = abs(area);
if (ksgn == -1 && max(d__1,d__2) <= defabs * .01) {
goto L130;
}
if (.01 > *result / area || *result / area > 100. || errsum > abs(area)) {
*ier = 6;
}
goto L130;
/* COMPUTE GLOBAL INTEGRAL SUM. */
L115:
*result = 0.;
i__1 = *last;
for (k = 1; k <= i__1; ++k) {
*result += rlist[k];
/* L120: */
}
*abserr = errsum;
L130:
*neval = *last * 30 - 15;
if (*inf == 2) {
*neval <<= 1;
}
if (*ier > 2) {
--(*ier);
}
L999:
return 0;
} /* dqagie_ */
/* Subroutine */ int dqawfe_(D_fp f, doublereal *a, doublereal *omega,
integer *integr, doublereal *epsabs, integer *limlst, integer *limit,
integer *maxp1, doublereal *result, doublereal *abserr, integer *
neval, integer *ier, doublereal *rslst, doublereal *erlst, integer *
ierlst, integer *lst, doublereal *alist__, doublereal *blist,
doublereal *rlist, doublereal *elist, integer *iord, integer *nnlog,
doublereal *chebmo)
{
/* Initialized data */
static doublereal p = .9;
static doublereal pi = 3.1415926535897932384626433832795;
/* System generated locals */
integer chebmo_dim1, chebmo_offset, i__1;
doublereal d__1, d__2;
/* Local variables */
doublereal fact, epsa;
integer last, nres;
doublereal psum[52];
integer l;
extern /* Subroutine */ int dqelg_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *);
doublereal cycle;
integer ktmin;
doublereal c1, c2, uflow;
extern doublereal d1mach_(integer *);
doublereal p1, res3la[3];
integer numrl2;
doublereal dl, ep;
integer ll;
extern /* Subroutine */ int dqagie_(D_fp, doublereal *, integer *,
doublereal *, doublereal *, integer *, doublereal *, doublereal *,
integer *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, integer *);
doublereal abseps, correc;
extern /* Subroutine */ int dqawoe_(D_fp, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, doublereal *, integer *,
integer *, integer *, doublereal *, doublereal *, integer *,
integer *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, integer *, integer *, doublereal *);
integer momcom;
doublereal reseps, errsum, dla, drl, eps;
integer nev;
/* ***begin prologue dqawfe */
/* ***date written 800101 (yymmdd) */
/* ***revision date 830518 (yymmdd) */
/* ***category no. h2a3a1 */
/* ***keywords automatic integrator, special-purpose, */
/* fourier integrals, */
/* integration between zeros with dqawoe, */
/* convergence acceleration with dqelg */
/* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
/* dedoncker,elise,appl. math. & progr. div. - k.u.leuven */
/* ***purpose the routine calculates an approximation result to a */
/* given fourier integal */
/* i = integral of f(x)*w(x) over (a,infinity) */
/* where w(x)=cos(omega*x) or w(x)=sin(omega*x), */
/* hopefully satisfying following claim for accuracy */
/* abs(i-result).le.epsabs. */
/* ***description */
/* computation of fourier integrals */
/* standard fortran subroutine */
/* double precision version */
/* parameters */
/* on entry */
/* f - double precision */
/* function subprogram defining the integrand */
/* function f(x). the actual name for f needs to */
/* be declared e x t e r n a l in the driver program. */
/* a - double precision */
/* lower limit of integration */
/* omega - double precision */
/* parameter in the weight function */
/* integr - integer */
/* indicates which weight function is used */
/* integr = 1 w(x) = cos(omega*x) */
/* integr = 2 w(x) = sin(omega*x) */
/* if integr.ne.1.and.integr.ne.2, the routine will */
/* end with ier = 6. */
/* epsabs - double precision */
/* absolute accuracy requested, epsabs.gt.0 */
/* if epsabs.le.0, the routine will end with ier = 6. */
/* limlst - integer */
/* limlst gives an upper bound on the number of */
/* cycles, limlst.ge.1. */
/* if limlst.lt.3, the routine will end with ier = 6. */
/* limit - integer */
/* gives an upper bound on the number of subintervals */
/* allowed in the partition of each cycle, limit.ge.1 */
/* each cycle, limit.ge.1. */
/* maxp1 - integer */
/* gives an upper bound on the number of */
/* chebyshev moments which can be stored, i.e. */
/* for the intervals of lengths abs(b-a)*2**(-l), */
/* l=0,1, ..., maxp1-2, maxp1.ge.1 */
/* on return */
/* result - double precision */
/* approximation to the integral x */
/* abserr - double precision */
/* estimate of the modulus of the absolute error, */
/* which should equal or exceed abs(i-result) */
/* neval - integer */
/* number of integrand evaluations */
/* ier - ier = 0 normal and reliable termination of */
/* the routine. it is assumed that the */
/* requested accuracy has been achieved. */
/* ier.gt.0 abnormal termination of the routine. the */
/* estimates for integral and error are less */
/* reliable. it is assumed that the requested */
/* accuracy has not been achieved. */
/* error messages */
/* if omega.ne.0 */
/* ier = 1 maximum number of cycles allowed */
/* has been achieved., i.e. of subintervals */
/* (a+(k-1)c,a+kc) where */
/* c = (2*int(abs(omega))+1)*pi/abs(omega), */
/* for k = 1, 2, ..., lst. */
/* one can allow more cycles by increasing */
/* the value of limlst (and taking the */
/* according dimension adjustments into */
/* account). */
/* examine the array iwork which contains */
/* the error flags on the cycles, in order to */
/* look for eventual local integration */
/* difficulties. if the position of a local */
/* difficulty can be determined (e.g. */
/* singularity, discontinuity within the */
/* interval) one will probably gain from */
/* splitting up the interval at this point */
/* and calling appropriate integrators on */
/* the subranges. */
/* = 4 the extrapolation table constructed for */
/* convergence acceleration of the series */
/* formed by the integral contributions over */
/* the cycles, does not converge to within */
/* the requested accuracy. as in the case of */
/* ier = 1, it is advised to examine the */
/* array iwork which contains the error */
/* flags on the cycles. */
/* = 6 the input is invalid because */
/* (integr.ne.1 and integr.ne.2) or */
/* epsabs.le.0 or limlst.lt.3. */
/* result, abserr, neval, lst are set */
/* to zero. */
/* = 7 bad integrand behaviour occurs within one */
/* or more of the cycles. location and type */
/* of the difficulty involved can be */
/* determined from the vector ierlst. here */
/* lst is the number of cycles actually */
/* needed (see below). */
/* ierlst(k) = 1 the maximum number of */
/* subdivisions (= limit) has */
/* been achieved on the k th */
/* cycle. */
/* = 2 occurrence of roundoff error */
/* is detected and prevents the */
/* tolerance imposed on the */
/* k th cycle, from being */
/* achieved. */
/* = 3 extremely bad integrand */
/* behaviour occurs at some */
/* points of the k th cycle. */
/* = 4 the integration procedure */
/* over the k th cycle does */
/* not converge (to within the */
/* required accuracy) due to */
/* roundoff in the */
/* extrapolation procedure */
/* invoked on this cycle. it */
/* is assumed that the result */
/* on this interval is the */
/* best which can be obtained. */
/* = 5 the integral over the k th */
/* cycle is probably divergent */
/* or slowly convergent. it */
/* must be noted that */
/* divergence can occur with */
/* any other value of */
/* ierlst(k). */
/* if omega = 0 and integr = 1, */
/* the integral is calculated by means of dqagie */
/* and ier = ierlst(1) (with meaning as described */
/* for ierlst(k), k = 1). */
/* rslst - double precision */
/* vector of dimension at least limlst */
/* rslst(k) contains the integral contribution */
/* over the interval (a+(k-1)c,a+kc) where */
/* c = (2*int(abs(omega))+1)*pi/abs(omega), */
/* k = 1, 2, ..., lst. */
/* note that, if omega = 0, rslst(1) contains */
/* the value of the integral over (a,infinity). */
/* erlst - double precision */
/* vector of dimension at least limlst */
/* erlst(k) contains the error estimate corresponding */
/* with rslst(k). */
/* ierlst - integer */
/* vector of dimension at least limlst */
/* ierlst(k) contains the error flag corresponding */
/* with rslst(k). for the meaning of the local error */
/* flags see description of output parameter ier. */
/* lst - integer */
/* number of subintervals needed for the integration */
/* if omega = 0 then lst is set to 1. */
/* alist, blist, rlist, elist - double precision */
/* vector of dimension at least limit, */
/* iord, nnlog - integer */
/* vector of dimension at least limit, providing */
/* space for the quantities needed in the subdivision */
/* process of each cycle */
/* chebmo - double precision */
/* array of dimension at least (maxp1,25), providing */
/* space for the chebyshev moments needed within the */
/* cycles */
/* ***references (none) */
/* ***routines called d1mach,dqagie,dqawoe,dqelg */
/* ***end prologue dqawfe */
/* the dimension of psum is determined by the value of */
/* limexp in subroutine dqelg (psum must be of dimension */
/* (limexp+2) at least). */
/* list of major variables */
/* ----------------------- */
/* c1, c2 - end points of subinterval (of length cycle) */
/* cycle - (2*int(abs(omega))+1)*pi/abs(omega) */
/* psum - vector of dimension at least (limexp+2) */
/* (see routine dqelg) */
/* psum contains the part of the epsilon table */
/* which is still needed for further computations. */
/* each element of psum is a partial sum of the */
/* series which should sum to the value of the */
/* integral. */
/* errsum - sum of error estimates over the subintervals, */
/* calculated cumulatively */
/* epsa - absolute tolerance requested over current */
/* subinterval */
/* chebmo - array containing the modified chebyshev */
/* moments (see also routine dqc25f) */
/* Parameter adjustments */
--ierlst;
--erlst;
--rslst;
--nnlog;
--iord;
--elist;
--rlist;
--blist;
--alist__;
chebmo_dim1 = *maxp1;
chebmo_offset = 1 + chebmo_dim1 * 1;
chebmo -= chebmo_offset;
/* Function Body */
/* test on validity of parameters */
/* ------------------------------ */
/* ***first executable statement dqawfe */
*result = 0.;
*abserr = 0.;
*neval = 0;
*lst = 0;
*ier = 0;
if (*integr != 1 && *integr != 2 || *epsabs <= 0. || *limlst < 3) {
*ier = 6;
}
if (*ier == 6) {
goto L999;
}
if (*omega != 0.) {
goto L10;
}
/* integration by dqagie if omega is zero */
/* -------------------------------------- */
if (*integr == 1) {
dqagie_((D_fp)f, &c_b4, &c__1, epsabs, &c_b4, limit, result, abserr,
neval, ier, &alist__[1], &blist[1], &rlist[1], &elist[1], &
iord[1], &last);
}
rslst[1] = *result;
erlst[1] = *abserr;
ierlst[1] = *ier;
*lst = 1;
goto L999;
/* initializations */
/* --------------- */
L10:
l = (integer) abs(*omega);
dl = (doublereal) ((l << 1) + 1);
cycle = dl * pi / abs(*omega);
*ier = 0;
ktmin = 0;
*neval = 0;
numrl2 = 0;
nres = 0;
c1 = *a;
c2 = cycle + *a;
p1 = 1. - p;
uflow = d1mach_(&c__1);
eps = *epsabs;
if (*epsabs > uflow / p1) {
eps = *epsabs * p1;
}
ep = eps;
fact = 1.;
correc = 0.;
*abserr = 0.;
errsum = 0.;
/* main do-loop */
/* ------------ */
i__1 = *limlst;
for (*lst = 1; *lst <= i__1; ++(*lst)) {
/* integrate over current subinterval. */
dla = (doublereal) (*lst);
epsa = eps * fact;
dqawoe_((D_fp)f, &c1, &c2, omega, integr, &epsa, &c_b4, limit, lst,
maxp1, &rslst[*lst], &erlst[*lst], &nev, &ierlst[*lst], &last,
&alist__[1], &blist[1], &rlist[1], &elist[1], &iord[1], &
nnlog[1], &momcom, &chebmo[chebmo_offset]);
*neval += nev;
fact *= p;
errsum += erlst[*lst];
drl = (d__1 = rslst[*lst], abs(d__1)) * 50.;
/* test on accuracy with partial sum */
if (errsum + drl <= *epsabs && *lst >= 6) {
goto L80;
}
/* Computing MAX */
d__1 = correc, d__2 = erlst[*lst];
correc = max(d__1,d__2);
if (ierlst[*lst] != 0) {
/* Computing MAX */
d__1 = ep, d__2 = correc * p1;
eps = max(d__1,d__2);
}
if (ierlst[*lst] != 0) {
*ier = 7;
}
if (*ier == 7 && errsum + drl <= correc * 10. && *lst > 5) {
goto L80;
}
++numrl2;
if (*lst > 1) {
goto L20;
}
psum[0] = rslst[1];
goto L40;
L20:
psum[numrl2 - 1] = psum[ll - 1] + rslst[*lst];
if (*lst == 2) {
goto L40;
}
/* test on maximum number of subintervals */
if (*lst == *limlst) {
*ier = 1;
}
/* perform new extrapolation */
dqelg_(&numrl2, psum, &reseps, &abseps, res3la, &nres);
/* test whether extrapolated result is influenced by roundoff */
++ktmin;
if (ktmin >= 15 && *abserr <= (errsum + drl) * .001) {
*ier = 4;
}
if (abseps > *abserr && *lst != 3) {
goto L30;
}
*abserr = abseps;
*result = reseps;
ktmin = 0;
/* if ier is not 0, check whether direct result (partial sum) */
/* or extrapolated result yields the best integral */
/* approximation */
if (*abserr + correc * 10. <= *epsabs || *abserr <= *epsabs && correc
* 10. >= *epsabs) {
goto L60;
}
L30:
if (*ier != 0 && *ier != 7) {
goto L60;
}
L40:
ll = numrl2;
c1 = c2;
c2 += cycle;
/* L50: */
}
/* set final result and error estimate */
/* ----------------------------------- */
L60:
*abserr += correc * 10.;
if (*ier == 0) {
goto L999;
}
if (*result != 0. && psum[numrl2 - 1] != 0.) {
goto L70;
}
if (*abserr > errsum) {
goto L80;
}
if (psum[numrl2 - 1] == 0.) {
goto L999;
}
L70:
if (*abserr / abs(*result) > (errsum + drl) / (d__1 = psum[numrl2 - 1],
abs(d__1))) {
goto L80;
}
if (*ier >= 1 && *ier != 7) {
*abserr += drl;
}
goto L999;
L80:
*result = psum[numrl2 - 1];
*abserr = errsum + drl;
L999:
return 0;
} /* dqawfe_ */
