!! Sortiert eingegebene Zahlenwerte mit dem Quicksort-Algorithmus
!! (c) sdteffen 6/97

!! Subroutine um Feldwerte zu tauschen
  module utilities
  implicit none
  contains

   subroutine swap(feld, n1, n2)
     real, pointer :: feld(:)
     integer, intent(in) :: n1, n2
     real :: rswap
  
     rswap = feld(n1)
     feld(n1) = feld(n2)
     feld(n2) = rswap    
    return
   end subroutine swap

   recursive subroutine QuickSort(a, lo0, hi0)
     real, pointer :: a(:)
     integer, intent(in) :: lo0, hi0

     integer :: hi, lo, mid
     
     hi = hi0
     lo = lo0
     
     if ( hi0.gt.lo0) then
        mid = a( ( lo0 + hi0 ) / 2 )
        do while( lo.le.hi )
          do while( ( lo .lt. hi0 ).and. ( a(lo) .lt. mid ))
            lo = lo+1
          end do
          do while( ( hi .gt. lo0 ).and.( a(hi) .gt. mid ))
            hi=hi-1
          end do
          if( lo .le. hi ) then 
            call swap(a, lo, hi)
            lo = lo+1
            hi = hi-1
          end if
        end do  
     end if
     if( lo0 .lt. hi )then
       call QuickSort( a, lo0, hi )
     end if
     if( lo .lt. hi0 )then
       call QuickSort( a, lo, hi0 )
     end if
    return
   end subroutine QuickSort
  end module utilities


  program Sort

   use utilities
   implicit none

!! Anzahl der einzugebenden Werte
   integer :: nZahlen

!! Laufvariable
   integer :: i

!! Abfrage
   character (len = 1) :: cWiederholung = 'j'

!! Real - Feld beliebiger Groesse
   real, pointer :: rZahlen(:)

!! Eingabe soll mehrfach moeglich sein
   do while((cWiederholung.eq.'j').or.(cWiederholung.eq.'J'))

     !! Feldgroesse ermitteln
     write(*,'(A)', advance='no')' Anzahl der zu sortierenden Zahlenwerte: '
     read(*, *)nZahlen

     !! dynamisches Feld anlegen
     allocate(rZahlen(nZahlen),stat=i)

     !! Fehler ?  
     if(i.ne.0) stop 'Speicherreservierung nicht moeglich'

     !! Zahlenwerte einlesen
     do i=1, nZahlen
       write(*,'(I5,A)', advance='no')i,'. Zahl: '
       read(*, *)rZahlen(i)
     end do

     !! Sortieren

     call QuickSort(rZahlen, 1, nZahlen)

    !! Ausgabe

     write(*,*)
     write(*,*)'Sortierte Zahlenfolge'
     do i=nZahlen, 1, -1
       write(*, *)rZahlen(i)
     end do
     
    !! Speicher freigeben
     deallocate(rZahlen)

     write(*,'(A)',advance='no')' Sollen weitere Zahlen sortiert werden ? '
     read(*,*)cWiederholung
   end do

   stop "i'm tryin' to tell you now it's sabotage"
   
   

  end program Sort