dqpsrt.f

Go to the documentation of this file.

      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