悲催的科学匠人 - 冷水's blog
[zz]FORTRAN版非递归快速排序
在二叉树离散网格单元时,最初使用递归的,但是网格单元到百万量级时,排序程序就出错了。怀疑是递归耗尽系统堆栈的问题,搜到一个非递归版本: http://www.fortran.com/fortran/quick_sort2.f 百万量级也不是问题了。
PROGRAM test_nrqsort REAL,ALLOCATABLE :: array(:) INTEGER,ALLOCATABLE :: idx(:) INTEGER N,i INTEGER,PARAMETER :: seed = 86456 !READ(*,*) N N = 5000000 ALLOCATE(array(N),idx(N)) CALL srand(seed) DO i=1,N; array(i) = rand() ENDDO WRITE(*,*) 'sorting' CALL SORTRX(N,array,idx) !DO i=1,N ! WRITE(*,*) array(idx(i)) !ENDDO DO i=2,N IF(array(idx(i)) .lt. array(idx(i-1)) ) THEN WRITE(*,*) 'error', array(idx(i)), array(idx(i-1)) ENDIF ENDDO DEALLOCATE(array,idx) END C From Leonard J. Moss of SLAC: C Here's a hybrid QuickSort I wrote a number of years ago. It's C based on suggestions in Knuth, Volume 3, and performs much better C than a pure QuickSort on short or partially ordered input arrays. SUBROUTINE SORTRX(N,DATA,INDEX) C=================================================================== C C SORTRX -- SORT, Real input, indeX output C C C Input: N INTEGER C DATA REAL C C Output: INDEX INTEGER (DIMENSION N) C C This routine performs an in-memory sort of the first N elements of C array DATA, returning into array INDEX the indices of elements of C DATA arranged in ascending order. Thus, C C DATA(INDEX(1)) will be the smallest number in array DATA; C DATA(INDEX(N)) will be the largest number in DATA. C C The original data is not physically rearranged. The original order C of equal input values is not necessarily preserved. C C=================================================================== C C SORTRX uses a hybrid QuickSort algorithm, based on several C suggestions in Knuth, Volume 3, Section 5.2.2. In particular, the C "pivot key" [my term] for dividing each subsequence is chosen to be C the median of the first, last, and middle values of the subsequence; C and the QuickSort is cut off when a subsequence has 9 or fewer C elements, and a straight insertion sort of the entire array is done C at the end. The result is comparable to a pure insertion sort for C very short arrays, and very fast for very large arrays (of order 12 C micro-sec/element on the 3081K for arrays of 10K elements). It is C also not subject to the poor performance of the pure QuickSort on C partially ordered data. C C Created: 15 Jul 1986 Len Moss C C=================================================================== INTEGER N,INDEX(N) REAL DATA(N) INTEGER LSTK(31),RSTK(31),ISTK INTEGER L,R,I,J,P,INDEXP,INDEXT REAL DATAP C QuickSort Cutoff C C Quit QuickSort-ing when a subsequence contains M or fewer C elements and finish off at end with straight insertion sort. C According to Knuth, V.3, the optimum value of M is around 9. INTEGER M PARAMETER (M=9) C=================================================================== C C Make initial guess for INDEX DO 50 I=1,N INDEX(I)=I 50 CONTINUE C If array is short, skip QuickSort and go directly to C the straight insertion sort. IF (N.LE.M) GOTO 900 C=================================================================== C C QuickSort C C The "Qn:"s correspond roughly to steps in Algorithm Q, C Knuth, V.3, PP.116-117, modified to select the median C of the first, last, and middle elements as the "pivot C key" (in Knuth's notation, "K"). Also modified to leave C data in place and produce an INDEX array. To simplify C comments, let DATA[I]=DATA(INDEX(I)). C Q1: Initialize ISTK=0 L=1 R=N 200 CONTINUE C Q2: Sort the subsequence DATA[L]..DATA[R]. C C At this point, DATA[l] <= DATA[m] <= DATA[r] for all l < L, C r > R, and L <= m <= R. (First time through, there is no C DATA for l < L or r > R.) I=L J=R C Q2.5: Select pivot key C C Let the pivot, P, be the midpoint of this subsequence, C P=(L+R)/2; then rearrange INDEX(L), INDEX(P), and INDEX(R) C so the corresponding DATA values are in increasing order. C The pivot key, DATAP, is then DATA[P]. P=(L+R)/2 INDEXP=INDEX(P) DATAP=DATA(INDEXP) IF (DATA(INDEX(L)) .GT. DATAP) THEN INDEX(P)=INDEX(L) INDEX(L)=INDEXP INDEXP=INDEX(P) DATAP=DATA(INDEXP) ENDIF IF (DATAP .GT. DATA(INDEX(R))) THEN IF (DATA(INDEX(L)) .GT. DATA(INDEX(R))) THEN INDEX(P)=INDEX(L) INDEX(L)=INDEX(R) ELSE INDEX(P)=INDEX(R) ENDIF INDEX(R)=INDEXP INDEXP=INDEX(P) DATAP=DATA(INDEXP) ENDIF C Now we swap values between the right and left sides and/or C move DATAP until all smaller values are on the left and all C larger values are on the right. Neither the left or right C side will be internally ordered yet; however, DATAP will be C in its final position. 300 CONTINUE C Q3: Search for datum on left >= DATAP C C At this point, DATA[L] <= DATAP. We can therefore start scanning C up from L, looking for a value >= DATAP (this scan is guaranteed C to terminate since we initially placed DATAP near the middle of C the subsequence). I=I+1 IF (DATA(INDEX(I)).LT.DATAP) GOTO 300 400 CONTINUE C Q4: Search for datum on right <= DATAP C C At this point, DATA[R] >= DATAP. We can therefore start scanning C down from R, looking for a value <= DATAP (this scan is guaranteed C to terminate since we initially placed DATAP near the middle of C the subsequence). J=J-1 IF (DATA(INDEX(J)).GT.DATAP) GOTO 400 C Q5: Have the two scans collided? IF (I.LT.J) THEN C Q6: No, interchange DATA[I] <--> DATA[J] and continue INDEXT=INDEX(I) INDEX(I)=INDEX(J) INDEX(J)=INDEXT GOTO 300 ELSE C Q7: Yes, select next subsequence to sort C C At this point, I >= J and DATA[l] <= DATA[I] == DATAP <= DATA[r], C for all L <= l < I and J < r <= R. If both subsequences are C more than M elements long, push the longer one on the stack and C go back to QuickSort the shorter; if only one is more than M C elements long, go back and QuickSort it; otherwise, pop a C subsequence off the stack and QuickSort it. IF (R-J .GE. I-L .AND. I-L .GT. M) THEN ISTK=ISTK+1 LSTK(ISTK)=J+1 RSTK(ISTK)=R R=I-1 ELSE IF (I-L .GT. R-J .AND. R-J .GT. M) THEN ISTK=ISTK+1 LSTK(ISTK)=L RSTK(ISTK)=I-1 L=J+1 ELSE IF (R-J .GT. M) THEN L=J+1 ELSE IF (I-L .GT. M) THEN R=I-1 ELSE C Q8: Pop the stack, or terminate QuickSort if empty IF (ISTK.LT.1) GOTO 900 L=LSTK(ISTK) R=RSTK(ISTK) ISTK=ISTK-1 ENDIF GOTO 200 ENDIF 900 CONTINUE C=================================================================== C C Q9: Straight Insertion sort DO 950 I=2,N IF (DATA(INDEX(I-1)) .GT. DATA(INDEX(I))) THEN INDEXP=INDEX(I) DATAP=DATA(INDEXP) P=I-1 920 CONTINUE INDEX(P+1) = INDEX(P) P=P-1 IF (P.GT.0) THEN IF (DATA(INDEX(P)).GT.DATAP) GOTO 920 ENDIF INDEX(P+1) = INDEXP ENDIF 950 CONTINUE C=================================================================== C C All done END