lexical_sort_recursive Subroutine

public subroutine lexical_sort_recursive(str, case_sensitive)

Sorts a character array str in increasing order. Uses a basic recursive quicksort (with insertion sort for partitions with <= 20 elements).

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(inout), dimension(:) :: str
logical, intent(in) :: case_sensitive

if true, the sort is case sensitive


Source Code

    subroutine lexical_sort_recursive(str,case_sensitive)

    implicit none

    character(len=*),dimension(:),intent(inout) :: str
    logical,intent(in) :: case_sensitive !! if true, the sort is case sensitive

    call quicksort(1,size(str))

    contains

    !***************************************************************
    !>
    !  Sort the array, based on the lexical string comparison.

        recursive subroutine quicksort(ilow,ihigh)

        implicit none

        integer,intent(in) :: ilow
        integer,intent(in) :: ihigh

        integer :: ipivot !! pivot element
        integer :: i      !! counter
        integer :: j      !! counter

        if ( ihigh-ilow<=max_size_for_insertion_sort .and. ihigh>ilow ) then

            ! do insertion sort:
            do i = ilow + 1,ihigh
                do j = i,ilow + 1,-1
                    if ( lexical_lt(str(j),str(j-1),case_sensitive) ) then
                        call swap(str(j),str(j-1))
                    else
                        exit
                    end if
                end do
            end do

        elseif ( ihigh-ilow>max_size_for_insertion_sort ) then

            ! do the normal quicksort:
            call partition(ilow,ihigh,ipivot)
            call quicksort(ilow,ipivot - 1)
            call quicksort(ipivot + 1,ihigh)

        end if

        end subroutine quicksort

    !***************************************************************
    !>
    !  Partition the array, based on the lexical string comparison.

        subroutine partition(ilow,ihigh,ipivot)

        implicit none

        integer,intent(in)  :: ilow
        integer,intent(in)  :: ihigh
        integer,intent(out) :: ipivot

        integer :: i,ip

        call swap(str(ilow),str((ilow+ihigh)/2))
        ip = ilow
        do i = ilow + 1, ihigh
            if (lexical_lt(str(i),str(ilow),case_sensitive)) then
                ip = ip + 1
                call swap(str(ip),str(i))
            end if
        end do
        call swap(str(ilow),str(ip))
        ipivot = ip

        end subroutine partition

    end subroutine lexical_sort_recursive