d6/dc6/qpsrt_8f_source.html

       subroutine qpsrt(limit,last,maxerr,ermax,elist,iord,nrmax)

 c***begin prologue  qpsrt

 c***refer to  qage,qagie,qagpe,qagse,qawce,qawse,qawoe

 c***routines called  (none)

 c***keywords  sequential sorting

 c***description

 c

 c 1.        qpsrt

 c           ordering routine

 c              standard fortran subroutine

 c              real version

 c

 c 2.        purpose

 c              this routine maintains the descending ordering

 c              in the list of the local error estimates resulting from

 c              the 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

 c              and bottom-up for the smallest error estimate.

 c

 c 3.        calling sequence

 c              call qpsrt(limit,last,maxerr,ermax,elist,iord,nrmax)

 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

 c                       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  - real

 c                       nrmax-th largest error estimate

 c                       ermax = elist(maxerr)

 c

 c              elist  - real

 c                       vector of dimension last containing

 c                       the error estimates

 c

 c              iord   - integer

 c                       vector of dimension last, the first k

 c                       elements of which contain pointers

 c                       to the error 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 4.        no subroutines or functions needed

 c***end prologue  qpsrt

 c

       real 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  qpsrt

       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

 c           if, due to a difficult integrand, subdivision

 c           increased the error estimate. in the normal case

 c           the insert procedure should start after the

 c           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

 c           be maintained in descending order. this number

 c           depends on the number of subdivisions still

 c           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

qpsrt
subroutine qpsrt(limit, last, maxerr, ermax, elist, iord, nrmax)
Definition: qpsrt.f:2