GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
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