subroutine dqawse(f, a, b, alfa, beta, integr, epsabs, epsrel, limit, result, abserr, neval, ier, alist, blist, rlist, elist, iord, last)
double precision :: a, abserr, alfa, alist, area, area1, area12, area2, a1, a2, b, beta, blist, b1, b2, centre, dabs, dmax1, d1mach, elist, epmach, epsabs, epsrel, errbnd, errmax, error1, erro12, error2, errsum, f, resas1, resas2, result, rg, rh, ri, rj, rlist, uflow
integer :: ier, integr, iord, iroff1, iroff2, k, last, limit, maxerr, nev, neval, nrmax
external :: f
dimension :: alist(limit), blist(limit), rlist(limit), elist(limit), iord(limit), ri(25), rj(25), rh(25), rg(25)
epmach = d1mach(4)
uflow = d1mach(1)
ier = 6
neval = 0
last = 0
rlist(1) = 0.0d+00
elist(1) = 0.0d+00
iord(1) = 0
result = 0.0d+00
abserr = 0.0d+00
if (b <= a .or. epsabs == 0.0d+00 .and. epsrel < dmax1(0.5d+02*epmach, 0.5d-28) .or. alfa <= -0.1d+01 .or. beta <= -0.1d+01 .or. integr < 1 .or. integr > 4 .or. limit < 2) then
    go to 999
end if
ier = 0
call dqmomo(alfa, beta, ri, rj, rg, rh, integr)
centre = 0.5d+00*(b + a)
call dqc25s(f, a, b, a, centre, alfa, beta, ri, rj, rg, rh, area1, error1, resas1, integr, nev)
neval = nev
call dqc25s(f, a, b, centre, b, alfa, beta, ri, rj, rg, rh, area2, error2, resas2, integr, nev)
last = 2
neval = neval + nev
result = area1 + area2
abserr = error1 + error2
errbnd = dmax1(epsabs, epsrel*dabs(result))
if (error2 > error1) then
    go to 10
end if
alist(1) = a
alist(2) = centre
blist(1) = centre
blist(2) = b
rlist(1) = area1
rlist(2) = area2
elist(1) = error1
elist(2) = error2
go to 20
10 alist(1) = centre
alist(2) = a
blist(1) = b
blist(2) = centre
rlist(1) = area2
rlist(2) = area1
elist(1) = error2
elist(2) = error1
20 iord(1) = 1
iord(2) = 2
if (limit == 2) then
    ier = 1
end if
if (abserr <= errbnd .or. ier == 1) then
    go to 999
end if
errmax = elist(1)
maxerr = 1
nrmax = 1
area = result
errsum = abserr
iroff1 = 0
iroff2 = 0
do last = 3, limit
    a1 = alist(maxerr)
    b1 = 0.5d+00*(alist(maxerr) + blist(maxerr))
    a2 = b1
    b2 = blist(maxerr)
    call dqc25s(f, a, b, a1, b1, alfa, beta, ri, rj, rg, rh, area1, error1, resas1, integr, nev)
    neval = neval + nev
    call dqc25s(f, a, b, a2, b2, alfa, beta, ri, rj, rg, rh, area2, error2, resas2, integr, nev)
    neval = neval + nev
    area12 = area1 + area2
    erro12 = error1 + error2
    errsum = errsum + erro12 - errmax
    area = area + area12 - rlist(maxerr)
    if (a == a1 .or. b == b2) then
        go to 30
    end if
    if (resas1 == error1 .or. resas2 == error2) then
        go to 30
    end if
    if (dabs(rlist(maxerr) - area12) < 0.1d-04*dabs(area12) .and. erro12 >= 0.99d+00*errmax) then
        iroff1 = iroff1 + 1
    end if
    if (last > 10 .and. erro12 > errmax) then
        iroff2 = iroff2 + 1
    end if
    30 rlist(maxerr) = area1
    rlist(last) = area2
    errbnd = dmax1(epsabs, epsrel*dabs(area))
    if (errsum <= errbnd) then
        go to 35
    end if
    if (last == limit) then
        ier = 1
    end if
    if (iroff1 >= 6 .or. iroff2 >= 20) then
        ier = 2
    end if
    if (dmax1(dabs(a1), dabs(b2)) <= (0.1d+01 + 0.1d+03*epmach)*(dabs(a2) + 0.1d+04*uflow)) then
        ier = 3
    end if
    35 if (error2 > error1) then
        go to 40
    end if
    alist(last) = a2
    blist(maxerr) = b1
    blist(last) = b2
    elist(maxerr) = error1
    elist(last) = error2
    go to 50
    40 alist(maxerr) = a2
    alist(last) = a1
    blist(last) = b1
    rlist(maxerr) = area2
    rlist(last) = area1
    elist(maxerr) = error2
    elist(last) = error1
    50 call dqpsrt(limit, last, maxerr, errmax, elist, iord, nrmax)
    if (ier /= 0 .or. errsum <= errbnd) then
        go to 70
    end if
    60 continue
end do
70 result = 0.0d+00
do k = 1, last
    result = result + rlist(k)
    80 continue
end do
abserr = errsum
999 return
end subroutine dqawse
