Statistics
| Branch: | Revision:

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