PROGRAM Test_Quick
      USE Precision
      USE Sorting_Ranking
      USE Random_Numbers
      USE Simple_Graphics
      USE StopWatch
      IMPLICIT NONE
      
      INTEGER,DIMENSION(:),ALLOCATABLE::permutation
      INTEGER,DIMENSION(:),ALLOCATABLE::i_array
      REAL(KIND=r_sp),DIMENSION(:),ALLOCATABLE::r_array
      INTEGER,DIMENSION(:,:),ALLOCATABLE::i_array_2
      
      TYPE(WATCHTYPE)::timer
      REAL::elapsed_time,mean,std,disorder,memory_factor,uniformity
      LOGICAL::test,use_pointers
      INTEGER::size_array,n_repeated,cutoff,n_keys,n_bits,n_passes,n_ignored
      INTEGER::i,key
      CHARACTER(LEN=1)::distribution,method,pivot_method,pointer_method
      
      debug=.TRUE.
      CALL CREATE_WATCH(timer,name="Single real keys:")
      CALL UnpredictableSeeds()
      
      
      WRITE(*,*)"Enter the size of the integer array to be *fully* ranked: "
      READ(*,*)size_array
      WRITE(*,*)"Enter the number of repetitions per key in integer array"
      READ(*,*)n_repeated
      ALLOCATE(permutation(size_array),i_array(size_array))
      CALL RandomUniform(i_array,range=(/1,size_array/n_repeated/))
      IF(debug)THEN
      
      IF(SIZE(i_array)<=20)THEN
      WRITE(*,"(A)")"Input array:"
      WRITE(*,"(20G5.2)")i_array
      END IF
      END IF
      
      RankSingleIntegerKeys:DO
      
      WRITE(*,*)"Enter method of sorting for integers ('X'-exit, 'Shell', 'Quick', 'Hash' or 'Radix'):"
      READ(*,*)method
      IF(method=='X')EXIT RankSingleIntegerKeys
      IF(method=='R')THEN
      WRITE(*,*)"Enter the number of bits in the radix: "
      READ(*,*)n_bits
      ELSE IF(method=='H')THEN
      WRITE(*,*)"Enter method of hashing ('Pointers' or 'NoPointers'):"
      READ(*,*)pointer_method
      IF(pointer_method=='P')THEN
      use_pointers=.TRUE.
      ELSE
      use_pointers=.FALSE.
      END IF
      WRITE(*,*)"Enter the number of passes, the memory and the uniformity factors: "
      READ(*,*)n_passes,memory_factor,uniformity
      ELSE IF(method=='S')THEN
      WRITE(*,*)"Enter the final gap: "
      READ(*,*)cutoff
      ELSE
      WRITE(*,*)"Enter the cutoff size: "
      READ(*,*)cutoff
      WRITE(*,*)"Enter the pivot selection rule ('U' or 'R'): "
      READ(*,*)pivot_method
      END IF
      
      CALL RESET_WATCH(timer)
      CALL START_WATCH(timer)
      IF(method=='R')THEN
      CALL RadixRank(array=i_array,permutation=permutation,&
      partially_ranked=.FALSE.,n_radix_bits=n_bits)
      ELSE IF(method=='H')THEN
      CALL HashRank(array=i_array,permutation=permutation,&
      number_passes=n_passes,partially_ranked=.FALSE.,&
      memory_factor=memory_factor,uniformity=uniformity,&
      distribution='U',use_hash_pointers=use_pointers)
      ELSE IF(method=='S')THEN
      CALL ShellInsertionRank(array=i_array,permutation=permutation,&
      partially_ranked=.FALSE.,method="Shell",last_gap=cutoff)
      IF(cutoff>1)THEN
      CALL ShellInsertionRank(array=i_array,permutation=permutation,&
      partially_ranked=.TRUE.,method='Insertion')
      END IF
      ELSE
      CALL QuickRank(array=i_array,permutation=permutation,&
      partially_ranked=.FALSE.,pivot_selection=pivot_method,cutoff_size=cutoff)
      IF(cutoff>1)THEN
      CALL ShellInsertionRank(array=i_array,permutation=permutation,&
      partially_ranked=.TRUE.,method='Insertion')
      END IF
      END IF
      CALL STOP_WATCH(timer)
      CALL READ_WATCH(read_result=elapsed_time,watch=timer,clock="cpu")
      WRITE(*,"(A,F10.2)")"Ranking took (s):",elapsed_time
      
      test=TestPermutation(permutation)
      IF(.NOT.test)THEN
      WRITE(*,*)"The returned permutation is invalid !!!"
      STOP
      END IF
      test=TestRanking(i_array,permutation)
      IF(.NOT.test)THEN
      WRITE(*,*)"The final ranking is not strictly non-descreasing !!!"
      STOP
      END IF
      i_array=i_array(permutation)
      IF(debug)THEN
      
      IF(SIZE(i_array)<=20)THEN
      WRITE(*,"(A)")"Sorted array:"
      WRITE(*,"(20G5.2)")i_array
      END IF
      END IF
      
      END DO RankSingleIntegerKeys
      
      DEALLOCATE(permutation,i_array)
      
      WRITE(*,*)"Enter the size of the multiple-key integer array to be sorted: "
      READ(*,*)size_array
      WRITE(*,*)"Enter the number of repetitions per key in integer array"
      READ(*,*)n_repeated
      WRITE(*,*)"Enter the number of multiple keys:"
      READ(*,*)n_keys
      
      ALLOCATE(permutation(size_array),i_array_2(n_keys,size_array))
      CALL RandomUniform(i_array_2,range=(/1,size_array/n_repeated/))
      
      RankMultipleIntegerKeys:DO
      
      WRITE(*,*)"Enter method of sorting ('X'-exit, 'Q'-pure quick or 'I'-quick/insertion):"
      READ(*,*)method
      IF(method=='X')EXIT RankMultipleIntegerKeys
      
      WRITE(*,*)"Enter the cutoff size (or cutoff gap): "
      READ(*,*)cutoff
      
      IF(debug.AND.(size_array<20))THEN
      WRITE(*,*)"Multiple keys before ranking:"
      DO key=1,SIZE(i_array_2,1)
      WRITE(*,"(A,I1,A,20I5)")"Key #",key,":",i_array_2(key,:)
      END DO
      END IF
      
      CALL RESET_WATCH(timer)
      CALL START_WATCH(timer)
      IF(method=='I')THEN
      CALL QuickRank(array=i_array_2(1,:),permutation=permutation,&
      partially_ranked=.FALSE.,pivot_selection=pivot_method,cutoff_size=cutoff)
      CALL ShellInsertionRank(array=i_array_2,permutation=permutation,&
      partially_ranked=.TRUE.,method='Insertion')
      ELSE
      CALL QuickRank(array=i_array_2,permutation=permutation,&
      partially_ranked=.FALSE.,pivot_selection='R',cutoff_size=cutoff)
      IF(cutoff>1)THEN
      CALL ShellInsertionRank(array=i_array_2,permutation=permutation,&
      partially_ranked=.TRUE.,method='Insertion')
      END IF
      END IF
      CALL STOP_WATCH(timer)
      CALL READ_WATCH(read_result=elapsed_time,watch=timer,clock="cpu")
      WRITE(*,"(A,F10.2)")"Ranking took (s):",elapsed_time
      
      test=TestPermutation(permutation)
      IF(.NOT.test)THEN
      WRITE(*,*)"The permutation with multiple keys is invalid!!!"
      STOP
      END IF
      test=TestRanking(i_array_2,permutation)
      IF(.NOT.test)THEN
      WRITE(*,*)"The final ranking is not strictly non-descreasing !!!"
      STOP
      END IF
      
      i_array_2=i_array_2(:,permutation)
      IF(debug.AND.(size_array<20))THEN
      WRITE(*,*)"After ranking:"
      DO key=1,SIZE(i_array_2,1)
      WRITE(*,"(A,I1,A,20I5)")"Key #",key,":",i_array_2(key,:)
      END DO
      END IF
      
      END DO RankMultipleIntegerKeys
      
      DEALLOCATE(permutation,i_array_2)
      
      WRITE(*,*)"Enter the size of the real array to be *partially* sorted: "
      READ(*,*)size_array
      WRITE(*,*)"Enter the disorder:"
      READ(*,*)disorder
      WRITE(*,*)"Distribution for random numbers in array ('Uniform' or 'Normal'):"
      READ(*,*)distribution
      
      ALLOCATE(permutation(size_array),r_array(size_array))
      IF(distribution=="U")THEN
      CALL RandomUniform(r_array)
      mean=0.5
      std=0.5/SQRT(3.0)
      ELSE
      CALL RandomNormal(r_array)
      mean=0.0
      std=1.0
      END IF
      
      IF(disorder/=1.0)THEN
      CALL QuickRank(r_array,permutation)
      r_array=r_array(permutation)
      CALL DisorderPermutation(permutation=permutation,&
      disorder=disorder,disorder_distribution='N')
      r_array=r_array(permutation)
      END IF
      
      RankRealKeys:DO
      WRITE(*,*)"Enter method of sorting ('X'-exit, 'Q', 'R', 'H', 'I' or 'S'):"
      READ(*,*)method
      IF(method=='X')EXIT RankRealKeys
      IF(method=='S')THEN
      WRITE(*,*)"Enter the cutoff gap:"
      READ(*,*)cutoff
      ELSE IF(method=='I')THEN
      ELSE IF(method=='R')THEN
      WRITE(*,*)"Enter the number of ignored bits in the real numbers: "
      READ(*,*)n_ignored
      ELSE IF(method=='H')THEN
      WRITE(*,*)"Enter the number of passes, the memory and the uniformity factors: "
      READ(*,*)n_passes,memory_factor,uniformity
      WRITE(*,*)"Distribution for hashing ('Uniform' or 'Normal'):"
      READ(*,*)distribution
      ELSE
      WRITE(*,*)"Enter the cutoff size: "
      READ(*,*)cutoff
      WRITE(*,*)"Distribution for pivot selection ('Uniform' or 'Normal'):"
      READ(*,*)distribution
      END IF
      
      CALL RESET_WATCH(timer)
      CALL START_WATCH(timer)
      IF(method=='S'.OR.method=='I')THEN
      CALL ShellInsertionRank(array=r_array,permutation=permutation,&
      partially_ranked=.FALSE.,method=method,&
      last_gap=cutoff,disorder=disorder)
      ELSE IF(method=='R')THEN
      WRITE(*,*)"Calling RadixSort real..."
      CALL RadixRank(array=r_array,&
      permutation=permutation,&
      partially_ranked=.FALSE.,n_ignored_bits=n_ignored)
      ELSE IF(method=='H')THEN
      CALL HashRank(array=r_array,permutation=permutation,&
      partially_ranked=.FALSE.,number_passes=n_passes,&
      memory_factor=memory_factor,uniformity=uniformity,&
      distribution=distribution,use_hash_pointers=.FALSE.,full_ranking=.FALSE.)
      ELSE
      CALL QuickRank(array=r_array,permutation=permutation,&
      partially_ranked=.FALSE.,pivot_selection=distribution,cutoff_size=cutoff)
      END IF
      CALL STOP_WATCH(timer)
      CALL READ_WATCH(read_result=elapsed_time,watch=timer,clock="cpu")
      WRITE(*,"(A,F10.2)")"Ranking took (s):",elapsed_time
      
      IF(debug)THEN
      IF(size_array<2500.AND.size_array>20)THEN
      CALL InitGraphics(plot_title=(/"Almost-sorted array  ",&
      "A. Donev 1/18/2001   "/),&
      x_label="$i$",y_label="$A_{i}$")
      CALL Plot2D(x=REAL((/(i,i=1,size_array)/),r_sg),y=REAL(r_array(permutation),r_sg),&
      plot_spec="SCR")
      CALL EndGraphics()
      END IF
      END IF
      
      IF(method/='I')THEN
      WRITE(*,*)"Enter method of insertion ('Insertion' or 'Shell') for final sort:"
      READ(*,*)method
      CALL START_WATCH(timer)
      CALL ShellInsertionRank(array=r_array,permutation=permutation,&
      partially_ranked=.TRUE.,method=method,&
      disorder=REAL(cutoff)/REAL(size_array),last_gap=1)
      CALL STOP_WATCH(timer)
      CALL READ_WATCH(read_result=elapsed_time,watch=timer,clock="cpu")
      WRITE(*,"(A,F10.2)")"Partial Ranking+Insertion ranking took (s):",elapsed_time
      CALL RESET_WATCH(timer)
      END IF
      
      END DO RankRealKeys
      
      DEALLOCATE(r_array,permutation)
      
      END PROGRAM Test_Quick