Viewing contents of file '../idllib/astron/contrib/varosi/vlib/allpro/fsort.pro'
function Fsort, Array, Asort, INFO=info, DESCENDING=descend
;+
; NAME:
;	FSORT
; PURPOSE:
;	Function to sort data into ascending order,
;	original subscript order is maintained when values are equal (FIFO).
;	(unlike IDL sort routine alone,
;			which may rearrange the order of equal values)
; CALLING SEQUENCE:  
;	result = fsort( array, [asort] )
; INPUT:
;	Array - array to be sorted
; KEYWORDS:
;	/INFO = optional keyword to cause brief message about # equal values.
;	/DESCENDING = descending order instead of the default ascending order.
; OUTPUT:
;	Subscripts which give sorted order are returned as function value.
; OPTIONAL OUTPUT:
;	Asort - sorted array
; METHOD:
;	uses WHERE to find equal clumps, instead of looping with IF ( EQ ).
; HISTORY:
;	written by F. Varosi NASA/GSFC 1990.
;-
	N = N_elements( Array )
	if (N EQ 1) then return,[0]    ;Only 1 element

	if (N LE 0) then begin
		message,"expecting an array as input",/INFO
		retall
	   endif

	subs = sort( Array )
	Asort = Array(subs)

; now sort subscripts into ascending order
; whenever clumps of equality are found in Asort:

	weq = where( shift( Asort, -1 ) EQ Asort, Neq )

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

	if (Neq GE N) then begin

		subs = Lindgen( N )
		Asort = Array

	 endif else 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",/INFO

		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 keyword_set( descend ) then subs = rotate( subs, 2 )
		if N_params() GE 2 then Asort = Array(subs)	;resort array.
	   endif

return, subs
end