/* Subroutine */ int qagse_(E_fp f, real *a, real *b, real *epsabs, real *
epsrel, integer *limit, real *result, real *abserr, integer *neval,
integer *ier, real *alist__, real *blist, real *rlist, real *elist,
integer *iord, integer *last)
{
/* System generated locals */
integer i__1, i__2;
real r__1, r__2;
/* Local variables */
real area;
extern /* Subroutine */ int qelg_(integer *, real *, real *, real *, real
*, integer *);
real dres;
integer ksgn, nres;
real area1, area2, area12;
integer k;
real small, erro12;
integer ierro;
real a1, a2, b1, b2, defab1, defab2, oflow;
integer ktmin, nrmax;
real uflow;
logical noext;
extern /* Subroutine */ int qpsrt_(integer *, integer *, integer *, real *
, real *, integer *, integer *);
extern doublereal r1mach_(integer *);
integer iroff1, iroff2, iroff3;
real res3la[3], error1, error2;
integer id;
real rlist2[52];
integer numrl2;
real defabs, epmach, erlarg, abseps, correc, errbnd, resabs;
integer jupbnd;
real erlast, errmax;
integer maxerr;
real reseps;
logical extrap;
real ertest, errsum;
extern /* Subroutine */ int qk21_(E_fp, real *, real *, real *, real *,
real *, real *);
/* ***begin prologue qagse */
/* ***date written 800101 (yymmdd) */
/* ***revision date 830518 (yymmdd) */
/* ***category no. h2a1a1 */
/* ***keywords automatic integrator, general-purpose, */
/* (end point) singularities, extrapolation, */
/* globally adaptive */
/* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
/* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
/* ***purpose the routine calculates an approximation result to a given */
/* definite integral i = integral of f over (a,b), */
/* hopefully satisfying following claim for accuracy */
/* abs(i-result).le.max(epsabs,epsrel*abs(i)). */
/* ***description */
/* computation of a definite integral */
/* standard fortran subroutine */
/* real version */
/* parameters */
/* on entry */
/* f - real */
/* 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 - real */
/* lower limit of integration */
/* b - real */
/* upper limit of integration */
/* epsabs - real */
/* absolute accuracy requested */
/* epsrel - real */
/* 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 upperbound on the number of subintervals */
/* in the partition of (a,b) */
/* on return */
/* result - real */
/* approximation to the integral */
/* abserr - real */
/* 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 integral and error are */
/* less reliable. it is assumed that the */
/* requested accuracy has not been achieved. */
/* error messages */
/* = 1 maximum number of subdivisions allowed */
/* has been achieved. one can allow more sub- */
/* divisions 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 detec- */
/* ted, 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 presumed 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), */
/* iord(1) and elist(1) are set to zero. */
/* alist(1) and blist(1) are set to a and b */
/* respectively. */
/* alist - real */
/* 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 */
/* given integration range (a,b) */
/* blist - real */
/* 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 given */
/* integration range (a,b) */
/* rlist - real */
/* vector of dimension at least limit, the first */
/* last elements of which are the integral */
/* approximations on the subintervals */
/* elist - real */
/* 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 at least 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 qelg,qk21,qpsrt,r1mach */
/* ***end prologue qagse */
/* the dimension of rlist2 is determined by the value of */
/* limexp in subroutine qelg (rlist2 should be of dimension */
/* (limexp+2) at least). */
/* 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 interval */
/* *****2 - variable for the right interval */
/* 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 qagse */
/* Parameter adjustments */
--iord;
--elist;
--rlist;
--blist;
--alist__;
/* Function Body */
epmach = r1mach_(&c__4);
/* test on validity of parameters */
/* ------------------------------ */
*ier = 0;
*neval = 0;
*last = 0;
*result = (float)0.;
*abserr = (float)0.;
alist__[1] = *a;
blist[1] = *b;
rlist[1] = (float)0.;
elist[1] = (float)0.;
/* Computing MAX */
r__1 = epmach * (float)50.;
if (*epsabs <= (float)0. && *epsrel < dmax(r__1,(float)5e-15)) {
*ier = 6;
}
if (*ier == 6) {
goto L999;
}
/* first approximation to the integral */
/* ----------------------------------- */
uflow = r1mach_(&c__1);
oflow = r1mach_(&c__2);
ierro = 0;
qk21_((E_fp)f, a, b, result, abserr, &defabs, &resabs);
/* test on accuracy. */
dres = dabs(*result);
/* Computing MAX */
r__1 = *epsabs, r__2 = *epsrel * dres;
errbnd = dmax(r__1,r__2);
*last = 1;
rlist[1] = *result;
elist[1] = *abserr;
iord[1] = 1;
if (*abserr <= epmach * (float)100. * defabs && *abserr > errbnd) {
*ier = 2;
}
if (*limit == 1) {
*ier = 1;
}
if (*ier != 0 || *abserr <= errbnd && *abserr != resabs || *abserr == (
float)0.) {
goto L140;
}
/* initialization */
/* -------------- */
rlist2[0] = *result;
errmax = *abserr;
maxerr = 1;
area = *result;
errsum = *abserr;
*abserr = oflow;
nrmax = 1;
nres = 0;
numrl2 = 2;
ktmin = 0;
extrap = FALSE_;
noext = FALSE_;
iroff1 = 0;
iroff2 = 0;
iroff3 = 0;
ksgn = -1;
if (dres >= ((float)1. - epmach * (float)50.) * defabs) {
ksgn = 1;
}
/* main do-loop */
/* ------------ */
i__1 = *limit;
for (*last = 2; *last <= i__1; ++(*last)) {
/* bisect the subinterval with the nrmax-th largest */
/* error estimate. */
a1 = alist__[maxerr];
b1 = (alist__[maxerr] + blist[maxerr]) * (float).5;
a2 = b1;
b2 = blist[maxerr];
erlast = errmax;
qk21_((E_fp)f, &a1, &b1, &area1, &error1, &resabs, &defab1);
qk21_((E_fp)f, &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 ((r__1 = rlist[maxerr] - area12, dabs(r__1)) > dabs(area12) * (
float)1e-5 || erro12 < errmax * (float).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 */
r__1 = *epsabs, r__2 = *epsrel * dabs(area);
errbnd = dmax(r__1,r__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 a point of the integration range. */
/* Computing MAX */
r__1 = dabs(a1), r__2 = dabs(b2);
if (dmax(r__1,r__2) <= (epmach * (float)100. + (float)1.) * (dabs(a2)
+ uflow * (float)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 qpsrt 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:
qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
/* ***jump out of do-loop */
if (errsum <= errbnd) {
goto L115;
}
/* ***jump out of do-loop */
if (*ier != 0) {
goto L100;
}
if (*last == 2) {
goto L80;
}
if (noext) {
goto L90;
}
erlarg -= erlast;
if ((r__1 = b1 - a1, dabs(r__1)) > small) {
erlarg += erro12;
}
if (extrap) {
goto L40;
}
/* test whether the interval to be bisected next is the */
/* smallest interval. */
if ((r__1 = blist[maxerr] - alist__[maxerr], dabs(r__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];
/* ***jump out of do-loop */
if ((r__1 = blist[maxerr] - alist__[maxerr], dabs(r__1)) > small)
{
goto L90;
}
++nrmax;
/* L50: */
}
/* perform extrapolation. */
L60:
++numrl2;
rlist2[numrl2 - 1] = area;
qelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
++ktmin;
if (ktmin > 5 && *abserr < errsum * (float).001) {
*ier = 5;
}
if (abseps >= *abserr) {
goto L70;
}
ktmin = 0;
*abserr = abseps;
*result = reseps;
correc = erlarg;
/* Computing MAX */
r__1 = *epsabs, r__2 = *epsrel * dabs(reseps);
ertest = dmax(r__1,r__2);
/* ***jump out of do-loop */
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 *= (float).5;
erlarg = errsum;
goto L90;
L80:
small = (r__1 = *b - *a, dabs(r__1)) * (float).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 != (float)0. && area != (float)0.) {
goto L105;
}
if (*abserr > errsum) {
goto L115;
}
if (area == (float)0.) {
goto L130;
}
goto L110;
L105:
if (*abserr / dabs(*result) > errsum / dabs(area)) {
goto L115;
}
/* test on divergence. */
L110:
/* Computing MAX */
r__1 = dabs(*result), r__2 = dabs(area);
if (ksgn == -1 && dmax(r__1,r__2) <= defabs * (float).01) {
goto L130;
}
if ((float).01 > *result / area || *result / area > (float)100. || errsum
> dabs(area)) {
*ier = 6;
}
goto L130;
/* compute global integral sum. */
L115:
*result = (float)0.;
i__1 = *last;
for (k = 1; k <= i__1; ++k) {
*result += rlist[k];
/* L120: */
}
*abserr = errsum;
L130:
if (*ier > 2) {
--(*ier);
}
L140:
*neval = *last * 42 - 21;
L999:
return 0;
} /* qagse_ */
/* Subroutine */ int qawfe_(U_fp f, real *a, real *omega, integer *integr,
real *epsabs, integer *limlst, integer *limit, integer *maxp1, real *
result, real *abserr, integer *neval, integer *ier, real *rslst, real
*erlst, integer *ierlst, integer *lst, real *alist__, real *blist,
real *rlist, real *elist, integer *iord, integer *nnlog, real *chebmo)
{
/* Initialized data */
static real p = (float).9;
static real pi = (float)3.1415926535897932;
/* System generated locals */
integer chebmo_dim1, chebmo_offset, i__1;
real r__1, r__2;
/* Local variables */
real fact, epsa;
extern /* Subroutine */ int qelg_(integer *, real *, real *, real *, real
*, integer *);
integer last, nres;
real psum[52];
integer l;
extern /* Subroutine */ int qagie_(U_fp, real *, integer *, real *, real *
, integer *, real *, real *, integer *, integer *, real *, real *,
real *, real *, integer *, integer *);
real cycle;
extern /* Subroutine */ int qawoe_(U_fp, real *, real *, real *, integer *
, real *, real *, integer *, integer *, integer *, real *, real *,
integer *, integer *, integer *, real *, real *, real *, real *,
integer *, integer *, integer *, real *);
integer ktmin;
real c1, c2, uflow, p1;
extern doublereal r1mach_(integer *);
real res3la[3];
integer numrl2;
real dl, ep;
integer ll;
real abseps, correc;
integer momcom;
real reseps, errsum, dla, drl, eps;
integer nev;
/* ***begin prologue qawfe */
/* ***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 */
/* real version */
/* parameters */
/* on entry */
/* f - real */
/* 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 - real */
/* lower limit of integration */
/* omega - real */
/* 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 - real */
/* 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 - real */
/* approximation to the integral x */
/* abserr - real */
/* 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 - real */
/* 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 - real */
/* 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 - real */
/* 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 - real */
/* array of dimension at least (maxp1,25), providing */
/* space for the chebyshev moments needed within the */
/* cycles */
/* ***references (none) */
/* ***routines called qagie,qawoe,qelg,r1mach */
/* ***end prologue qawfe */
/* the dimension of psum is determined by the value of */
/* limexp in subroutine qelg (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 qelg) */
/* 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 qc25f) */
/* 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 qawfe */
*result = (float)0.;
*abserr = (float)0.;
*neval = 0;
*lst = 0;
*ier = 0;
if (*integr != 1 && *integr != 2 || *epsabs <= (float)0. || *limlst < 3) {
*ier = 6;
}
if (*ier == 6) {
goto L999;
}
if (*omega != (float)0.) {
goto L10;
}
/* integration by qagie if omega is zero */
/* -------------------------------------- */
if (*integr == 1) {
qagie_((U_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 = dabs(*omega);
dl = (real) ((l << 1) + 1);
cycle = dl * pi / dabs(*omega);
*ier = 0;
ktmin = 0;
*neval = 0;
numrl2 = 0;
nres = 0;
c1 = *a;
c2 = cycle + *a;
p1 = (float)1. - p;
eps = *epsabs;
uflow = r1mach_(&c__1);
if (*epsabs > uflow / p1) {
eps = *epsabs * p1;
}
ep = eps;
fact = (float)1.;
correc = (float)0.;
*abserr = (float)0.;
errsum = (float)0.;
/* main do-loop */
/* ------------ */
i__1 = *limlst;
for (*lst = 1; *lst <= i__1; ++(*lst)) {
/* integrate over current subinterval. */
dla = (real) (*lst);
epsa = eps * fact;
qawoe_((U_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 = (r__1 = rslst[*lst], dabs(r__1)) * (float)50.;
/* test on accuracy with partial sum */
if (errsum + drl <= *epsabs && *lst >= 6) {
goto L80;
}
/* Computing MAX */
r__1 = correc, r__2 = erlst[*lst];
correc = dmax(r__1,r__2);
if (ierlst[*lst] != 0) {
/* Computing MAX */
r__1 = ep, r__2 = correc * p1;
eps = dmax(r__1,r__2);
}
if (ierlst[*lst] != 0) {
*ier = 7;
}
if (*ier == 7 && errsum + drl <= correc * (float)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 */
qelg_(&numrl2, psum, &reseps, &abseps, res3la, &nres);
/* test whether extrapolated result is influenced by */
/* roundoff */
++ktmin;
if (ktmin >= 15 && *abserr <= (errsum + drl) * (float).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 * (float)10. <= *epsabs || *abserr <= *epsabs &&
correc * (float)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 * (float)10.;
if (*ier == 0) {
goto L999;
}
if (*result != (float)0. && psum[numrl2 - 1] != (float)0.) {
goto L70;
}
if (*abserr > errsum) {
goto L80;
}
if (psum[numrl2 - 1] == (float)0.) {
goto L999;
}
L70:
if (*abserr / dabs(*result) > (errsum + drl) / (r__1 = psum[numrl2 - 1],
dabs(r__1))) {
goto L80;
}
if (*ier >= 1 && *ier != 7) {
*abserr += drl;
}
goto L999;
L80:
*result = psum[numrl2 - 1];
*abserr = errsum + drl;
L999:
return 0;
} /* qawfe_ */
/* DECK QAGSE */
/* Subroutine */ int qagse_(E_fp f, real *a, real *b, real *epsabs, real *
epsrel, integer *limit, real *result, real *abserr, integer *neval,
integer *ier, real *alist__, real *blist, real *rlist, real *elist,
integer *iord, integer *last)
{
/* System generated locals */
integer i__1, i__2;
real r__1, r__2;
/* Local variables */
static integer k;
static real a1, a2, b1, b2;
static integer id;
extern /* Subroutine */ int qk21_(E_fp, real *, real *, real *, real *,
real *, real *);
static real area;
extern /* Subroutine */ int qelg_(integer *, real *, real *, real *, real
*, integer *);
static real dres;
static integer ksgn, nres;
static real area1, area2, area12, small, erro12;
static integer ierro;
static real defab1, defab2;
static integer ktmin, nrmax;
static real oflow, uflow;
static logical noext;
extern /* Subroutine */ int qpsrt_(integer *, integer *, integer *, real *
, real *, integer *, integer *);
extern doublereal r1mach_(integer *);
static integer iroff1, iroff2, iroff3;
static real res3la[3], error1, error2, rlist2[52];
static integer numrl2;
static real defabs, epmach, erlarg, abseps, correc, errbnd, resabs;
static integer jupbnd;
static real erlast, errmax;
static integer maxerr;
static real reseps;
static logical extrap;
static real ertest, errsum;
/* ***BEGIN PROLOGUE QAGSE */
/* ***PURPOSE The routine calculates an approximation result to a given */
/* definite integral I = Integral of F over (A,B), */
/* hopefully satisfying following claim for accuracy */
/* ABS(I-RESULT).LE.MAX(EPSABS,EPSREL*ABS(I)). */
/* ***LIBRARY SLATEC (QUADPACK) */
/* ***CATEGORY H2A1A1 */
/* ***TYPE SINGLE PRECISION (QAGSE-S, DQAGSE-D) */
/* ***KEYWORDS AUTOMATIC INTEGRATOR, END POINT SINGULARITIES, */
/* EXTRAPOLATION, GENERAL-PURPOSE, GLOBALLY ADAPTIVE, */
/* QUADPACK, QUADRATURE */
/* ***AUTHOR Piessens, Robert */
/* Applied Mathematics and Programming Division */
/* K. U. Leuven */
/* de Doncker, Elise */
/* Applied Mathematics and Programming Division */
/* K. U. Leuven */
/* ***DESCRIPTION */
/* Computation of a definite integral */
/* Standard fortran subroutine */
/* Real version */
/* PARAMETERS */
/* ON ENTRY */
/* F - Real */
/* 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 - Real */
/* Lower limit of integration */
/* B - Real */
/* Upper limit of integration */
/* EPSABS - Real */
/* Absolute accuracy requested */
/* EPSREL - Real */
/* 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) */
/* ON RETURN */
/* RESULT - Real */
/* Approximation to the integral */
/* ABSERR - Real */
/* 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 integral and error are */
/* less reliable. It is assumed that the */
/* requested accuracy has not been achieved. */
/* ERROR MESSAGES */
/* = 1 Maximum number of subdivisions allowed */
/* has been achieved. One can allow more sub- */
/* divisions 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 detec- */
/* ted, 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 presumed 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), */
/* IORD(1) and ELIST(1) are set to zero. */
/* ALIST(1) and BLIST(1) are set to A and B */
/* respectively. */
/* ALIST - Real */
/* 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 */
/* given integration range (A,B) */
/* BLIST - Real */
/* 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 given */
/* integration range (A,B) */
/* RLIST - Real */
/* Vector of dimension at least LIMIT, the first */
/* LAST elements of which are the integral */
/* approximations on the subintervals */
/* ELIST - Real */
/* 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 at least 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 QELG, QK21, QPSRT, R1MACH */
/* ***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 QAGSE */
/* THE DIMENSION OF RLIST2 IS DETERMINED BY THE VALUE OF */
/* LIMEXP IN SUBROUTINE QELG (RLIST2 SHOULD BE OF DIMENSION */
/* (LIMEXP+2) AT LEAST). */
/* 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 INTERVAL */
/* *****2 - VARIABLE FOR THE RIGHT INTERVAL */
/* 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 QAGSE */
/* Parameter adjustments */
--iord;
--elist;
--rlist;
--blist;
--alist__;
/* Function Body */
epmach = r1mach_(&c__4);
/* TEST ON VALIDITY OF PARAMETERS */
/* ------------------------------ */
*ier = 0;
*neval = 0;
*last = 0;
*result = 0.f;
*abserr = 0.f;
alist__[1] = *a;
blist[1] = *b;
rlist[1] = 0.f;
elist[1] = 0.f;
/* Computing MAX */
r__1 = epmach * 50.f;
if (*epsabs <= 0.f && *epsrel < dmax(r__1,5e-15f)) {
*ier = 6;
}
if (*ier == 6) {
goto L999;
}
/* FIRST APPROXIMATION TO THE INTEGRAL */
/* ----------------------------------- */
uflow = r1mach_(&c__1);
oflow = r1mach_(&c__2);
ierro = 0;
qk21_((E_fp)f, a, b, result, abserr, &defabs, &resabs);
/* TEST ON ACCURACY. */
dres = dabs(*result);
/* Computing MAX */
r__1 = *epsabs, r__2 = *epsrel * dres;
errbnd = dmax(r__1,r__2);
*last = 1;
rlist[1] = *result;
elist[1] = *abserr;
iord[1] = 1;
if (*abserr <= epmach * 100.f * defabs && *abserr > errbnd) {
*ier = 2;
}
if (*limit == 1) {
*ier = 1;
}
if (*ier != 0 || *abserr <= errbnd && *abserr != resabs || *abserr == 0.f)
{
goto L140;
}
/* INITIALIZATION */
/* -------------- */
rlist2[0] = *result;
errmax = *abserr;
maxerr = 1;
area = *result;
errsum = *abserr;
*abserr = oflow;
nrmax = 1;
nres = 0;
numrl2 = 2;
ktmin = 0;
extrap = FALSE_;
noext = FALSE_;
iroff1 = 0;
iroff2 = 0;
iroff3 = 0;
ksgn = -1;
if (dres >= (1.f - epmach * 50.f) * defabs) {
ksgn = 1;
}
/* MAIN DO-LOOP */
/* ------------ */
i__1 = *limit;
for (*last = 2; *last <= i__1; ++(*last)) {
/* BISECT THE SUBINTERVAL WITH THE NRMAX-TH LARGEST */
/* ERROR ESTIMATE. */
a1 = alist__[maxerr];
b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
a2 = b1;
b2 = blist[maxerr];
erlast = errmax;
qk21_((E_fp)f, &a1, &b1, &area1, &error1, &resabs, &defab1);
qk21_((E_fp)f, &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 ((r__1 = rlist[maxerr] - area12, dabs(r__1)) > dabs(area12) *
1e-5f || erro12 < errmax * .99f) {
goto L10;
}
if (extrap) {
++iroff2;
}
if (! extrap) {
++iroff1;
}
L10:
if (*last > 10 && erro12 > errmax) {
++iroff3;
}
L15:
rlist[maxerr] = area1;
rlist[*last] = area2;
/* Computing MAX */
r__1 = *epsabs, r__2 = *epsrel * dabs(area);
errbnd = dmax(r__1,r__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 A POINT OF THE INTEGRATION RANGE. */
/* Computing MAX */
r__1 = dabs(a1), r__2 = dabs(b2);
if (dmax(r__1,r__2) <= (epmach * 100.f + 1.f) * (dabs(a2) + uflow *
1e3f)) {
*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 QPSRT 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:
qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
/* ***JUMP OUT OF DO-LOOP */
if (errsum <= errbnd) {
goto L115;
}
/* ***JUMP OUT OF DO-LOOP */
if (*ier != 0) {
goto L100;
}
if (*last == 2) {
goto L80;
}
if (noext) {
goto L90;
}
erlarg -= erlast;
if ((r__1 = b1 - a1, dabs(r__1)) > small) {
erlarg += erro12;
}
if (extrap) {
goto L40;
}
/* TEST WHETHER THE INTERVAL TO BE BISECTED NEXT IS THE */
/* SMALLEST INTERVAL. */
if ((r__1 = blist[maxerr] - alist__[maxerr], dabs(r__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];
/* ***JUMP OUT OF DO-LOOP */
if ((r__1 = blist[maxerr] - alist__[maxerr], dabs(r__1)) > small)
{
goto L90;
}
++nrmax;
/* L50: */
}
/* PERFORM EXTRAPOLATION. */
L60:
++numrl2;
rlist2[numrl2 - 1] = area;
qelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
++ktmin;
if (ktmin > 5 && *abserr < errsum * .001f) {
*ier = 5;
}
if (abseps >= *abserr) {
goto L70;
}
ktmin = 0;
*abserr = abseps;
*result = reseps;
correc = erlarg;
/* Computing MAX */
r__1 = *epsabs, r__2 = *epsrel * dabs(reseps);
ertest = dmax(r__1,r__2);
/* ***JUMP OUT OF DO-LOOP */
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 *= .5f;
erlarg = errsum;
goto L90;
L80:
small = (r__1 = *b - *a, dabs(r__1)) * .375f;
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.f && area != 0.f) {
goto L105;
}
if (*abserr > errsum) {
goto L115;
}
if (area == 0.f) {
goto L130;
}
goto L110;
L105:
if (*abserr / dabs(*result) > errsum / dabs(area)) {
goto L115;
}
/* TEST ON DIVERGENCE. */
L110:
/* Computing MAX */
r__1 = dabs(*result), r__2 = dabs(area);
if (ksgn == -1 && dmax(r__1,r__2) <= defabs * .01f) {
goto L130;
}
if (.01f > *result / area || *result / area > 100.f || errsum > dabs(area)
) {
*ier = 6;
}
goto L130;
/* COMPUTE GLOBAL INTEGRAL SUM. */
L115:
*result = 0.f;
i__1 = *last;
for (k = 1; k <= i__1; ++k) {
*result += rlist[k];
/* L120: */
}
*abserr = errsum;
L130:
if (*ier > 2) {
--(*ier);
}
L140:
*neval = *last * 42 - 21;
L999:
return 0;
} /* qagse_ */
