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      648721 : 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      648721 : CALL quick_sort_1(1, SIZE(list))
      34             : 
      35             : CONTAINS
      36             : 
      37     1186869 : 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     1186869 : IF (right_end < left_end + max_simple_sort_size) THEN
      48             :   ! Use interchange sort for small lists
      49      890552 :   CALL interchange_sort(left_end, right_end)
      50             : 
      51             : ELSE
      52             :   ! Use partition ("quick") sort
      53      296317 :   reference = list((left_end + right_end)/2)
      54      296317 :   i = left_end - 1; j = right_end + 1
      55             : 
      56      559486 :   DO
      57             :     ! Scan list from left end until element >= reference is found
      58      661774 :     DO
      59     1517577 :       i = i + 1
      60     1517577 :       IF (list(i) >= reference) EXIT
      61             :     END DO
      62             :     ! Scan list from right end until element <= reference is found
      63      863327 :     DO
      64     1719130 :       j = j - 1
      65     1719130 :       IF (list(j) <= reference) EXIT
      66             :     END DO
      67             : 
      68             : 
      69      855803 :     IF (i < j) THEN
      70             :       ! Swap two out-of-order elements
      71      559486 :       temp = list(i); list(i) = list(j); list(j) = temp
      72      559486 :       itemp = order(i); order(i) = order(j); order(j) = itemp
      73      296317 :     ELSE IF (i == j) THEN
      74       45160 :       i = i + 1
      75       45160 :       EXIT
      76             :     ELSE
      77      251157 :       EXIT
      78             :     END IF
      79             :   END DO
      80             : 
      81      296317 :   IF (left_end < j) CALL quick_sort_1(left_end, j)
      82      296317 :   IF (i < right_end) CALL quick_sort_1(i, right_end)
      83             : END IF
      84             : 
      85     1186869 : END SUBROUTINE quick_sort_1
      86             : 
      87             : 
      88      890552 : 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     3676994 : DO i = left_end, right_end - 1
      98    10066106 :   DO j = i+1, right_end
      99     9175554 :     IF (list(i) > list(j)) THEN
     100     2711076 :       temp = list(i); list(i) = list(j); list(j) = temp
     101     2711076 :       itemp = order(i); order(i) = order(j); order(j) = itemp
     102             :     END IF
     103             :   END DO
     104             : END DO
     105             : 
     106      890552 : END SUBROUTINE interchange_sort
     107             : 
     108             : END SUBROUTINE quick_sort
     109             : 
     110             : end module quicksort