SUBROUTINE QSORTC (ORD,N,A) C This file: http://ftp.aset.psu.edu/pub/ger/fortran/hdk/qsortc.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 IMPLICIT INTEGER (A-Z) C DIMENSION ORD(N),POPLST(2,20) INTEGER X,XX,Z,ZZ,Y CHARACTER *(*) A(N) 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 X=ORD(P) Z=ORD(Q) IF (A(X).LE.A(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=ORD(P) IF (A(X).GE.A(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=ORD(Q) IF (A(Z).LE.A(ZZ)) GO TO 10 GO TO 8 9 Q=P P=P-1 Z=X X=ORD(P) C C DIST C 10 IF (A(X).LE.A(Z)) GO TO 11 Y=X X=Z Z=Y IP=ORD(P) ORD(P)=ORD(Q) ORD(Q)=IP 11 IF (A(X).LE.A(XX)) GO TO 12 XX=X IX=P 12 IF (A(Z).GE.A(ZZ)) GO TO 6 ZZ=Z IZ=Q GO TO 6 C C OUT C 13 CONTINUE IF (.NOT.(P.NE.IX.AND.A(X).NE.A(XX))) GO TO 14 IP=ORD(P) ORD(P)=ORD(IX) ORD(IX)=IP 14 CONTINUE IF (.NOT.(Q.NE.IZ.AND.A(Z).NE.A(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