Viewing contents of file '../idllib/uit/pro/bsort.pro'
function Bsort, Array, Asort, INFO=info, REVERSE = rev
;+
; NAME:
;	BSORT
; PURPOSE:
;	Function to sort data into ascending order, like a simple bubble sort.
;	original subscript order is maintained when values are equal (FIFO).
;	(This differs from the IDL SORT routine alone, which may rearrange 
;	order for equal values)
;
; CALLING SEQUENCE:  
;	result = bsort( array, [ asort, /INFO, /REVERSE ] )
;
; INPUT:
;	Array - array to be sorted
;
; OUTPUT:
;	result - sort subscripts are returned as function value
;
; OPTIONAL OUTPUT:
;	Asort - sorted array
;
; OPTIONAL KEYWORD INPUTS:
;       /REVERSE - if this keyword is set, and non-zero, then data is sorted
;                 in descending order instead of ascending order.
;	/INFO = optional keyword to cause brief message about # equal values.
;
; HISTORY
;	written by F. Varosi Oct.90:
;	uses WHERE to find equal clumps, instead of looping with IF ( EQ ).
;	compatible with string arrays, test for degenerate array 
;	20-MAY-1991	JKF/ACC via T AKE- return indexes if the array to 
;			be sorted has all equal values.
;	Aug - 91  Added  REVERSE keyword   W. Landsman      
;-
	N = N_elements( Array )
	if N lt 1 then begin
		print,'Input to BSORT must be an array'
		return, [0]
 	   endif
	if N lt 2 then return,[0]    ;Only 1 element
;
; sort array (in descending order if REVERSE keyword specified )
;
	subs = sort( Array )
        if keyword_set( REV ) then subs = rotate(subs,5)  
	Asort = Array(subs)
;
; now sort subscripts into ascending order
; when more than one Asort has same value
;
	     weq = where( (shift( Asort, -1 ) eq Asort) , Neq ) 

	if keyword_set( info ) then $
		message, strtrim( Neq, 2 ) + " equal values Located",/CON,/INF

	if (Neq EQ n) then return,lindgen(n) ;Array is degenerate equal values

	if (Neq GT 0) then begin

		if (Neq GT 1) then begin	      ;find clumps of equality

			wclump = where( (shift( weq, -1 ) - weq) GT 1, Nclump )
			Nclump = Nclump + 1

		  endif else Nclump = 1

		if (Nclump LE 1) then begin
			Clump_Beg = 0
			Clump_End = Neq-1
		  endif else begin
			Clump_Beg = [0,wclump+1]
			Clump_End = [wclump,Neq-1]
		   endelse

		weq_Beg = weq( Clump_Beg )		;subscript ranges
		weq_End = weq( Clump_End ) + 1		; of Asort equalities.

		if keyword_set( info ) then message, strtrim( Nclump, 2 ) + $
				" clumps of equal values Located",/CON,/INF

		for ic = 0L, Nclump-1 do begin		;sort each clump.

			subic = subs( weq_Beg(ic) : weq_End(ic) )
		        subs( weq_Beg(ic) ) = subic( sort( subic ) )
		  endfor

		if N_params() GE 2 then Asort = Array(subs)	;resort array.
	   endif

return, subs
end