GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
dqpsrt.f
Go to the documentation of this file.
1  SUBROUTINE dqpsrt(LIMIT,LAST,MAXERR,ERMAX,ELIST,IORD,NRMAX)
2 C***BEGIN PROLOGUE DQPSRT
3 C***REFER TO DQAGE,DQAGIE,DQAGPE,DQAWSE
4 C***ROUTINES CALLED (NONE)
5 C***REVISION DATE 810101 (YYMMDD)
6 C***KEYWORDS SEQUENTIAL SORTING
7 C***AUTHOR PIESSENS,ROBERT,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN
8 C DE DONCKER,ELISE,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN
9 C***PURPOSE THIS ROUTINE MAINTAINS THE DESCENDING ORDERING IN THE
10 C LIST OF THE LOCAL ERROR ESTIMATED RESULTING FROM THE
11 C INTERVAL SUBDIVISION PROCESS. AT EACH CALL TWO ERROR
12 C ESTIMATES ARE INSERTED USING THE SEQUENTIAL SEARCH
13 C METHOD, TOP-DOWN FOR THE LARGEST ERROR ESTIMATE AND
14 C BOTTOM-UP FOR THE SMALLEST ERROR ESTIMATE.
15 C***DESCRIPTION
16 C
17 C ORDERING ROUTINE
18 C STANDARD FORTRAN SUBROUTINE
19 C DOUBLE PRECISION VERSION
20 C
21 C PARAMETERS (MEANING AT OUTPUT)
22 C LIMIT - INTEGER
23 C MAXIMUM NUMBER OF ERROR ESTIMATES THE LIST
24 C CAN CONTAIN
25 C
26 C LAST - INTEGER
27 C NUMBER OF ERROR ESTIMATES CURRENTLY IN THE LIST
28 C
29 C MAXERR - INTEGER
30 C MAXERR POINTS TO THE NRMAX-TH LARGEST ERROR
31 C ESTIMATE CURRENTLY IN THE LIST
32 C
33 C ERMAX - DOUBLE PRECISION
34 C NRMAX-TH LARGEST ERROR ESTIMATE
35 C ERMAX = ELIST(MAXERR)
36 C
37 C ELIST - DOUBLE PRECISION
38 C VECTOR OF DIMENSION LAST CONTAINING
39 C THE ERROR ESTIMATES
40 C
41 C IORD - INTEGER
42 C VECTOR OF DIMENSION LAST, THE FIRST K ELEMENTS
43 C OF WHICH CONTAIN POINTERS TO THE ERROR
44 C ESTIMATES, SUCH THAT
45 C ELIST(IORD(1)),..., ELIST(IORD(K))
46 C FORM A DECREASING SEQUENCE, WITH
47 C K = LAST IF LAST.LE.(LIMIT/2+2), AND
48 C K = LIMIT+1-LAST OTHERWISE
49 C
50 C NRMAX - INTEGER
51 C MAXERR = IORD(NRMAX)
52 C
53 C***END PROLOGUE DQPSRT
54 C
55  DOUBLE PRECISION ELIST,ERMAX,ERRMAX,ERRMIN
56  INTEGER I,IBEG,IDO,IORD,ISUCC,J,JBND,JUPBN,K,LAST,LIMIT,MAXERR,
57  * NRMAX
58  dimension elist(last),iord(last)
59 C
60 C CHECK WHETHER THE LIST CONTAINS MORE THAN
61 C TWO ERROR ESTIMATES.
62 C
63 C***FIRST EXECUTABLE STATEMENT DQPSRT
64  IF(last.GT.2) GO TO 10
65  iord(1) = 1
66  iord(2) = 2
67  GO TO 90
68 C
69 C THIS PART OF THE ROUTINE IS ONLY EXECUTED IF, DUE TO A
70 C DIFFICULT INTEGRAND, SUBDIVISION INCREASED THE ERROR
71 C ESTIMATE. IN THE NORMAL CASE THE INSERT PROCEDURE SHOULD
72 C START AFTER THE NRMAX-TH LARGEST ERROR ESTIMATE.
73 C
74  10 errmax = elist(maxerr)
75  IF(nrmax.EQ.1) GO TO 30
76  ido = nrmax-1
77  DO 20 i = 1,ido
78  isucc = iord(nrmax-1)
79 C ***JUMP OUT OF DO-LOOP
80  IF(errmax.LE.elist(isucc)) GO TO 30
81  iord(nrmax) = isucc
82  nrmax = nrmax-1
83  20 CONTINUE
84 C
85 C COMPUTE THE NUMBER OF ELEMENTS IN THE LIST TO BE MAINTAINED
86 C IN DESCENDING ORDER. THIS NUMBER DEPENDS ON THE NUMBER OF
87 C SUBDIVISIONS STILL ALLOWED.
88 C
89  30 jupbn = last
90  IF(last.GT.(limit/2+2)) jupbn = limit+3-last
91  errmin = elist(last)
92 C
93 C INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN,
94 C STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)).
95 C
96  jbnd = jupbn-1
97  ibeg = nrmax+1
98  IF(ibeg.GT.jbnd) GO TO 50
99  DO 40 i=ibeg,jbnd
100  isucc = iord(i)
101 C ***JUMP OUT OF DO-LOOP
102  IF(errmax.GE.elist(isucc)) GO TO 60
103  iord(i-1) = isucc
104  40 CONTINUE
105  50 iord(jbnd) = maxerr
106  iord(jupbn) = last
107  GO TO 90
108 C
109 C INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP.
110 C
111  60 iord(i-1) = maxerr
112  k = jbnd
113  DO 70 j=i,jbnd
114  isucc = iord(k)
115 C ***JUMP OUT OF DO-LOOP
116  IF(errmin.LT.elist(isucc)) GO TO 80
117  iord(k+1) = isucc
118  k = k-1
119  70 CONTINUE
120  iord(i) = last
121  GO TO 90
122  80 iord(k+1) = last
123 C
124 C SET MAXERR AND ERMAX.
125 C
126  90 maxerr = iord(nrmax)
127  ermax = elist(maxerr)
128  RETURN
129  END
subroutine dqpsrt(LIMIT, LAST, MAXERR, ERMAX, ELIST, IORD, NRMAX)
Definition: dqpsrt.f:2