1*DECK DQPSRT
2      SUBROUTINE DQPSRT (LIMIT, LAST, MAXERR, ERMAX, ELIST, IORD, NRMAX)
3C***BEGIN PROLOGUE  DQPSRT
4C***SUBSIDIARY
5C***PURPOSE  This routine maintains the descending ordering in the
6C            list of the local error estimated resulting from the
7C            interval subdivision process. At each call two error
8C            estimates are inserted using the sequential search
9C            method, top-down for the largest error estimate and
10C            bottom-up for the smallest error estimate.
11C***LIBRARY   SLATEC
12C***TYPE      DOUBLE PRECISION (QPSRT-S, DQPSRT-D)
13C***KEYWORDS  SEQUENTIAL SORTING
14C***AUTHOR  Piessens, Robert
15C             Applied Mathematics and Programming Division
16C             K. U. Leuven
17C           de Doncker, Elise
18C             Applied Mathematics and Programming Division
19C             K. U. Leuven
20C***DESCRIPTION
21C
22C           Ordering routine
23C           Standard fortran subroutine
24C           Double precision version
25C
26C           PARAMETERS (MEANING AT OUTPUT)
27C              LIMIT  - Integer
28C                       Maximum number of error estimates the list
29C                       can contain
30C
31C              LAST   - Integer
32C                       Number of error estimates currently in the list
33C
34C              MAXERR - Integer
35C                       MAXERR points to the NRMAX-th largest error
36C                       estimate currently in the list
37C
38C              ERMAX  - Double precision
39C                       NRMAX-th largest error estimate
40C                       ERMAX = ELIST(MAXERR)
41C
42C              ELIST  - Double precision
43C                       Vector of dimension LAST containing
44C                       the error estimates
45C
46C              IORD   - Integer
47C                       Vector of dimension LAST, the first K elements
48C                       of which contain pointers to the error
49C                       estimates, such that
50C                       ELIST(IORD(1)),...,  ELIST(IORD(K))
51C                       form a decreasing sequence, with
52C                       K = LAST if LAST.LE.(LIMIT/2+2), and
53C                       K = LIMIT+1-LAST otherwise
54C
55C              NRMAX  - Integer
56C                       MAXERR = IORD(NRMAX)
57C
58C***SEE ALSO  DQAGE, DQAGIE, DQAGPE, DQAWSE
59C***ROUTINES CALLED  (NONE)
60C***REVISION HISTORY  (YYMMDD)
61C   800101  DATE WRITTEN
62C   890831  Modified array declarations.  (WRB)
63C   890831  REVISION DATE from Version 3.2
64C   891214  Prologue converted to Version 4.0 format.  (BAB)
65C   900328  Added TYPE section.  (WRB)
66C***END PROLOGUE  DQPSRT
67C
68      DOUBLE PRECISION ELIST,ERMAX,ERRMAX,ERRMIN
69      INTEGER I,IBEG,IDO,IORD,ISUCC,J,JBND,JUPBN,K,LAST,LIMIT,MAXERR,
70     1  NRMAX
71      DIMENSION ELIST(*),IORD(*)
72C
73C           CHECK WHETHER THE LIST CONTAINS MORE THAN
74C           TWO ERROR ESTIMATES.
75C
76C***FIRST EXECUTABLE STATEMENT  DQPSRT
77      IF(LAST.GT.2) GO TO 10
78      IORD(1) = 1
79      IORD(2) = 2
80      GO TO 90
81C
82C           THIS PART OF THE ROUTINE IS ONLY EXECUTED IF, DUE TO A
83C           DIFFICULT INTEGRAND, SUBDIVISION INCREASED THE ERROR
84C           ESTIMATE. IN THE NORMAL CASE THE INSERT PROCEDURE SHOULD
85C           START AFTER THE NRMAX-TH LARGEST ERROR ESTIMATE.
86C
87   10 ERRMAX = ELIST(MAXERR)
88      IF(NRMAX.EQ.1) GO TO 30
89      IDO = NRMAX-1
90      DO 20 I = 1,IDO
91        ISUCC = IORD(NRMAX-1)
92C ***JUMP OUT OF DO-LOOP
93        IF(ERRMAX.LE.ELIST(ISUCC)) GO TO 30
94        IORD(NRMAX) = ISUCC
95        NRMAX = NRMAX-1
96   20    CONTINUE
97C
98C           COMPUTE THE NUMBER OF ELEMENTS IN THE LIST TO BE MAINTAINED
99C           IN DESCENDING ORDER. THIS NUMBER DEPENDS ON THE NUMBER OF
100C           SUBDIVISIONS STILL ALLOWED.
101C
102   30 JUPBN = LAST
103      IF(LAST.GT.(LIMIT/2+2)) JUPBN = LIMIT+3-LAST
104      ERRMIN = ELIST(LAST)
105C
106C           INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN,
107C           STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)).
108C
109      JBND = JUPBN-1
110      IBEG = NRMAX+1
111      IF(IBEG.GT.JBND) GO TO 50
112      DO 40 I=IBEG,JBND
113        ISUCC = IORD(I)
114C ***JUMP OUT OF DO-LOOP
115        IF(ERRMAX.GE.ELIST(ISUCC)) GO TO 60
116        IORD(I-1) = ISUCC
117   40 CONTINUE
118   50 IORD(JBND) = MAXERR
119      IORD(JUPBN) = LAST
120      GO TO 90
121C
122C           INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP.
123C
124   60 IORD(I-1) = MAXERR
125      K = JBND
126      DO 70 J=I,JBND
127        ISUCC = IORD(K)
128C ***JUMP OUT OF DO-LOOP
129        IF(ERRMIN.LT.ELIST(ISUCC)) GO TO 80
130        IORD(K+1) = ISUCC
131        K = K-1
132   70 CONTINUE
133      IORD(I) = LAST
134      GO TO 90
135   80 IORD(K+1) = LAST
136C
137C           SET MAXERR AND ERMAX.
138C
139   90 MAXERR = IORD(NRMAX)
140      ERMAX = ELIST(MAXERR)
141      RETURN
142      END
143