src/numerical/slatec/fortran/dqpsrt.f

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