Viewing contents of file '../idllib/contrib/meron/m_smooth.pro'
Function M_Smooth, arr, wid, deriv = nder, edge_truncate = edt

;+
; NAME:
;	M_SMOOTH
; VERSION:
;	3.0
; PURPOSE:
;	Non broadening data smoothing.
; CATEGORY:
;	Array function.
; CALLING SEQUENCE:
;	Result = M_SMOOTH( ARR, WID [keywords])
; INPUTS:
;    ARR
;	Array, numeric, no more than six dimensions.
;    WID
;	The width of the smoothing window.  Can be given either as a scalar (in
;	which case it is applied to all the dimensions of the array, or as a 
;	vector (in which case each entry applies to one dimension).  The WIDTH
;	entry(s) should be an odd number(s), if it is even the next higher odd 
;	number(s) will be used.
; OPTIONAL INPUT PARAMETERS:
;	None.
; KEYWORD PARAMETERS:
;    DERIV
;	Causes the smoothed derivative (first or second) of the data to be 
;	returned instead of the data itself.  Currently valid only for 1D 
;	arrays.
;    /EDGE_TRUNCATE
;	Switch.  Same as in the IDL version of SMOOTH.
; OUTPUTS:
;	Returns the smoothed array or (optionally) its first or second 
;	derivative.
; OPTIONAL OUTPUT PARAMETERS:
;	None.
; COMMON BLOCKS:
;	None.
; SIDE EFFECTS:
;	None.
; RESTRICTIONS:
;	None.
; PROCEDURE:
;	Uses a variation of the Savitzky-Golay procedure.  Superior to the IDL
;	provided SMOOTH routine in the sense that it doesn't introduce peak 
;	broadening.  Note that:
;
;	1)  The width needed obtain a given degree of smoothing is about twice 
;	    as big as with SMOOTH (which isn't a problem since this extra width
;	    doesn't cause broadening.
;	2)  Since the averaging kernel isn't positive definite, in some rare
;	    cases (high and very narrow peaks with little or no background)
;	    M_SMOOTH may generate artifacts.
;
;	Calls CAST, DEFAULT, DIAGOARR, MAKE_GRID, M_CONVOL, SOLVE_LINSYS and
;	TYPE from MIDL.
; MODIFICATION HISTORY:
;	Created 25-JAN-1997 by Mati Meron.
;-

    on_error, 1
    ndmx = 6

    siz = size(reform([arr]))
    ndm = siz(0)
    if ndm gt ndmx then message, 'At most six dimensions are allowed'
    nder = Default(nder,0,/dtype)

    if nder gt 0 then begin
	if ndm gt 1 then message, 'Derivatives allowed only with 1D data'
	wwid = Default(wid,3l,/dtype) > 3l
    endif else begin
	wwid = Default(wid,1l,/dtype) > 1l
	if n_elements(wwid) eq 1 then wwid = replicate(wwid,ndm) else $
	if n_elements(wwid) ne ndm then message, 'Improper width dimension!'
    endelse

    m = Cast(floor(wwid/2.),4,Type(arr))
    if nder gt 0 then k = findgen(2*m+1) - m
    if min(siz(1:ndm) - 2*m - 1) lt 0 then message, 'Width exceeds array size'

    case nder of
	0:	begin
		    ks = (Make_grid(transpose([[-m],[m]]),2*m+1,fun=ker))^2

		    s2 = [1.,m*(m+1)/3]
		    s4 = s2*[1.,(3*m^2 + 3*m - 1)/5]
		    sar = s2#transpose(s2) + Diagoarr(s4 - s2^2)
		    rhs = [1.*ndm/n_elements(ks),fltarr(ndm)]
		    lam = Solve_linsys(sar,rhs,/svd)

		    ker = ker + lam(0)
		    if ndm eq 1 then ker = ker + lam(1)*ks else $
		    for i = 0, ndm-1 do ker = ker + lam(i+1)*ks(i,*,*,*,*,*)
		    ker = reform(ker,2*m+1)
		end
	1:	ker = -3.*k/(m*(m+1)*(2*m+1))
	2:	ker = 30.*(3*k^2 - m*(m+1))/(m*(m+1)*(2*m-1)*(2*m+1)*(2*m+3))
	else:	message, 'Derivative of order'+ string(nder)+ ' not supported!'
    endcase

    if not keyword_set(edt) then begin
	l = lonarr(ndmx)
	l(0:ndm-1) = m
 	h = lonarr(ndmx)
	h(0:ndm-1) = siz(1:ndm) - m - 1
	res = Cast(arr,4)
	tres = M_convol(arr,ker)
	res(l(0):h(0),l(1):h(1),l(2):h(2),l(3):h(3),l(4):h(4),l(5):h(5)) = $
	tres(l(0):h(0),l(1):h(1),l(2):h(2),l(3):h(3),l(4):h(4),l(5):h(5))
    endif else res = M_convol(arr,ker,/edge_trun)

    return, res
end