00001 subroutine qpsrt(limit,last,maxerr,ermax,elist,iord,nrmax) 00002 c***begin prologue qpsrt 00003 c***refer to qage,qagie,qagpe,qagse,qawce,qawse,qawoe 00004 c***routines called (none) 00005 c***keywords sequential sorting 00006 c***description 00007 c 00008 c 1. qpsrt 00009 c ordering routine 00010 c standard fortran subroutine 00011 c real version 00012 c 00013 c 2. purpose 00014 c this routine maintains the descending ordering 00015 c in the list of the local error estimates resulting from 00016 c the interval subdivision process. at each call two error 00017 c estimates are inserted using the sequential search 00018 c method, top-down for the largest error estimate 00019 c and bottom-up for the smallest error estimate. 00020 c 00021 c 3. calling sequence 00022 c call qpsrt(limit,last,maxerr,ermax,elist,iord,nrmax) 00023 c 00024 c parameters (meaning at output) 00025 c limit - integer 00026 c maximum number of error estimates the list 00027 c can contain 00028 c 00029 c last - integer 00030 c number of error estimates currently 00031 c in the list 00032 c 00033 c maxerr - integer 00034 c maxerr points to the nrmax-th largest error 00035 c estimate currently in the list 00036 c 00037 c ermax - real 00038 c nrmax-th largest error estimate 00039 c ermax = elist(maxerr) 00040 c 00041 c elist - real 00042 c vector of dimension last containing 00043 c the error estimates 00044 c 00045 c iord - integer 00046 c vector of dimension last, the first k 00047 c elements of which contain pointers 00048 c to the error estimates, such that 00049 c elist(iord(1)),... , elist(iord(k)) 00050 c form a decreasing sequence, with 00051 c k = last if last.le.(limit/2+2), and 00052 c k = limit+1-last otherwise 00053 c 00054 c nrmax - integer 00055 c maxerr = iord(nrmax) 00056 c 00057 c 4. no subroutines or functions needed 00058 c***end prologue qpsrt 00059 c 00060 real elist,ermax,errmax,errmin 00061 integer i,ibeg,ido,iord,isucc,j,jbnd,jupbn,k,last,limit,maxerr, 00062 * nrmax 00063 dimension elist(last),iord(last) 00064 c 00065 c check whether the list contains more than 00066 c two error estimates. 00067 c 00068 c***first executable statement qpsrt 00069 if(last.gt.2) go to 10 00070 iord(1) = 1 00071 iord(2) = 2 00072 go to 90 00073 c 00074 c this part of the routine is only executed 00075 c if, due to a difficult integrand, subdivision 00076 c increased the error estimate. in the normal case 00077 c the insert procedure should start after the 00078 c nrmax-th largest error estimate. 00079 c 00080 10 errmax = elist(maxerr) 00081 if(nrmax.eq.1) go to 30 00082 ido = nrmax-1 00083 do 20 i = 1,ido 00084 isucc = iord(nrmax-1) 00085 c ***jump out of do-loop 00086 if(errmax.le.elist(isucc)) go to 30 00087 iord(nrmax) = isucc 00088 nrmax = nrmax-1 00089 20 continue 00090 c 00091 c compute the number of elements in the list to 00092 c be maintained in descending order. this number 00093 c depends on the number of subdivisions still 00094 c allowed. 00095 c 00096 30 jupbn = last 00097 if(last.gt.(limit/2+2)) jupbn = limit+3-last 00098 errmin = elist(last) 00099 c 00100 c insert errmax by traversing the list top-down, 00101 c starting comparison from the element elist(iord(nrmax+1)). 00102 c 00103 jbnd = jupbn-1 00104 ibeg = nrmax+1 00105 if(ibeg.gt.jbnd) go to 50 00106 do 40 i=ibeg,jbnd 00107 isucc = iord(i) 00108 c ***jump out of do-loop 00109 if(errmax.ge.elist(isucc)) go to 60 00110 iord(i-1) = isucc 00111 40 continue 00112 50 iord(jbnd) = maxerr 00113 iord(jupbn) = last 00114 go to 90 00115 c 00116 c insert errmin by traversing the list bottom-up. 00117 c 00118 60 iord(i-1) = maxerr 00119 k = jbnd 00120 do 70 j=i,jbnd 00121 isucc = iord(k) 00122 c ***jump out of do-loop 00123 if(errmin.lt.elist(isucc)) go to 80 00124 iord(k+1) = isucc 00125 k = k-1 00126 70 continue 00127 iord(i) = last 00128 go to 90 00129 80 iord(k+1) = last 00130 c 00131 c set maxerr and ermax. 00132 c 00133 90 maxerr = iord(nrmax) 00134 ermax = elist(maxerr) 00135 return 00136 end
1.7.1
