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