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