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
double precision function d1mach(i)
OCTAVE_EXPORT octave_value_list or class The return code an ordinary file in Octave s or(after appending @samp{.m}) a function file in Octave 's ode
OCTAVE_EXPORT octave_value_list etc The functions then dimension(columns)