@*0 Test of Hash and Insertion ranking.
@f range _range
@f index _index

@*1 Main program.
This program performs a timing of the six major ranking algorithms provided in the module |Sorting_Ranking| for arrays of different sizes and different initial disorders.
@a@%%
PROGRAM Time_Ranking @;
 USE Precision @;
 USE Sorting_Ranking @;
 USE Random_Numbers @;
 USE Simple_Graphics @;
 USE StopWatch @;
 IMPLICIT NONE @; 
 
 INTEGER :: size_array, min_size, max_size, n_repeated @;
 INTEGER, DIMENSION(:), ALLOCATABLE :: permutation @; 
 INTEGER, DIMENSION(:), ALLOCATABLE :: i_array @;
 REAL, DIMENSION(:), ALLOCATABLE :: r_array @; 

 TYPE(WATCHTYPE) :: timer, timers[10] @;
 REAL :: disorder, elapsed_time, mean, std @;   
 INTEGER :: i,j,reps, n_reps, n_calls, n_steps @;
 LOGICAL :: test @;
 CHARACTER(LEN=1) :: distribution, method @;
 CHARACTER(LEN=25) :: buffer, file_name
 REAL, DIMENSION(:,:,:), ALLOCATABLE :: timing_matrix @;

 CALL CREATE_WATCH(timer) @;
 CALL CREATE_WATCH(timers) @;
 CALL UnpredictableSeeds() @;
 debug=.FALSE. @;

 WRITE(*,*) "Enter min_size, max_size as LOG10 of actual array size: " @;
 READ(*,*) min_size,max_size @; 
 WRITE(*,*) "Enter the number of disorders to time (>=2):"
 READ(*,*) n_steps @;
 WRITE(*,*) "Distribution for random numbers in array ('Uniform' or 'Normal'):" @;
 READ(*,*) distribution @; 
 ALLOCATE(timing_matrix(6,n_steps,max_size-min_size+1)) @; // The timing results for 6 sorts

 OPEN(UNIT=10,FILE="TimeRanking.full.dat",STATUS="REPLACE",ACTION="WRITE") @;
 @%%,POSITION="APPEND") @;
 @%% WRITE(buffer,"(F10.2)") disorder @;
 @%% file_name="TimingDisorder_"\/TRIM(ADJUSTL(buffer))\/".dat" @;
 @%% OPEN(UNIT=20,FILE=TRIM(file_name),STATUS="UNKNOWN",ACTION="WRITE",POSITION="APPEND") @;
 OPEN(UNIT=20,FILE="TimeRanking.short.dat",STATUS="REPLACE",ACTION="WRITE") @;
 OPEN(UNIT=30,FILE="TimeRanking.matrix.dat",STATUS="REPLACE",ACTION="WRITE") @;

	 ChangeSize: DO j=min_size, max_size @;	
	    size_array=10^j @; 
	    @%% INT(10.0^(0.5*(j+1)))
	    ALLOCATE(permutation(size_array), r_array(size_array)) @; 	  
		 ChangeDisorder: DO i=1, n_steps @;		 
	       disorder= @E REAL(i-1)/ @E REAL(n_steps-1) @; 
		    WRITE(*,*) "Now doing arrays of size:", size_array, " disorder=", disorder @;
		    WRITE(*,*) "___________________________________________" @;    
		    WRITE(10,*) "Now doing arrays of size:", size_array, " disorder=", disorder     
		    WRITE(10,*) "___________________________________________" @;   
		    WRITE(20,FMT="(2I3,F10.2,I10)",ADVANCE="NO") i,j,disorder,size_array @; 		  
			
			 IF(distribution=="U") THEN @;
			   CALL RandomUniform(r_array) @; // |range=(/0.0,1.0/)| by default
			   mean=0.5 @;
			   std=0.5/SQRT(3.0) @;
			 ELSE @;  
			   CALL RandomNormal(r_array) @; // |mean_std=(/0.0,1.0/)| by default
			   mean=0.0 @;
			   std=1.0 @;
			 END IF @;  

			 CALL MergeRank(r_array, permutation) @; // Order then disorder the array
			 r_array=r_array(permutation) @; 
			 CALL DisorderPermutation(permutation=permutation, &
			        disorder=disorder,disorder_distribution='N') @;    
			 r_array=r_array(permutation) @; // Now disorder the sorted array

			 _TimeRank("ORDERPACK's MergeRank",_CallMerge,1) @;
			 IF(LOG(@E REAL(size_array))<=-0.65*LOG(disorder+0.01)+9.90) THEN @; // Empirical test
			    _TimeRank("InsertionRank",_CallInsertion,2) @;
			 ELSE @;
			    _TimeRank("DummyInsertionRank",_Dummy,2) @;	    
			 END IF @;   
			 IF( (disorder<0.5) .OR. ( (disorder>=0.5) .AND. (size_array<=1500000)) ) THEN @;
			    _TimeRank("ShellRank",_CallShell,3) @;
			 ELSE @;
			    _TimeRank("DummyShellRank",_Dummy,3) @;	    
			 END IF @;   
			 _TimeRank("QuickRank",_CallQuick,4) @;
			 _TimeRank("HashRank",_CallHash,5) @;				 
			 _TimeRank("RadixRank",_CallRadix,6) @;	 

		    WRITE(*,*) "___________________________________________" @;    
		    WRITE(10,*) "___________________________________________" @;        	 	 	  
		    WRITE(20,*) @; // A new line
		    CALL FLUSH(10) @~; CALL FLUSH(20) @; // Flush the I/O buffers
		    
	    END DO ChangeDisorder @;    
	    DEALLOCATE(r_array, permutation) @;   	    
    END DO ChangeSize @;

    WRITE(30,*) SHAPE(timing_matrix) @;
    WRITE(30,*) timing_matrix @;
    CLOSE(10) @;
    CLOSE(20) @; 
    CLOSE(30) @;  
 
