root / synthbench / euroben-dm / mod2i / .svn / text-base / iqsort.f.svn-base @ 0:839f52ef7657
History | View | Annotate | Download (1.6 kB)
1 |
Subroutine iqsort( a, n, nl, nu ) ! Integer sort |
---|---|
2 |
! -------------------------------------------------------------------- |
3 |
Implicit None |
4 |
|
5 |
Integer, Intent( In ) :: n, nl, nu |
6 |
Integer, Intent( Inout) :: a(n) |
7 |
|
8 |
Integer :: iu(16), il(16) |
9 |
Integer :: i, ii, ij, j, jj, k, l, m |
10 |
Integer :: t, tt |
11 |
! -------------------------------------------------------------------- |
12 |
ii = nl |
13 |
m = 1 |
14 |
i = ii |
15 |
j = nu |
16 |
10 If ( i >= j ) Go To 80 |
17 |
20 k = i |
18 |
ij = (j+i)/2 |
19 |
t = a(ij) |
20 |
If ( a(i) <= t ) Go To 30 |
21 |
a(ij) = a(i) |
22 |
a(i) = t |
23 |
t = a(ij) |
24 |
30 l = j |
25 |
If ( a(j) >= t ) Go To 50 |
26 |
a(ij) = a(j) |
27 |
a(j) = t |
28 |
t = a(ij) |
29 |
If ( a(i) <= t ) Go To 50 |
30 |
a(ij) = a(i) |
31 |
a(i) = t |
32 |
t = a(ij) |
33 |
Go To 50 |
34 |
40 a(l) = a(k) |
35 |
a(k) = tt |
36 |
50 l = l - 1 |
37 |
If ( a(l) > t ) Go To 50 |
38 |
tt = a(l) |
39 |
60 k = k + 1 |
40 |
If ( a(k) < t ) Go To 60 |
41 |
If ( k <= l) Go To 40 |
42 |
If ( l - i <= j - k ) Go To 70 |
43 |
il(m) = i |
44 |
iu(m) = l |
45 |
i = k |
46 |
m = m + 1 |
47 |
Go To 90 |
48 |
70 il(m) = k |
49 |
iu(m) = j |
50 |
j = l |
51 |
m = m + 1 |
52 |
Go To 90 |
53 |
80 m = m - 1 |
54 |
If ( m == 0 ) Return |
55 |
i = il(m) |
56 |
j = iu(m) |
57 |
90 If ( j-i >= 11 ) Go To 20 |
58 |
If ( i == ii ) Go To 10 |
59 |
i = i - 1 |
60 |
100 i = i + 1 |
61 |
If ( i == j ) Go To 80 |
62 |
t = a(i+1) |
63 |
If ( a(i) <= t) Go To 100 |
64 |
k = i |
65 |
110 a(k+1) = a(k) |
66 |
k = k - 1 |
67 |
If ( t < a(k) ) Go To 110 |
68 |
a(k+1) = t |
69 |
Go To 100 |
70 |
! -------------------------------------------------------------------- |
71 |
End Subroutine iqsort |
72 |
|