Viewing contents of file '../idllib/ghrs/pro/bsort.pro'
function Bsort, Array, Asort, INFO=info
;+
; 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] )
; INPUT:
;	Array - array to be sorted
;	/INFO = optional keyword to cause breif message about # equal values.
; OUTPUT:
;	result - sort subscripts are returned as function value
; OPTIONAL OUTPUT:
;	Asort - sorted array
; 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 
;        W. Landsman  November 1990
;	20-MAY-1991	JKF/ACC via T AKE- return indexes if the array to 
;					be sorted has all equal values.
;-
	N = N_elements( Array )
	if N lt 1 then begin
		print,'Input to BSORT must be an array'
		retall
 	   endif
	if N lt 2 then return,[0]    ;Only 1 element
;
; sort array
;
	subs = sort( Array )
	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,Array      ;Array is degenerate equal values
	if (Neq EQ N) then return,long(findgen(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