1 SUBROUTINE dqagie(F,BOUND,INF,EPSABS,EPSREL,LIMIT,RESULT,ABSERR,
2 * neval,ier,alist,blist,rlist,elist,iord,last)
152 DOUBLE PRECISION ABSEPS,ABSERR,ALIST,AREA,AREA1,AREA12,AREA2,A1,
153 * a2,blist,boun,bound,b1,b2,correc,dabs,defabs,defab1,defab2,
154 * dmax1,dres,d1mach,elist,epmach,epsabs,epsrel,erlarg,erlast,
155 * errbnd,errmax,error1,error2,erro12,errsum,ertest,oflow,resabs,
156 * reseps,result,res3la,rlist,rlist2,small,
uflow
157 INTEGER ID,IER,IERRO,INF,IORD,IROFF1,IROFF2,IROFF3,JUPBND,K,KSGN,
158 * ktmin,last,limit,maxerr,neval,nres,nrmax,numrl2
161 dimension alist(limit),blist(limit),elist(limit),iord(limit),
162 * res3la(3),rlist(limit),rlist2(52)
235 IF(epsabs.LE.0.0d+00.AND.epsrel.LT.dmax1(0.5d+02*epmach,0.5d-28))
237 IF(ier.EQ.6) go to 999
249 IF(inf.EQ.2) boun = 0.0d+00
250 CALL
dqk15i(f,boun,inf,0.0d+00,0.1d+01,result,abserr,
252 IF (ier .LT. 0)
RETURN
261 errbnd = dmax1(epsabs,epsrel*dres)
262 IF(abserr.LE.1.0d+02*epmach*defabs.AND.abserr.GT.errbnd) ier = 2
263 IF(limit.EQ.1) ier = 1
264 IF(ier.NE.0.OR.(abserr.LE.errbnd.AND.abserr.NE.resabs).OR.
265 * abserr.EQ.0.0d+00) go to 130
289 IF(dres.GE.(0.1d+01-0.5d+02*epmach)*defabs) ksgn = 1
299 b1 = 0.5d+00*(alist(maxerr)+blist(maxerr))
303 CALL
dqk15i(f,boun,inf,a1,b1,area1,error1,resabs,defab1,ier)
304 IF (ier .LT. 0)
RETURN
305 CALL
dqk15i(f,boun,inf,a2,b2,area2,error2,resabs,defab2,ier)
306 IF (ier .LT. 0)
RETURN
312 erro12 = error1+error2
313 errsum = errsum+erro12-errmax
314 area = area+area12-rlist(maxerr)
315 IF(defab1.EQ.error1.OR.defab2.EQ.error2)go to 15
316 IF(dabs(rlist(maxerr)-area12).GT.0.1d-04*dabs(area12)
317 * .OR.erro12.LT.0.99d+00*errmax) go to 10
318 IF(extrap) iroff2 = iroff2+1
319 IF(.NOT.extrap) iroff1 = iroff1+1
320 10
IF(last.GT.10.AND.erro12.GT.errmax) iroff3 = iroff3+1
321 15 rlist(maxerr) = area1
323 errbnd = dmax1(epsabs,epsrel*dabs(area))
327 IF(iroff1+iroff2.GE.10.OR.iroff3.GE.20) ier = 2
328 IF(iroff2.GE.5) ierro = 3
333 IF(last.EQ.limit) ier = 1
338 IF(dmax1(dabs(a1),dabs(b2)).LE.(0.1d+01+0.1d+03*epmach)*
339 * (dabs(a2)+0.1d+04*
uflow)) ier = 4
343 IF(error2.GT.error1) go to 20
347 elist(maxerr) = error1
350 20 alist(maxerr) = a2
353 rlist(maxerr) = area2
355 elist(maxerr) = error2
362 30 CALL
dqpsrt(limit,last,maxerr,errmax,elist,iord,nrmax)
363 IF(errsum.LE.errbnd) go to 115
364 IF(ier.NE.0) go to 100
365 IF(last.EQ.2) go to 80
367 erlarg = erlarg-erlast
368 IF(dabs(b1-a1).GT.small) erlarg = erlarg+erro12
374 IF(dabs(blist(maxerr)-alist(maxerr)).GT.small) go to 90
377 40
IF(ierro.EQ.3.OR.erlarg.LE.ertest) go to 60
385 IF(last.GT.(2+limit/2)) jupbnd = limit+3-last
388 errmax = elist(maxerr)
389 IF(dabs(blist(maxerr)-alist(maxerr)).GT.small) go to 90
396 rlist2(numrl2) = area
397 CALL
dqelg(numrl2,rlist2,reseps,abseps,res3la,nres)
399 IF(ktmin.GT.5.AND.abserr.LT.0.1d-02*errsum) ier = 5
400 IF(abseps.GE.abserr) go to 70
405 ertest = dmax1(epsabs,epsrel*dabs(reseps))
406 IF(abserr.LE.ertest) go to 100
410 70
IF(numrl2.EQ.1) noext = .true.
411 IF(ier.EQ.5) go to 100
413 errmax = elist(maxerr)
416 small = small*0.5d+00
428 100
IF(abserr.EQ.oflow) go to 115
429 IF((ier+ierro).EQ.0) go to 110
430 IF(ierro.EQ.3) abserr = abserr+correc
432 IF(result.NE.0.0d+00.AND.area.NE.0.0d+00)go to 105
433 IF(abserr.GT.errsum)go to 115
434 IF(area.EQ.0.0d+00) go to 130
436 105
IF(abserr/dabs(result).GT.errsum/dabs(area))go to 115
440 110
IF(ksgn.EQ.(-1).AND.dmax1(dabs(result),dabs(area)).LE.
441 * defabs*0.1d-01) go to 130
442 IF(0.1d-01.GT.(result/area).OR.(result/area).GT.0.1d+03.
443 *or.errsum.GT.dabs(area)) ier = 6
450 result = result+rlist(k)
453 130 neval = 30*last-15
454 IF(inf.EQ.2) neval = 2*neval
455 IF(ier.GT.2) ier=ier-1
subroutine dqelg(N, EPSTAB, RESULT, ABSERR, RES3LA, NRES)
std::string dimension(void) const
subroutine dqk15i(F, BOUN, INF, A, B, RESULT, ABSERR, RESABS, RESASC, IERR)
subroutine dqpsrt(LIMIT, LAST, MAXERR, ERMAX, ELIST, IORD, NRMAX)
subroutine dqagie(F, BOUND, INF, EPSABS, EPSREL, LIMIT, RESULT, ABSERR, NEVAL, IER, ALIST, BLIST, RLIST, ELIST, IORD, LAST)