SUBROUTINE QSORTI (ORD,N,A) C This file: http://ftp.aset.psu.edu/pub/ger/fortran/hdk/qsorti.for C C C==============SORTS THE ARRAY A(I),I=1,2,...,N BY PUTTING THE C ASCENDING ORDER VECTOR IN ORD. THAT IS ASCENDING ORDERED A C IS A(ORD(I)),I=1,2,...,N; DESCENDING ORDER A IS A(ORD(N-I+1)), C I=1,2,...,N . THIS SORT RUNS IN TIME PROPORTIONAL TO N LOG N . C C C ACM QUICKSORT - ALGORITHM #402 - IMPLEMENTED IN FORTRAN BY C WILLIAM H. VERITY C COMPUTATION CENTER C PENNSYLVANIA STATE UNIVERSITY C UNIVERSITY PARK, PA. 16802 C With correction to that algorithm. C IMPLICIT INTEGER (A-Z) C DIMENSION ORD(N),POPLST(2,20) C C To sort different input types change the following C specification statements; FOR EXAMPLE, REAL A(N) or C CHARACTER *(L) A(N) for REAL or CHARACTER sorting C respectively similarly for X,XX,Z,ZZ,Y. L is the C character length of the elements of A. C INTEGER A(N) C REAL A(N) C CHARACTER*(L) A(N) INTEGER X,XX,Z,ZZ,Y C REAL X,XX,Z,ZZ,Y C CHARACTER*(L) X,XX,Z,ZZ,Y C NDEEP=0 U1=N L1=1 DO 1 I=1,N 1 ORD(I)=I 2 IF (U1.GT.L1) GO TO 3 RETURN C 3 L=L1 U=U1 C C PART C 4 P=L Q=U C X=A(ORD(P)) Z=A(ORD(Q)) C FOR CHARACTER SORTS, THE FOLLOWING STATEMENT WOULD BECOME C IF (A(X) .LE. A(Z)) GO TO 2 IF (X.LE.Z) GO TO 5 Y=X X=Z Z=Y YP=ORD(P) ORD(P)=ORD(Q) ORD(Q)=YP 5 IF (U-L.LE.1) GO TO 15 XX=X IX=P ZZ=Z IZ=Q C C LEFT C 6 P=P+1 IF (P.GE.Q) GO TO 7 X=A(ORD(P)) IF (X.GE.XX) GO TO 8 GO TO 6 7 P=Q-1 GO TO 13 C C RIGHT C 8 Q=Q-1 IF (Q.LE.P) GO TO 9 Z=A(ORD(Q)) IF (Z.LE.ZZ) GO TO 10 GO TO 8 9 Q=P P=P-1 Z=X X=A(ORD(P)) C C DIST C 10 IF (X.LE.Z) GO TO 11 Y=X X=Z Z=Y IP=ORD(P) ORD(P)=ORD(Q) ORD(Q)=IP 11 IF (X.LE.XX) GO TO 12 XX=X IX=P 12 IF (Z.GE.ZZ) GO TO 6 ZZ=Z IZ=Q GO TO 6 C C OUT C 13 CONTINUE IF (.NOT.(P.NE.IX.AND.X.NE.XX)) GO TO 14 IP=ORD(P) ORD(P)=ORD(IX) ORD(IX)=IP 14 CONTINUE IF (.NOT.(Q.NE.IZ.AND.Z.NE.ZZ)) GO TO 15 IQ=ORD(Q) ORD(Q)=ORD(IZ) ORD(IZ)=IQ 15 CONTINUE IF (U-Q.LE.P-L) GO TO 16 L1=L U1=P-1 L=Q+1 GO TO 17 16 U1=U L1=Q+1 U=P-1 17 CONTINUE IF (U1.LE.L1) GO TO 18 C C START RECURSIVE CALL C NDEEP=NDEEP+1 POPLST(1,NDEEP)=U POPLST(2,NDEEP)=L GO TO 3 18 IF (U.GT.L) GO TO 4 C C POP BACK UP IN THE RECURSION LIST C IF (NDEEP.EQ.0) GO TO 2 U=POPLST(1,NDEEP) L=POPLST(2,NDEEP) NDEEP=NDEEP-1 GO TO 18 C C END SORT C END QSORT C END