Correctly calling qsort from C

11

When possible I sort derived types by converting them to REALs and sorting those. For example a date type (month,day,year) can be converted a Julian day. Rosetta code shows how to Sort using a custom comparator in Fortran. Here is the code, pasting a needed function, fixing the array of strings constructor, and making a few small other changes:

module sorts_with_custom_comparator
  implicit none
contains
  subroutine a_sort(a, cc)
    character(len=*), dimension(:), intent(inout) :: a
    interface
       integer function cc(a, b)
         character(len=*), intent(in) :: a, b
       end function cc
    end interface
 
    integer :: i, j, increment
    character(len=max(len(a), 10)) :: temp
 
    increment = size(a) / 2
    do while ( increment > 0 )
       do i = increment+1, size(a)
          j = i
          temp = a(i)
          do while ( j >= increment+1 .and. cc(a(j-increment), temp) > 0)
             a(j) = a(j-increment)
             j = j - increment
          end do
          a(j) = temp
       end do
       if ( increment == 2 ) then
          increment = 1
       else
          increment = increment * 5 / 11
       end if
    end do
  end subroutine a_sort
end module sorts_with_custom_comparator
! Then we have to put our custom comparator in a module (to_lower is defined here):

module comparators
  implicit none
contains
   subroutine To_lower(str)
     character(*), intent(in out) :: str
     integer :: i
 
     do i = 1, len(str)
       select case(str(i:i))
         case("A":"Z")
           str(i:i) = achar(iachar(str(i:i))+32)
       end select
     end do  
   end subroutine To_Lower
!
  integer function my_compare(a, b)
    character(len=*), intent(in) :: a, b
 
    character(len=max(len(a),len(b))) :: a1, b1
 
    a1 = a
    b1 = b
    call to_lower(b1)
    call to_lower(a1)
 
    if ( len(trim(a)) > len(trim(b)) ) then
       my_compare = -1
    elseif ( len(trim(a)) == len(trim(b)) ) then
       if ( a1 > b1 ) then
          my_compare = 1
       else
          my_compare = -1
       end if
    else
       my_compare = 1
    end if
  end function my_compare
end module comparators
! At the end, we can test these:

program CustomComparator
  use comparators, only: my_compare
  use sorts_with_custom_comparator, only: a_sort
  implicit none
  character(len=100), dimension(8) :: str
  integer :: i
  str = ["this   ", "is     ", "an     ", "array  ", "of     ", "strings", "to     ", "sort   "]
  call a_sort(str, my_compare)
  do i = 1, size(str)
     print *, trim(str(i))
  end do
end program CustomComparator

It gives output

 strings
 array
 sort
 this
 an
 is
 of
 to

which

sort[s] an array (or list) of strings in order of descending length, and in ascending lexicographic order for strings of equal length.

The Fortran Wiki has a relevant qsort_inline code.