LCOV - code coverage report
Current view: top level - utils - quicksort.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 28 28 100.0 %
Date: 2025-01-13 21:54:50 Functions: 3 3 100.0 %

          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

Generated by: LCOV version 1.14