sort_unique_strings Subroutine

   subroutine sort_unique_strings(a)
      type(string_t), allocatable, intent(inout) :: a(:)
      type(string_t), allocatable :: out(:)
      integer :: i, nuniq

      if (.not. allocated(a)) return
      if (size(a) <= 1) return

      call qsort(a, 1, size(a))

      nuniq = 1
      do i = 2, size(a)
         if (a(i)%s /= a(i-1)%s) nuniq = nuniq + 1
      end do

      if (nuniq == size(a)) return

      allocate(out(nuniq))
      out(1) = a(1)
      nuniq = 1
      do i = 2, size(a)
         if (a(i)%s == a(i-1)%s) cycle
         nuniq = nuniq + 1
         out(nuniq) = a(i)
      end do

      call move_alloc(out, a)
   contains
      recursive subroutine qsort(x, lo, hi)
         type(string_t), intent(inout) :: x(:)
         integer, intent(in) :: lo, hi
         integer :: i, j
         character(len=:), allocatable :: p
         type(string_t) :: t

         if (lo >= hi) return

         i = lo
         j = hi
         p = x((lo+hi)/2)%s

         do
            do while (x(i)%s < p)
               i = i + 1
            end do
            do while (p < x(j)%s)
               j = j - 1
            end do
            if (i <= j) then
               t = x(i)
               x(i) = x(j)
               x(j) = t
               i = i + 1
               j = j - 1
            end if
            if (i > j) exit
         end do

         if (lo < j) call qsort(x, lo, j)
         if (i < hi) call qsort(x, i, hi)
      end subroutine qsort
   end subroutine sort_unique_strings