/* 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_ */