Line data Source code
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 16803071 : 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 16803071 : CALL quick_sort_1(1, SIZE(list)) 34 : 35 : CONTAINS 36 : 37 32319400 : 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 32319400 : IF (right_end < left_end + max_simple_sort_size) THEN 48 : ! Use interchange sort for small lists 49 23802142 : CALL interchange_sort(left_end, right_end) 50 : 51 : ELSE 52 : ! Use partition ("quick") sort 53 8517258 : reference = list((left_end + right_end)/2) 54 8517258 : i = left_end - 1; j = right_end + 1 55 : 56 16085572 : DO 57 : ! Scan list from left end until element >= reference is found 58 : DO 59 44294139 : i = i + 1 60 44294139 : IF (list(i) >= reference) EXIT 61 : END DO 62 : ! Scan list from right end until element <= reference is found 63 : DO 64 49580050 : j = j - 1 65 49580050 : IF (list(j) <= reference) EXIT 66 : END DO 67 : 68 : 69 31903500 : IF (i < j) THEN 70 : ! Swap two out-of-order elements 71 16085572 : temp = list(i); list(i) = list(j); list(j) = temp 72 16085572 : itemp = order(i); order(i) = order(j); order(j) = itemp 73 8517258 : ELSE IF (i == j) THEN 74 1216588 : i = i + 1 75 1216588 : EXIT 76 : ELSE 77 : EXIT 78 : END IF 79 : END DO 80 : 81 8517258 : IF (left_end < j) CALL quick_sort_1(left_end, j) 82 8517258 : IF (i < right_end) CALL quick_sort_1(i, right_end) 83 : END IF 84 : 85 32319400 : END SUBROUTINE quick_sort_1 86 : 87 : 88 23802142 : 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 99698459 : DO i = left_end, right_end - 1 98 276051286 : DO j = i+1, right_end 99 252249144 : IF (list(i) > list(j)) THEN 100 74556149 : temp = list(i); list(i) = list(j); list(j) = temp 101 74556149 : itemp = order(i); order(i) = order(j); order(j) = itemp 102 : END IF 103 : END DO 104 : END DO 105 : 106 23802142 : END SUBROUTINE interchange_sort 107 : 108 : END SUBROUTINE quick_sort 109 : 110 : end module quicksort