lexical_sort_natural_recursive Subroutine

public subroutine lexical_sort_natural_recursive(str, case_sensitive)

Sorts a character array str in increasing order, using a "natural" sorting method.

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_natural_recursive(str,case_sensitive)

    implicit none

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

    type(int_list),dimension(size(str)) :: ints !! the `str` converted into arrays of integers
    logical,dimension(size(str)) :: case_sensitive_vec !! for the elemental routine
    integer,dimension(size(str)) :: idx !! index vector for sorting
    integer :: i !! counter

    !convert vector of strings to vector of int vectors:
    case_sensitive_vec = case_sensitive
    call string_to_int_list(str,case_sensitive_vec,ints)

    idx = [(i, i=1,size(str))]
    call quicksort(1,size(str))
    str = str(idx)

    contains

    !***************************************************************
    !>
    !  Sort the index array of `str`, based on int vec 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 ( ints(idx(j)) < ints(idx(j-1)) ) then
                        call swap(idx(j),idx(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 index array of `str`, based on int vec 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(idx(ilow),idx((ilow+ihigh)/2))
        ip = ilow
        do i = ilow + 1, ihigh
            if ( ints(idx(i)) < ints(idx(ilow)) ) then
                ip = ip + 1
                call swap(idx(ip),idx(i))
            end if
        end do
        call swap(idx(ilow),idx(ip))
        ipivot = ip

        end subroutine partition

    end subroutine lexical_sort_natural_recursive