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).
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(inout), | dimension(:) | :: | str | ||
logical, | intent(in) | :: | case_sensitive |
if true, the sort is case sensitive |
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