/* Subroutine */ int qawo_(E_fp f, real *a, real *b, real *omega, integer *
integr, real *epsabs, real *epsrel, real *result, real *abserr,
integer *neval, integer *ier, integer *leniw, integer *maxp1, integer
*lenw, integer *last, integer *iwork, real *work)
{
extern /* Subroutine */ int qawoe_(E_fp, real *, real *, real *, integer *
, real *, real *, integer *, integer *, integer *, real *, real *,
integer *, integer *, integer *, real *, real *, real *, real *,
integer *, integer *, integer *, real *);
integer limit, l1, l2, l3, l4, momcom;
extern /* Subroutine */ int xerror_(char *, integer *, integer *, integer
*, ftnlen);
integer lvl;
/* ***begin prologue qawo */
/* ***date written 800101 (yymmdd) */
/* ***revision date 830518 (yymmdd) */
/* ***category no. h2a2a1 */
/* ***keywords automatic integrator, special-purpose, */
/* integrand with oscillatory cos or sin factor, */
/* clenshaw-curtis method, (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(x)*w(x) over (a,b) */
/* where w(x) = cos(omega*x) or w(x) = sin(omega*x), */
/* hopefully satisfying following claim for accuracy */
/* abs(i-result).le.max(epsabs,epsrel*abs(i)). */
/* ***description */
/* computation of oscillatory integrals */
/* standard fortran subroutine */
/* real version */
/* parameters */
/* on entry */
/* f - real */
/* function subprogram defining the 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 */
/* omega - real */
/* parameter in the integrand weight function */
/* integr - integer */
/* indicates which of the weight functions 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 */
/* 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. */
/* 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 */
/* ier = 1 maximum number of subdivisions allowed */
/* (= leniw/2) has been achieved. one can */
/* allow more subdivisions by increasing the */
/* value of leniw (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 interior 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 */
/* due to roundoff in the extrapolation */
/* table, 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)) */
/* or (integr.ne.1 and integr.ne.2), */
/* or leniw.lt.2 or maxp1.lt.1 or */
/* lenw.lt.leniw*2+maxp1*25. */
/* result, abserr, neval, last are set to */
/* zero. except when leniw, maxp1 or lenw are */
/* invalid, work(limit*2+1), work(limit*3+1), */
/* iwork(1), iwork(limit+1) are set to zero, */
/* work(1) is set to a and work(limit+1) to */
/* b. */
/* dimensioning parameters */
/* leniw - integer */
/* dimensioning parameter for iwork. */
/* leniw/2 equals the maximum number of subintervals */
/* allowed in the partition of the given integration */
/* interval (a,b), leniw.ge.2. */
/* if leniw.lt.2, the routine will end with ier = 6. */
/* 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 */
/* if maxp1.lt.1, the routine will end with ier = 6. */
/* lenw - integer */
/* dimensioning parameter for work */
/* lenw must be at least leniw*2+maxp1*25. */
/* if lenw.lt.(leniw*2+maxp1*25), the routine will */
/* end with ier = 6. */
/* last - integer */
/* on return, last equals the number of subintervals */
/* produced in the subdivision process, which */
/* determines the number of significant elements */
/* actually in the work arrays. */
/* work arrays */
/* iwork - integer */
/* vector of dimension at least leniw */
/* on return, the first k elements of which contain */
/* pointers to the error estimates over the */
/* subintervals, such that work(limit*3+iwork(1)), .. */
/* work(limit*3+iwork(k)) form a decreasing */
/* sequence, with limit = lenw/2 , and k = last */
/* if last.le.(limit/2+2), and k = limit+1-last */
/* otherwise. */
/* furthermore, iwork(limit+1), ..., iwork(limit+ */
/* last) indicate the subdivision levels of the */
/* subintervals, such that iwork(limit+i) = l means */
/* that the subinterval numbered i is of length */
/* abs(b-a)*2**(1-l). */
/* work - real */
/* vector of dimension at least lenw */
/* on return */
/* work(1), ..., work(last) contain the left */
/* end points of the subintervals in the */
/* partition of (a,b), */
/* work(limit+1), ..., work(limit+last) contain */
/* the right end points, */
/* work(limit*2+1), ..., work(limit*2+last) contain */
/* the integral approximations over the */
/* subintervals, */
/* work(limit*3+1), ..., work(limit*3+last) */
/* contain the error estimates. */
/* work(limit*4+1), ..., work(limit*4+maxp1*25) */
/* provide space for storing the chebyshev moments. */
/* note that limit = lenw/2. */
/* ***references (none) */
/* ***routines called qawoe,xerror */
/* ***end prologue qawo */
/* check validity of leniw, maxp1 and lenw. */
/* ***first executable statement qawo */
/* Parameter adjustments */
--iwork;
--work;
/* Function Body */
*ier = 6;
*neval = 0;
*last = 0;
*result = (float)0.;
*abserr = (float)0.;
if (*leniw < 2 || *maxp1 < 1 || *lenw < (*leniw << 1) + *maxp1 * 25) {
goto L10;
}
/* prepare call for qawoe */
limit = *leniw / 2;
l1 = limit + 1;
l2 = limit + l1;
l3 = limit + l2;
l4 = limit + l3;
qawoe_((E_fp)f, a, b, omega, integr, epsabs, epsrel, &limit, &c__1, maxp1,
result, abserr, neval, ier, last, &work[1], &work[l1], &work[l2],
&work[l3], &iwork[1], &iwork[l1], &momcom, &work[l4]);
/* call error handler if necessary */
lvl = 0;
L10:
if (*ier == 6) {
lvl = 1;
}
if (*ier != 0) {
xerror_("abnormal return from qawo", &c__26, ier, &lvl, (ftnlen)26);
}
return 0;
} /* qawo_ */
/* 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 QAWO */
/* Subroutine */ int qawo_(E_fp f, real *a, real *b, real *omega, integer *
integr, real *epsabs, real *epsrel, real *result, real *abserr,
integer *neval, integer *ier, integer *leniw, integer *maxp1, integer
*lenw, integer *last, integer *iwork, real *work)
{
static integer l1, l2, l3, l4, lvl;
extern /* Subroutine */ int qawoe_(E_fp, real *, real *, real *, integer *
, real *, real *, integer *, integer *, integer *, real *, real *,
integer *, integer *, integer *, real *, real *, real *, real *,
integer *, integer *, integer *, real *);
static integer limit, momcom;
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
/* ***BEGIN PROLOGUE QAWO */
/* ***PURPOSE Calculate an approximation to a given definite integral */
/* I = Integral of F(X)*W(X) over (A,B), where */
/* W(X) = COS(OMEGA*X) */
/* or W(X) = SIN(OMEGA*X), */
/* hopefully satisfying the following claim for accuracy */
/* ABS(I-RESULT).LE.MAX(EPSABS,EPSREL*ABS(I)). */
/* ***LIBRARY SLATEC (QUADPACK) */
/* ***CATEGORY H2A2A1 */
/* ***TYPE SINGLE PRECISION (QAWO-S, DQAWO-D) */
/* ***KEYWORDS AUTOMATIC INTEGRATOR, CLENSHAW-CURTIS METHOD, */
/* EXTRAPOLATION, GLOBALLY ADAPTIVE, */
/* INTEGRAND WITH OSCILLATORY COS OR SIN FACTOR, QUADPACK, */
/* QUADRATURE, SPECIAL-PURPOSE */
/* ***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 oscillatory integrals */
/* Standard fortran subroutine */
/* Real version */
/* PARAMETERS */
/* ON ENTRY */
/* F - Real */
/* Function subprogram defining the 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 */
/* OMEGA - Real */
/* Parameter in the integrand weight function */
/* INTEGR - Integer */
/* Indicates which of the weight functions 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 */
/* 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. */
/* 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 */
/* IER = 1 Maximum number of subdivisions allowed */
/* has been achieved(= LENIW/2). One can */
/* allow more subdivisions by increasing the */
/* value of LENIW (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 interior 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 */
/* due to roundoff in the extrapolation */
/* table, 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)) */
/* or (INTEGR.NE.1 AND INTEGR.NE.2), */
/* or LENIW.LT.2 OR MAXP1.LT.1 or */
/* LENW.LT.LENIW*2+MAXP1*25. */
/* RESULT, ABSERR, NEVAL, LAST are set to */
/* zero. Except when LENIW, MAXP1 or LENW are */
/* invalid, WORK(LIMIT*2+1), WORK(LIMIT*3+1), */
/* IWORK(1), IWORK(LIMIT+1) are set to zero, */
/* WORK(1) is set to A and WORK(LIMIT+1) to */
/* B. */
/* DIMENSIONING PARAMETERS */
/* LENIW - Integer */
/* Dimensioning parameter for IWORK. */
/* LENIW/2 equals the maximum number of subintervals */
/* allowed in the partition of the given integration */
/* interval (A,B), LENIW.GE.2. */
/* If LENIW.LT.2, the routine will end with IER = 6. */
/* 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 */
/* If MAXP1.LT.1, the routine will end with IER = 6. */
/* LENW - Integer */
/* Dimensioning parameter for WORK */
/* LENW must be at least LENIW*2+MAXP1*25. */
/* If LENW.LT.(LENIW*2+MAXP1*25), the routine will */
/* end with IER = 6. */
/* LAST - Integer */
/* On return, LAST equals the number of subintervals */
/* produced in the subdivision process, which */
/* determines the number of significant elements */
/* actually in the WORK ARRAYS. */
/* WORK ARRAYS */
/* IWORK - Integer */
/* Vector of dimension at least LENIW */
/* on return, the first K elements of which contain */
/* pointers to the error estimates over the */
/* subintervals, such that WORK(LIMIT*3+IWORK(1)), .. */
/* WORK(LIMIT*3+IWORK(K)) form a decreasing */
/* sequence, with LIMIT = LENW/2 , and K = LAST */
/* if LAST.LE.(LIMIT/2+2), and K = LIMIT+1-LAST */
/* otherwise. */
/* Furthermore, IWORK(LIMIT+1), ..., IWORK(LIMIT+ */
/* LAST) indicate the subdivision levels of the */
/* subintervals, such that IWORK(LIMIT+I) = L means */
/* that the subinterval numbered I is of length */
/* ABS(B-A)*2**(1-L). */
/* WORK - Real */
/* Vector of dimension at least LENW */
/* On return */
/* WORK(1), ..., WORK(LAST) contain the left */
/* end points of the subintervals in the */
/* partition of (A,B), */
/* WORK(LIMIT+1), ..., WORK(LIMIT+LAST) contain */
/* the right end points, */
/* WORK(LIMIT*2+1), ..., WORK(LIMIT*2+LAST) contain */
/* the integral approximations over the */
/* subintervals, */
/* WORK(LIMIT*3+1), ..., WORK(LIMIT*3+LAST) */
/* contain the error estimates. */
/* WORK(LIMIT*4+1), ..., WORK(LIMIT*4+MAXP1*25) */
/* Provide space for storing the Chebyshev moments. */
/* Note that LIMIT = LENW/2. */
/* ***REFERENCES (NONE) */
/* ***ROUTINES CALLED QAWOE, XERMSG */
/* ***REVISION HISTORY (YYMMDD) */
/* 800101 DATE WRITTEN */
/* 890831 Modified array declarations. (WRB) */
/* 890831 REVISION DATE from Version 3.2 */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
/* ***END PROLOGUE QAWO */
/* CHECK VALIDITY OF LENIW, MAXP1 AND LENW. */
/* ***FIRST EXECUTABLE STATEMENT QAWO */
/* Parameter adjustments */
--work;
--iwork;
/* Function Body */
*ier = 6;
*neval = 0;
*last = 0;
*result = 0.f;
*abserr = 0.f;
if (*leniw < 2 || *maxp1 < 1 || *lenw < (*leniw << 1) + *maxp1 * 25) {
goto L10;
}
/* PREPARE CALL FOR QAWOE */
limit = *leniw / 2;
l1 = limit + 1;
l2 = limit + l1;
l3 = limit + l2;
l4 = limit + l3;
qawoe_((E_fp)f, a, b, omega, integr, epsabs, epsrel, &limit, &c__1, maxp1,
result, abserr, neval, ier, last, &work[1], &work[l1], &work[l2],
&work[l3], &iwork[1], &iwork[l1], &momcom, &work[l4]);
/* CALL ERROR HANDLER IF NECESSARY */
lvl = 0;
L10:
if (*ier == 6) {
lvl = 1;
}
if (*ier != 0) {
xermsg_("SLATEC", "QAWO", "ABNORMAL RETURN", ier, &lvl, (ftnlen)6, (
ftnlen)4, (ftnlen)15);
}
return 0;
} /* qawo_ */
