-
Notifications
You must be signed in to change notification settings - Fork 0
/
quickSort_Module.f90
111 lines (84 loc) · 2.78 KB
/
quickSort_Module.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
MODULE quickSort
USE basics
IMPLICIT NONE
CONTAINS
SUBROUTINE quick_sort(list_in, list_out)
IMPLICIT NONE
REAL(dp), DIMENSION (:), INTENT(IN) :: list_in
REAL(dp), DIMENSION (:), INTENT(OUT) :: list_out
INTEGER order(size(list_in))
call quick_sort_index(list_in, list_out, order)
END SUBROUTINE quick_sort
SUBROUTINE quick_sort_index(list_in, list_out, order)
! Quick sort routine from:
! Brainerd, W.S., Goldberg, C.H. & Adams, J.C. (1990) "Programmer's Guide to
! Fortran 90", McGraw-Hill ISBN 0-07-000248-7, pages 149-150.
! Modified by Alan Miller to include an associated integer array which gives
! the positions of the elements in the original order.
IMPLICIT NONE
REAL(dp), DIMENSION (:), INTENT(IN) :: list_in
REAL(dp), DIMENSION (:), INTENT(OUT) :: list_out
INTEGER, DIMENSION (:), INTENT(OUT) :: order
! Local variable
INTEGER :: i
list_out = list_in
DO i = 1, SIZE(list_out)
order(i) = i
END DO
CALL quick_sort_1(1, SIZE(list_out))
CONTAINS
RECURSIVE SUBROUTINE quick_sort_1(left_end, right_end)
INTEGER, INTENT(IN) :: left_end, right_end
! Local variables
INTEGER :: i, j, itemp
REAL(dp) :: reference, temp
INTEGER, PARAMETER :: max_simple_sort_size = 6
IF (right_end < left_end + max_simple_sort_size) THEN
! Use interchange sort for small lists
CALL interchange_sort(left_end, right_end)
ELSE
! Use partition ("quick") sort
reference = list_out((left_end + right_end)/2)
i = left_end - 1; j = right_end + 1
DO
! Scan list from left END until element >= reference is found
DO
i = i + 1
IF (list_out(i) >= reference) EXIT
END DO
! Scan list from right END until element <= reference is found
DO
j = j - 1
IF (list_out(j) <= reference) EXIT
END DO
IF (i < j) THEN
! Swap two out-of-order elements
temp = list_out(i); list_out(i) = list_out(j); list_out(j) = temp
itemp = order(i); order(i) = order(j); order(j) = itemp
ELSE IF (i == j) THEN
i = i + 1
EXIT
ELSE
EXIT
END IF
END DO
IF (left_end < j) CALL quick_sort_1(left_end, j)
IF (i < right_end) CALL quick_sort_1(i, right_end)
END IF
END SUBROUTINE quick_sort_1
SUBROUTINE interchange_sort(left_end, right_end)
INTEGER, INTENT(IN) :: left_end, right_end
! Local variables
INTEGER :: i, j, itemp
REAL(dp) :: temp
DO i = left_end, right_end - 1
DO j = i+1, right_end
IF (list_out(i) > list_out(j)) THEN
temp = list_out(i); list_out(i) = list_out(j); list_out(j) = temp
itemp = order(i); order(i) = order(j); order(j) = itemp
END IF
END DO
END DO
END SUBROUTINE interchange_sort
END SUBROUTINE quick_sort_index
END MODULE quickSort