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