pro thm_qfit, data, phs, phsf=phsf, es=es, ec=ec, zero=zero, $
do_sigma=do_sigma, sigma=sigma, $
period=period, slide=slide, n_fitpts=n_fitpts, $
out=out, max_err=max_err, bad_pts=bad_pts, $
fail = fail
fail = 0
two_pi = 2.d*!dpi
pi_over_2 = !dpi/2.d
ec = !values.d_nan
if not keyword_set(period) then period = 2.d*two_pi $
ELSE BEGIN
period = double(long(period/two_pi + 0.0001)) * two_pi
if period LT two_pi then period = two_pi
ENDELSE
n_per = long(period/two_pi + 0.0001)
if not keyword_set(n_fitpts) then n_fitpts = 64
n_fitpts = long( n_fitpts/(n_per*4) ) * n_per*4
if (n_fitpts LT n_per*4) then n_fitpts = n_per*4
n_slide = n_fitpts/(n_per*4)
npts = n_elements(phs)
IF npts LT 4 then BEGIN
dprint, "STOPPED!"
dprint, "Need to give phase array."
fail = 1
return
ENDIF
IF size(/type,phs) NE 5 then BEGIN
dprint, 'STOPPED! '
dprint, 'Phs must be double array.'
fail = 1
return
ENDIF
IF phs(0) LT 0 THEN BEGIN
n_skip = long( abs(phs(0)) / two_pi ) + 1l
phs = phs + n_skip*two_pi
phs0 = n_skip*two_pi
ENDIF ELSE phs0 = 0
dat_type = size(/type,data)
IF dat_type gt 5 or dat_type lt 1 then BEGIN
dprint, 'STOPPED! '
dprint, 'Dat byte, int, long, float, or double array.'
fail = 1
return
ENDIF
IF n_elements(data) NE npts then BEGIN
dprint, "STOPPED!"
dprint, "Data and phase must have the same number of points."
fail = 1
return
ENDIF
max_nfit = long( (phs(npts-1) - phs(0))/pi_over_2 + 9 )
qfit = dblarr(max_nfit)*!values.d_nan
base = dblarr(max_nfit)*!values.d_nan
phsf = dblarr(max_nfit)
d_phs = period/(n_fitpts*2)
fix_phs_sm = dindgen(n_fitpts)*period/n_fitpts + d_phs
fix_cos = cos(fix_phs_sm)
phs_zero = phs(0) - ( phs(0) mod pi_over_2 ) + pi_over_2 + d_phs
phs_end = phs(npts-1) - ( phs(npts-1) mod pi_over_2 ) + d_phs
n_phases = long( (phs_end - phs_zero) * n_fitpts / period + 0.0001)
fix_phs = dindgen(n_phases)*period/n_fitpts + phs_zero
phs_quad = ( phs(0) / pi_over_2 ) + 1.001
n_quad = (long(phs_quad) mod 4)
fix_dat = interpol(data,phs,fix_phs, /spline)
fix_strt = 0l
fix_end = long(n_fitpts-1)
nfits = 0l
WHILE fix_end LT n_phases DO BEGIN
qfit(nfits) = total( fix_dat(fix_strt:fix_end) * fix_cos ) * 2.d / n_fitpts
base(nfits) = total( fix_dat(fix_strt:fix_end) ) / n_fitpts
phsf(nfits) = fix_phs(fix_strt) + period/2.0
nfits = nfits + 1
fix_strt = fix_strt + n_slide
fix_end = fix_end + n_slide
ENDWHILE
if nfits LT 5 then begin
dprint, 'nfits = ', nfits
dprint, 'Not enough fits. Exiting...'
fail = 1
return
endif
kerz = [0.125d, 0.25d, 0.25d, 0.25d, 0.125d]
kers = [0.5d, 0.5d]
di = n_quad mod 2
n_ec = (nfits+1-di)/2
index = lindgen(n_ec)
sgn = (index mod 2) * 2 - 1
if (n_quad EQ 0 OR n_quad EQ 3) then sgn = -sgn
ec = double( qfit(index*2 + di) ) * sgn
n_ec = (nfits+1-di)/2
base = [base(2), base(3), base(0:nfits-1), base(nfits-4), base(nfits-3)]
base = convol(base,kerz, /edge_t)
zero = base(index*2 + di + 2)
phsf = phsf(index*2 + di) - d_phs
n_es = (nfits+di)/2
index = lindgen(n_es)
sgn = (index mod 2) * 2 - 1
if (n_quad EQ 0 OR n_quad EQ 1) then sgn = -sgn
es = double( qfit(index*2 + 1 - di) ) * sgn
if (n_es LT n_ec) then es = [es,es(n_es-1)]
if (di EQ 1) AND (n_es EQ n_ec) then es = [es,es(n_es-1)]
es = convol(es,kers, /edge_t)
if (n_es GT n_ec) then es = es(1:n_es-1)
if (di EQ 1) AND (n_es EQ n_ec) then es = es(1:n_es)
if NOT keyword_set(max_error) then max_error=25.d
IF keyword_set(do_sigma) or keyword_set(out) then BEGIN
z_big = interpol(zero,phsf,fix_phs)
c_big = interpol(ec,phsf,fix_phs)
s_big = interpol(es,phsf,fix_phs)
fit_big = z_big + c_big * cos(fix_phs) + s_big * sin(fix_phs)
strt = phsf(0) - period/2.0 + d_phs
index = where(abs(fix_phs-strt) LT d_phs, n_index)
IF ( n_index EQ 1 AND keyword_set(do_sigma) ) then begin
sigma = dblarr(n_ec)
strt = index(0)
stop = strt + n_fitpts - 1
FOR i = 0L, n_ec-1 DO BEGIN
dif = fit_big(strt:stop)-fix_dat(strt:stop)
sigma(i) = sqrt( total(dif*dif) / (n_fitpts-3) )
strt = strt + n_slide*2
stop = stop + n_slide*2
ENDFOR
ENDIF
IF keyword_set(out) then BEGIN
append_low = fix_phs(0:2*n_fitpts-1) - 2.d*period
append_high = fix_phs(n_phases-2*n_fitpts:n_phases-1) + 2.d*period
fix_phs = [append_low,fix_phs,append_high]
z_big = interpol(zero,phsf,fix_phs)
c_big = interpol(ec,phsf,fix_phs)
s_big = interpol(es,phsf,fix_phs)
fit_big = z_big + c_big * cos(fix_phs) + s_big * sin(fix_phs)
fit_big = interpol(fit_big,fix_phs, phs, /spline)
bad_pts = where(abs(data-fit_big) GT max_error)
ENDIF
ENDIF
phs = phs - phs0
phsf = phsf - phs0
return
END