00001 SUBROUTINE DQPSRT(LIMIT,LAST,MAXERR,ERMAX,ELIST,IORD,NRMAX) 00002 C***BEGIN PROLOGUE DQPSRT 00003 C***REFER TO DQAGE,DQAGIE,DQAGPE,DQAWSE 00004 C***ROUTINES CALLED (NONE) 00005 C***REVISION DATE 810101 (YYMMDD) 00006 C***KEYWORDS SEQUENTIAL SORTING 00007 C***AUTHOR PIESSENS,ROBERT,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN 00008 C DE DONCKER,ELISE,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN 00009 C***PURPOSE THIS ROUTINE MAINTAINS THE DESCENDING ORDERING IN THE 00010 C LIST OF THE LOCAL ERROR ESTIMATED RESULTING FROM THE 00011 C INTERVAL SUBDIVISION PROCESS. AT EACH CALL TWO ERROR 00012 C ESTIMATES ARE INSERTED USING THE SEQUENTIAL SEARCH 00013 C METHOD, TOP-DOWN FOR THE LARGEST ERROR ESTIMATE AND 00014 C BOTTOM-UP FOR THE SMALLEST ERROR ESTIMATE. 00015 C***DESCRIPTION 00016 C 00017 C ORDERING ROUTINE 00018 C STANDARD FORTRAN SUBROUTINE 00019 C DOUBLE PRECISION VERSION 00020 C 00021 C PARAMETERS (MEANING AT OUTPUT) 00022 C LIMIT - INTEGER 00023 C MAXIMUM NUMBER OF ERROR ESTIMATES THE LIST 00024 C CAN CONTAIN 00025 C 00026 C LAST - INTEGER 00027 C NUMBER OF ERROR ESTIMATES CURRENTLY IN THE LIST 00028 C 00029 C MAXERR - INTEGER 00030 C MAXERR POINTS TO THE NRMAX-TH LARGEST ERROR 00031 C ESTIMATE CURRENTLY IN THE LIST 00032 C 00033 C ERMAX - DOUBLE PRECISION 00034 C NRMAX-TH LARGEST ERROR ESTIMATE 00035 C ERMAX = ELIST(MAXERR) 00036 C 00037 C ELIST - DOUBLE PRECISION 00038 C VECTOR OF DIMENSION LAST CONTAINING 00039 C THE ERROR ESTIMATES 00040 C 00041 C IORD - INTEGER 00042 C VECTOR OF DIMENSION LAST, THE FIRST K ELEMENTS 00043 C OF WHICH CONTAIN POINTERS TO THE ERROR 00044 C ESTIMATES, SUCH THAT 00045 C ELIST(IORD(1)),..., ELIST(IORD(K)) 00046 C FORM A DECREASING SEQUENCE, WITH 00047 C K = LAST IF LAST.LE.(LIMIT/2+2), AND 00048 C K = LIMIT+1-LAST OTHERWISE 00049 C 00050 C NRMAX - INTEGER 00051 C MAXERR = IORD(NRMAX) 00052 C 00053 C***END PROLOGUE DQPSRT 00054 C 00055 DOUBLE PRECISION ELIST,ERMAX,ERRMAX,ERRMIN 00056 INTEGER I,IBEG,IDO,IORD,ISUCC,J,JBND,JUPBN,K,LAST,LIMIT,MAXERR, 00057 * NRMAX 00058 DIMENSION ELIST(LAST),IORD(LAST) 00059 C 00060 C CHECK WHETHER THE LIST CONTAINS MORE THAN 00061 C TWO ERROR ESTIMATES. 00062 C 00063 C***FIRST EXECUTABLE STATEMENT DQPSRT 00064 IF(LAST.GT.2) GO TO 10 00065 IORD(1) = 1 00066 IORD(2) = 2 00067 GO TO 90 00068 C 00069 C THIS PART OF THE ROUTINE IS ONLY EXECUTED IF, DUE TO A 00070 C DIFFICULT INTEGRAND, SUBDIVISION INCREASED THE ERROR 00071 C ESTIMATE. IN THE NORMAL CASE THE INSERT PROCEDURE SHOULD 00072 C START AFTER THE NRMAX-TH LARGEST ERROR ESTIMATE. 00073 C 00074 10 ERRMAX = ELIST(MAXERR) 00075 IF(NRMAX.EQ.1) GO TO 30 00076 IDO = NRMAX-1 00077 DO 20 I = 1,IDO 00078 ISUCC = IORD(NRMAX-1) 00079 C ***JUMP OUT OF DO-LOOP 00080 IF(ERRMAX.LE.ELIST(ISUCC)) GO TO 30 00081 IORD(NRMAX) = ISUCC 00082 NRMAX = NRMAX-1 00083 20 CONTINUE 00084 C 00085 C COMPUTE THE NUMBER OF ELEMENTS IN THE LIST TO BE MAINTAINED 00086 C IN DESCENDING ORDER. THIS NUMBER DEPENDS ON THE NUMBER OF 00087 C SUBDIVISIONS STILL ALLOWED. 00088 C 00089 30 JUPBN = LAST 00090 IF(LAST.GT.(LIMIT/2+2)) JUPBN = LIMIT+3-LAST 00091 ERRMIN = ELIST(LAST) 00092 C 00093 C INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN, 00094 C STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)). 00095 C 00096 JBND = JUPBN-1 00097 IBEG = NRMAX+1 00098 IF(IBEG.GT.JBND) GO TO 50 00099 DO 40 I=IBEG,JBND 00100 ISUCC = IORD(I) 00101 C ***JUMP OUT OF DO-LOOP 00102 IF(ERRMAX.GE.ELIST(ISUCC)) GO TO 60 00103 IORD(I-1) = ISUCC 00104 40 CONTINUE 00105 50 IORD(JBND) = MAXERR 00106 IORD(JUPBN) = LAST 00107 GO TO 90 00108 C 00109 C INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP. 00110 C 00111 60 IORD(I-1) = MAXERR 00112 K = JBND 00113 DO 70 J=I,JBND 00114 ISUCC = IORD(K) 00115 C ***JUMP OUT OF DO-LOOP 00116 IF(ERRMIN.LT.ELIST(ISUCC)) GO TO 80 00117 IORD(K+1) = ISUCC 00118 K = K-1 00119 70 CONTINUE 00120 IORD(I) = LAST 00121 GO TO 90 00122 80 IORD(K+1) = LAST 00123 C 00124 C SET MAXERR AND ERMAX. 00125 C 00126 90 MAXERR = IORD(NRMAX) 00127 ERMAX = ELIST(MAXERR) 00128 RETURN 00129 END
1.7.1
