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
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