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