GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
qpsrt.f
Go to the documentation of this file.
1  subroutine qpsrt(limit,last,maxerr,ermax,elist,iord,nrmax)
2 c***begin prologue qpsrt
3 c***refer to qage,qagie,qagpe,qagse,qawce,qawse,qawoe
4 c***routines called (none)
5 c***keywords sequential sorting
6 c***description
7 c
8 c 1. qpsrt
9 c ordering routine
10 c standard fortran subroutine
11 c real version
12 c
13 c 2. purpose
14 c this routine maintains the descending ordering
15 c in the list of the local error estimates resulting from
16 c the interval subdivision process. at each call two error
17 c estimates are inserted using the sequential search
18 c method, top-down for the largest error estimate
19 c and bottom-up for the smallest error estimate.
20 c
21 c 3. calling sequence
22 c call qpsrt(limit,last,maxerr,ermax,elist,iord,nrmax)
23 c
24 c parameters (meaning at output)
25 c limit - integer
26 c maximum number of error estimates the list
27 c can contain
28 c
29 c last - integer
30 c number of error estimates currently
31 c in the list
32 c
33 c maxerr - integer
34 c maxerr points to the nrmax-th largest error
35 c estimate currently in the list
36 c
37 c ermax - real
38 c nrmax-th largest error estimate
39 c ermax = elist(maxerr)
40 c
41 c elist - real
42 c vector of dimension last containing
43 c the error estimates
44 c
45 c iord - integer
46 c vector of dimension last, the first k
47 c elements of which contain pointers
48 c to the error estimates, such that
49 c elist(iord(1)),... , elist(iord(k))
50 c form a decreasing sequence, with
51 c k = last if last.le.(limit/2+2), and
52 c k = limit+1-last otherwise
53 c
54 c nrmax - integer
55 c maxerr = iord(nrmax)
56 c
57 c 4. no subroutines or functions needed
58 c***end prologue qpsrt
59 c
60  real elist,ermax,errmax,errmin
61  integer i,ibeg,ido,iord,isucc,j,jbnd,jupbn,k,last,limit,maxerr,
62  * nrmax
63  dimension elist(last),iord(last)
64 c
65 c check whether the list contains more than
66 c two error estimates.
67 c
68 c***first executable statement qpsrt
69  if(last.gt.2) go to 10
70  iord(1) = 1
71  iord(2) = 2
72  go to 90
73 c
74 c this part of the routine is only executed
75 c if, due to a difficult integrand, subdivision
76 c increased the error estimate. in the normal case
77 c the insert procedure should start after the
78 c nrmax-th largest error estimate.
79 c
80  10 errmax = elist(maxerr)
81  if(nrmax.eq.1) go to 30
82  ido = nrmax-1
83  do 20 i = 1,ido
84  isucc = iord(nrmax-1)
85 c ***jump out of do-loop
86  if(errmax.le.elist(isucc)) go to 30
87  iord(nrmax) = isucc
88  nrmax = nrmax-1
89  20 continue
90 c
91 c compute the number of elements in the list to
92 c be maintained in descending order. this number
93 c depends on the number of subdivisions still
94 c allowed.
95 c
96  30 jupbn = last
97  if(last.gt.(limit/2+2)) jupbn = limit+3-last
98  errmin = elist(last)
99 c
100 c insert errmax by traversing the list top-down,
101 c starting comparison from the element elist(iord(nrmax+1)).
102 c
103  jbnd = jupbn-1
104  ibeg = nrmax+1
105  if(ibeg.gt.jbnd) go to 50
106  do 40 i=ibeg,jbnd
107  isucc = iord(i)
108 c ***jump out of do-loop
109  if(errmax.ge.elist(isucc)) go to 60
110  iord(i-1) = isucc
111  40 continue
112  50 iord(jbnd) = maxerr
113  iord(jupbn) = last
114  go to 90
115 c
116 c insert errmin by traversing the list bottom-up.
117 c
118  60 iord(i-1) = maxerr
119  k = jbnd
120  do 70 j=i,jbnd
121  isucc = iord(k)
122 c ***jump out of do-loop
123  if(errmin.lt.elist(isucc)) go to 80
124  iord(k+1) = isucc
125  k = k-1
126  70 continue
127  iord(i) = last
128  go to 90
129  80 iord(k+1) = last
130 c
131 c set maxerr and ermax.
132 c
133  90 maxerr = iord(nrmax)
134  ermax = elist(maxerr)
135  return
136  end
qpsrt
subroutine qpsrt(limit, last, maxerr, ermax, elist, iord, nrmax)
Definition: qpsrt.f:2