quicksort.f90

Go to the documentation of this file.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Time-stamp: <2014-09-22 15:48:46 pbrowne>
!This code was taken from http://rosettacode.org/wiki/Quicksort#Fortran
!and is distributed under GNU Free Documentation License 1.2.
!see  http://www.gnu.org/licenses/fdl-1.2.html
recursive subroutine quicksort_d(a,na)
implicit none 
! DUMMY ARGUMENTS
integer, intent(in) :: nA
real(kind=kind(1.0D0)), dimension(nA), intent(inout) :: A
 
! LOCAL VARIABLES
integer :: left, right, mid
real(kind=kind(1.0D0)) :: pivot, temp
integer :: marker
 
    if (na > 1) then
        ! insertion sort limit of 47 seems best for sorting 10 million
       !  integers on Intel i7-980X CPU.  Derived data types that use
        ! more memory are optimized with smaller values - around 20 for a 16
       ! -byte type.
        if (na > 47) then
            ! Do quicksort for large groups
            ! Get median of 1st, mid, & last points for pivot (helps reduce
           !  long execution time on some data sets, such as already
            ! sorted data, over simple 1st point pivot)
            mid = (na+1)/2
            if (a(mid) >= a(1)) then
                if (a(mid) <= a(na)) then
                    pivot = a(mid)
                else if (a(na) > a(1)) then
                    pivot = a(na)
                else
                    pivot = a(1)
                end if
            else if (a(1) <= a(na)) then
                pivot = a(1)
            else if (a(na) > a(mid)) then
                pivot = a(na)
            else
                pivot = a(mid)
            end if
 
            left = 0
            right = na + 1
 
            do while (left < right)
                right = right - 1
                do while (a(right) > pivot)
                    right = right - 1
                end do
                left = left + 1
                do while (a(left) < pivot)
                    left = left + 1
                end do
                if (left < right) then
                    temp = a(left)
                    a(left) = a(right)
                    a(right) = temp
                end if
            end do
 
            if (left == right) then
                marker = left + 1
            else
                marker = left
            end if
 
            call quicksort_d(a(:marker-1),marker-1)
            call quicksort_d(a(marker:),na-marker+1)
 
        else
            call insertionsort_d(a,na)    ! Insertion sort for small groups is
            !  faster than Quicksort
        end if
    end if
 
  end subroutine quicksort_d

subroutine insertionsort_d(A,nA)
 
! DUMMY ARGUMENTS
integer, intent(in) :: nA
real(kind=kind(1.0D0)), dimension(nA), intent(in out) :: A
 
! LOCAL VARIABLES
real(kind=kind(1.0D0)) :: temp
integer :: i, j
 
    do i = 2, na
        j = i - 1
        temp = a(i)
        do
            if (j == 0) exit
            if (a(j) <= temp) exit
            a(j+1) = a(j)
            j = j - 1
        end do
        a(j+1) = temp
    end do
 
  end subroutine insertionsort_d