subroutine dqpsrt(limit,last,maxerr,ermax,elist,iord,nrmax) c***begin prologue dqpsrt c***refer to dqage,dqagie,dqagpe,dqawse c***routines called (none) c***revision date 810101 (yymmdd) c***keywords sequential sorting c***author piessens,robert,appl. math. & progr. div. - k.u.leuven c de doncker,elise,appl. math. & progr. div. - k.u.leuven c***purpose this routine maintains the descending ordering in the c list of the local error estimated resulting from the c interval subdivision process. at each call two error c estimates are inserted using the sequential search c method, top-down for the largest error estimate and c bottom-up for the smallest error estimate. c***description c c ordering routine c standard fortran subroutine c double precision version c c parameters (meaning at output) c limit - integer c maximum number of error estimates the list c can contain c c last - integer c number of error estimates currently in the list c c maxerr - integer c maxerr points to the nrmax-th largest error c estimate currently in the list c c ermax - double precision c nrmax-th largest error estimate c ermax = elist(maxerr) c c elist - double precision c vector of dimension last containing c the error estimates c c iord - integer c vector of dimension last, the first k elements c of which contain pointers to the error c estimates, such that c elist(iord(1)),..., elist(iord(k)) c form a decreasing sequence, with c k = last if last.le.(limit/2+2), and c k = limit+1-last otherwise c c nrmax - integer c maxerr = iord(nrmax) c c***end prologue dqpsrt c double precision elist,ermax,errmax,errmin integer i,ibeg,ido,iord,isucc,j,jbnd,jupbn,k,last,limit,maxerr, * nrmax dimension elist(last),iord(last) c c check whether the list contains more than c two error estimates. c c***first executable statement dqpsrt if(last.gt.2) go to 10 iord(1) = 1 iord(2) = 2 go to 90 c c this part of the routine is only executed if, due to a c difficult integrand, subdivision increased the error c estimate. in the normal case the insert procedure should c start after the nrmax-th largest error estimate. c 10 errmax = elist(maxerr) if(nrmax.eq.1) go to 30 ido = nrmax-1 do 20 i = 1,ido isucc = iord(nrmax-1) c ***jump out of do-loop if(errmax.le.elist(isucc)) go to 30 iord(nrmax) = isucc nrmax = nrmax-1 20 continue c c compute the number of elements in the list to be maintained c in descending order. this number depends on the number of c subdivisions still allowed. c 30 jupbn = last if(last.gt.(limit/2+2)) jupbn = limit+3-last errmin = elist(last) c c insert errmax by traversing the list top-down, c starting comparison from the element elist(iord(nrmax+1)). c jbnd = jupbn-1 ibeg = nrmax+1 if(ibeg.gt.jbnd) go to 50 do 40 i=ibeg,jbnd isucc = iord(i) c ***jump out of do-loop if(errmax.ge.elist(isucc)) go to 60 iord(i-1) = isucc 40 continue 50 iord(jbnd) = maxerr iord(jupbn) = last go to 90 c c insert errmin by traversing the list bottom-up. c 60 iord(i-1) = maxerr k = jbnd do 70 j=i,jbnd isucc = iord(k) c ***jump out of do-loop if(errmin.lt.elist(isucc)) go to 80 iord(k+1) = isucc k = k-1 70 continue iord(i) = last go to 90 80 iord(k+1) = last c c set maxerr and ermax. c 90 maxerr = iord(nrmax) ermax = elist(maxerr) return end