Viewing contents of file '../idllib/astron/contrib/varosi/vlibm/allpro/chi_resid_corr.pro'
function chi_Resid_Corr, image_deconv, gradient, LAG_AUTO_CORR=Lag_ac, $
						 RATIO=ratio, SPECTRUM=spectrum
; Used by procedure Max_Resid_Like,
; Based on:
;	"Incorporation of Spatial Information in Bayesian Image Reconstruction:
;			the Maximum Residual Likelihood (MRL) Criterion",
; by Robert Pina and Richard Puetter UCSD 1992.
; coded by Frank Varosi NASA/GSFC 1992.
; F.V. 1992, added new positivity constraint function as suggested by R.P.,
;	so that final deconv image result = positivity( image_deconv ).

  common Deconv_Data, imaged, psf, psf_FT
  common Max_Resid_Like, close, phase2
  common chi_Resid_Corr, sigma, Lagac, mode
  common chi_Resid_Corr1, epsilon
  common chi_Resid_Corr2, resid, rac

	resid = imaged - convolve( positivity( image_deconv, EPS=epsilon ), $
							psf, FT_PSF = psf_FT )
	if N_elements( close ) NE 1 then close=0
	if N_elements( sigma ) NE 1 then sigma=0

	if N_elements( Lag_ac ) GT 0 then begin
		Lag = Lag_ac(0)
		if N_elements( Lag_ac ) GT 1 then Lagmin=Lag_ac(1) else Lagmin=1
	  endif else begin
		Lag = Lagac(0)
		if N_elements( Lagac ) GT 1 then Lagmin=Lagac(1) else Lagmin=1
	   endelse

	npix = N_elements( resid )
	sim = size( resid )
	Lag = (Lag > 0) < ( min( sim(1:2) )/2 -1 )
	Lagmin = ( Lagmin < Lag ) > 0

	if (Lag LE 3) then begin

	   rac = fltarr( 2*Lag+1, Lag+1 )

	   for L = Lagmin, Lag do begin
	    for i=1-L,L-1 do rac(Lag+i,L) = total( resid * shift( resid, i,L ) )
		for j=0,L do rac(Lag+L,j) = total( resid * shift( resid, L,j ) )
		for j=1,L do rac(Lag-L,j) = total( resid * shift( resid,-L,j ) )
	   endfor

	  endif else begin

		rac = convolve( resid, /AUTO_CORREL )

		s = sim/2 - Lag
		s(2) = s(2) + Lag
		L = sim/2 + Lag		;get the non-redundant elements only.

		rac = rac(s(1):L(1),s(2):L(2))
		rac(0:Lag-1,0) = 0

		if (Lagmin GT 0) then begin
			L1 = Lagmin-1
			rac( Lag-L1:Lag+L1, 0:L1 ) = 0
		   endif
	   endelse

	if (sigma GT 0) then begin
		sig2 = npix * sigma^2
		sig4 = npix * sigma^4
	  endif else begin
		sig = stdev( resid )
		sig2 = npix * sig^2
		sig4 = npix * sig^4
	   endelse

	if (Lagmin EQ 0) then rac(Lag,0) = (rac(Lag,0) - sig2)/sqrt(2)

	if keyword_set( spectrum ) then begin

		Lags = indgen( Lag ) + 1
		modes = (2*Lags+1)*(Lags+1) - Lags
		L = Lagmin-1
		modes = modes - ( (2*L+1)*(L+1) - L ) - 2
		chis = fltarr( Lag )
	    	for j=1,Lag do chis(j-1) = total( rac( Lag-j:Lag+j, 0:j )^2 )
		chis = chis/sig4
		if keyword_set( ratio ) then chis = chis/modes
		return, [ [modes], [chis] ]

	  endif else begin

		mode = (2*Lag+1)*(Lag+1) - Lag
		if (Lagmin GT 0) then begin
			L = Lagmin-1
			mode = mode - ( (2*L+1)*(L+1) - L )
		   endif
		mode = (mode-2) > 1
		chisq = total( rac * rac )/sig4
		if keyword_set( ratio ) then return, chisq/mode
	   endelse

	if N_params() GE 2 then begin

		resid = convolve( resid, FT_PSF=psf_FT, /CORREL )
		rac(Lag,0) = rac(Lag,0) / sqrt(2)
		gradient = fltarr( sim(1), sim(2) )

		for L = Lagmin, Lag do begin

			for i=1-L,L-1 do gradient = gradient + rac(Lag+i,L) * $
				( shift( resid, -i,-L ) + shift( resid, i, L ) )

			for j=0,L do gradient = gradient + rac(Lag+L,j) * $
				( shift( resid, -L,-j ) + shift( resid, L, j ) )

			for j=1,L do gradient = gradient + rac(Lag-L,j) * $
				( shift( resid, -L, j ) + shift( resid, L,-j ) )
		  endfor

		rac(Lag,0) = rac(Lag,0) * sqrt(2)
		if (close) then  fac=4*(chisq - mode)/sig4  else  fac=2/sig4
		gradient = -fac * positivity( image_deconv,/DERIV ) * gradient
	   endif

if (close) then  return,(chisq - mode)^2  else  return,chisq
end