*DECK DQPSRT SUBROUTINE DQPSRT (LIMIT, LAST, MAXERR, ERMAX, ELIST, IORD, NRMAX) C***BEGIN PROLOGUE DQPSRT C***SUBSIDIARY 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***LIBRARY SLATEC C***TYPE DOUBLE PRECISION (QPSRT-S, DQPSRT-D) C***KEYWORDS SEQUENTIAL SORTING C***AUTHOR Piessens, Robert C Applied Mathematics and Programming Division C K. U. Leuven C de Doncker, Elise C Applied Mathematics and Programming Division C K. U. Leuven 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***SEE ALSO DQAGE, DQAGIE, DQAGPE, DQAWSE C***ROUTINES CALLED (NONE) C***REVISION HISTORY (YYMMDD) C 800101 DATE WRITTEN C 890831 Modified array declarations. (WRB) C 890831 REVISION DATE from Version 3.2 C 891214 Prologue converted to Version 4.0 format. (BAB) C 900328 Added TYPE section. (WRB) C***END PROLOGUE DQPSRT C DOUBLE PRECISION ELIST,ERMAX,ERRMAX,ERRMIN INTEGER I,IBEG,IDO,IORD,ISUCC,J,JBND,JUPBN,K,LAST,LIMIT,MAXERR, 1 NRMAX DIMENSION ELIST(*),IORD(*) 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