2D AMRCLAW
quick_sort1.f
Go to the documentation of this file.
1 C From HDK@psuvm.psu.edu Thu Dec 8 15:27:16 MST 1994
2 C
3 C The following was converted from Algol recursive to Fortran iterative
4 C by a colleague at Penn State (a long time ago - Fortran 66, please
5 C excuse the GoTo's). The following code also corrects a bug in the
6 C Quicksort algorithm published in the ACM (see Algorithm 402, CACM,
7 C Sept. 1970, pp 563-567; also you younger folks who weren't born at
8 C that time might find interesting the history of the Quicksort
9 C algorithm beginning with the original published in CACM, July 1961,
10 C pp 321-322, Algorithm 64). Note that the following algorithm sorts
11 C integer data; actual data is not moved but sort is affected by sorting
12 C a companion index array (see leading comments). The data type being
13 C sorted can be changed by changing one line; see comments after
14 C declarations and subsequent one regarding comparisons(Fortran
15 C 77 takes care of character comparisons of course, so that comment
16 C is merely historical from the days when we had to write character
17 C compare subprograms, usually in assembler language for a specific
18 C mainframe platform at that time). But the following algorithm is
19 C good, still one of the best available.
20 
21 
22  SUBROUTINE qsorti (ORD,N,A)
23 C
24 C==============SORTS THE ARRAY A(I),I=1,2,...,N BY PUTTING THE
25 C ASCENDING ORDER VECTOR IN ORD. THAT IS ASCENDING ORDERED A
26 C IS A(ORD(I)),I=1,2,...,N; DESCENDING ORDER A IS A(ORD(N-I+1)),
27 C I=1,2,...,N . THIS SORT RUNS IN TIME PROPORTIONAL TO N LOG N .
28 C
29 C
30 C ACM QUICKSORT - ALGORITHM #402 - IMPLEMENTED IN FORTRAN 66 BY
31 C WILLIAM H. VERITY, WHV@PSUVM.PSU.EDU
32 C CENTER FOR ACADEMIC COMPUTING
33 C THE PENNSYLVANIA STATE UNIVERSITY
34 C UNIVERSITY PARK, PA. 16802
35 C
36  IMPLICIT INTEGER (A-Z)
37 C
38  dimension ord(n),poplst(2,20)
39  integer X,XX,Z,ZZ,Y
40 C
41 C TO SORT DIFFERENT INPUT TYPES, CHANGE THE FOLLOWING
42 C SPECIFICATION STATEMENTS; FOR EXAMPLE, FOR FORTRAN CHARACTER
43 C USE THE FOLLOWING: CHARACTER *(*) A(N)
44 C
45  integer A(n)
46 C
47  ndeep=0
48  u1=n
49  l1=1
50  DO 1 i=1,n
51  1 ord(i)=i
52  2 IF (u1.LE.l1) RETURN
53 C
54  3 l=l1
55  u=u1
56 C
57 C PART
58 C
59  4 p=l
60  q=u
61 C FOR CHARACTER SORTS, THE FOLLOWING 3 STATEMENTS WOULD BECOME
62 C X = ORD(P)
63 C Z = ORD(Q)
64 C IF (A(X) .LE. A(Z)) GO TO 2
65 C
66 C WHERE "CLE" IS A LOGICAL FUNCTION WHICH RETURNS "TRUE" IF THE
67 C FIRST ARGUMENT IS LESS THAN OR EQUAL TO THE SECOND, BASED ON "LEN"
68 C CHARACTERS.
69 C
70  x=a(ord(p))
71  z=a(ord(q))
72  IF (x.LE.z) GO TO 5
73  y=x
74  x=z
75  z=y
76  yp=ord(p)
77  ord(p)=ord(q)
78  ord(q)=yp
79  5 IF (u-l.LE.1) GO TO 15
80  xx=x
81  ix=p
82  zz=z
83  iz=q
84 C
85 C LEFT
86 C
87  6 p=p+1
88  IF (p.GE.q) GO TO 7
89  x=a(ord(p))
90  IF (x.GE.xx) GO TO 8
91  GO TO 6
92  7 p=q-1
93  GO TO 13
94 C
95 C RIGHT
96 C
97  8 q=q-1
98  IF (q.LE.p) GO TO 9
99  z=a(ord(q))
100  IF (z.LE.zz) GO TO 10
101  GO TO 8
102  9 q=p
103  p=p-1
104  z=x
105  x=a(ord(p))
106 C
107 C DIST
108 C
109  10 IF (x.LE.z) GO TO 11
110  y=x
111  x=z
112  z=y
113  ip=ord(p)
114  ord(p)=ord(q)
115  ord(q)=ip
116  11 IF (x.LE.xx) GO TO 12
117  xx=x
118  ix=p
119  12 IF (z.GE.zz) GO TO 6
120  zz=z
121  iz=q
122  GO TO 6
123 C
124 C OUT
125 C
126  13 CONTINUE
127  IF (.NOT.(p.NE.ix.AND.x.NE.xx)) GO TO 14
128  ip=ord(p)
129  ord(p)=ord(ix)
130  ord(ix)=ip
131  14 CONTINUE
132  IF (.NOT.(q.NE.iz.AND.z.NE.zz)) GO TO 15
133  iq=ord(q)
134  ord(q)=ord(iz)
135  ord(iz)=iq
136  15 CONTINUE
137  IF (u-q.LE.p-l) GO TO 16
138  l1=l
139  u1=p-1
140  l=q+1
141  GO TO 17
142  16 u1=u
143  l1=q+1
144  u=p-1
145  17 CONTINUE
146  IF (u1.LE.l1) GO TO 18
147 C
148 C START RECURSIVE CALL
149 C
150  ndeep=ndeep+1
151  poplst(1,ndeep)=u
152  poplst(2,ndeep)=l
153  GO TO 3
154  18 IF (u.GT.l) GO TO 4
155 C
156 C POP BACK UP IN THE RECURSION LIST
157 C
158  IF (ndeep.EQ.0) GO TO 2
159  u=poplst(1,ndeep)
160  l=poplst(2,ndeep)
161  ndeep=ndeep-1
162  GO TO 18
163 C
164 C END SORT
165 C END QSORT
166 C
167  END
subroutine qsorti(ORD, N, A)
Definition: quick_sort1.f:23