quicksort.F90 coverage: 0.00 %func 0.00 %block
1) module quicksort
2)
3) ! sort routine to arrange array elements from smallest to largest
4) !
5) ! grabbed from A millers web site http://users.bigpond.net.au/amiller/
6) ! Quick sort routine from:
7) ! Brainerd, W.S., Goldberg, C.H. & Adams, J.C. (1990) "Programmer's Guide to
8) ! Fortran 90", McGraw-Hill ISBN 0-07-000248-7, pages 149-150.
9) ! Modified by Alan Miller to include an associated integer array which gives
10) ! the positions of the elements in the original order.
11) ! pjr added module declaration
12) ! mvr modified integer array to intent inout - may now be any integer
13) ! array that gets sorted along with associated real array
14)
15) use shr_kind_mod, only: r8 => shr_kind_r8
16)
17) implicit none
18) save
19) private
20) public quick_sort
21) contains
22)
23) RECURSIVE SUBROUTINE quick_sort(list, order)
24)
25) implicit none
26)
27) REAL(r8), DIMENSION (:), INTENT(INOUT) :: list
28) INTEGER, DIMENSION (:), INTENT(INOUT) :: order
29)
30) ! Local variable
31) INTEGER :: i
32)
33) CALL quick_sort_1(1, SIZE(list))
34)
35) CONTAINS
36)
37) RECURSIVE SUBROUTINE quick_sort_1(left_end, right_end)
38)
39) implicit none
40) INTEGER, INTENT(IN) :: left_end, right_end
41)
42) ! Local variables
43) INTEGER :: i, j, itemp
44) REAL(r8) :: reference, temp
45) INTEGER, PARAMETER :: max_simple_sort_size = 6
46)
47) IF (right_end < left_end + max_simple_sort_size) THEN
48) ! Use interchange sort for small lists
49) CALL interchange_sort(left_end, right_end)
50)
51) ELSE
52) ! Use partition ("quick") sort
53) reference = list((left_end + right_end)/2)
54) i = left_end - 1; j = right_end + 1
55)
56) DO
57) ! Scan list from left end until element >= reference is found
58) DO
59) i = i + 1
60) IF (list(i) >= reference) EXIT
61) END DO
62) ! Scan list from right end until element <= reference is found
63) DO
64) j = j - 1
65) IF (list(j) <= reference) EXIT
66) END DO
67)
68)
69) IF (i < j) THEN
70) ! Swap two out-of-order elements
71) temp = list(i); list(i) = list(j); list(j) = temp
72) itemp = order(i); order(i) = order(j); order(j) = itemp
73) ELSE IF (i == j) THEN
74) i = i + 1
75) EXIT
76) ELSE
77) EXIT
78) END IF
79) END DO
80)
81) IF (left_end < j) CALL quick_sort_1(left_end, j)
82) IF (i < right_end) CALL quick_sort_1(i, right_end)
83) END IF
84)
85) END SUBROUTINE quick_sort_1
86)
87)
88) SUBROUTINE interchange_sort(left_end, right_end)
89)
90) implicit none
91) INTEGER, INTENT(IN) :: left_end, right_end
92)
93) ! Local variables
94) INTEGER :: i, j, itemp
95) REAL(r8) :: temp
96)
97) DO i = left_end, right_end - 1
98) DO j = i+1, right_end
99) IF (list(i) > list(j)) THEN
100) temp = list(i); list(i) = list(j); list(j) = temp
101) itemp = order(i); order(i) = order(j); order(j) = itemp
102) END IF
103) END DO
104) END DO
105)
106) END SUBROUTINE interchange_sort
107)
108) END SUBROUTINE quick_sort
109)
110) end module quicksort