END PROGRAM Time_Ranking @;  
@*2 Timing A Ranking Routine.
@m _CallMerge @;
    CALL MergeRank(r_array, permutation) @;
@m _CallInsertion @;
	 CALL ShellInsertionRank(array=r_array, permutation= permutation, &
	      partially_ranked = .FALSE., method="Insertion" ) @;
@m _CallShell @;
	 CALL ShellInsertionRank(array=r_array, permutation= permutation, &
	      partially_ranked = .FALSE., method="Shell", disorder=disorder) @;	      
@m _CallQuick @;
	 CALL QuickRank(array=r_array, permutation=permutation, &
	                mean_value=mean, standard_deviation=std, & 
	                partially_ranked = .FALSE., pivot_selection=distribution) @;  
@m _CallHash @;
	 CALL HashRank(array=r_array, permutation=permutation, &
	                mean_value=mean, standard_deviation=std, & 
	                partially_ranked = .FALSE., distribution=distribution) @;   
@m _CallRadix @;
    CALL RadixRank(array=TRANSFER(r_array, MOLD=1, SIZE=size_array), &
                   permutation= permutation, partially_ranked = .FALSE.) @; 	                                     
@%%		                	      
@m _TimeRank(Rank,_CallRanking,ID) @;
    n_swaps=0 @;
    n_reps=0 @;   
    n_calls=MAX(1,10000/size_array) @; // To avoid timing overhead influence
	 CALL RESET_WATCH(timer) @;
	 DO   
	    n_reps=n_reps+n_calls @;  	 
		 CALL START_WATCH(timer) @;
		 DO reps=1,n_calls @;
         _CallRanking @;
       END DO @;
		 CALL STOP_WATCH(timer) @;  
		 CALL READ_WATCH(read_result=elapsed_time, watch=timer, clock="cpu") @;  
		 IF(elapsed_time>5.0) @~ EXIT @; // Enough accuracy for now                  
	 END DO
	 timing_matrix(ID,i,j)=elapsed_time/@E REAL(n_reps) @;
    WRITE(*,*) Rank," took (s):", elapsed_time/@E REAL(n_reps) @; 	
    WRITE(*,*) "Number of swaps=",n_swaps/n_reps @;     
    WRITE(10,*) Rank," took (s):", elapsed_time/@E REAL(n_reps) @; 	   
    WRITE(10,*) "Number of swaps=",n_swaps/n_reps @; 
    WRITE(20,FMT="(E10.3)",ADVANCE="NO") elapsed_time/@E REAL(n_reps)     
@%%
@I HPF2Formatting.hweb
@%%