Viewing contents of file '../idllib/ghrs/pro/calfos_off.pro'
pro calfos_off,rootname,table,stable,pattern,expomax,h,data,err,eps,gpar
;+
;			calfos_off
;
; Apply GIMP offsets to the data.  Offsets are applied to the
; nearest pixel.  No interpolation is done.
;
; CALLING SEQUENCE:
;	calfos_off,rootname,table,stable,pattern,expomax,h,data,err,eps,gpar
;
; INPUTS:
;	rootname - observation rootname
;	table - GIMP offset table.  The only required column is
;		OFFSET_X which gives an offset for each spectrum.
;		The offsets are in units of diodes with positive
;		offsets going toward the right.  If not supplied
;		then it will be generated with FOS_GIMP.
;	stable - gimp sensitivity factor reference table
; 	pattern - substep pattern vector (FROM CALFOS_RD)
;	expomax - maximum exposure time for a readout
; INPUT/OUTPUT:
;	h - FITS header
;	data - 2-D data array
;	err - error array
;	eps - epsilon array (data last at ends by shift are
;		flagged with an epsilon=700)
;	gpar - group parameter array
; HISTORY:
;	version 1  D. Lindler   Feb. 21, 1991
;	July 1991 D. Lindler added Gimp sensitivity table and Group
;		parameter updating.  Fixed for no error prop. when
;		err_corr=omit
;	Apr, 1992  D. Lindler  Corrected roundoff error when zero counts
;		gave a non-zero count rate and non-zero error.
;-
;--------------------------------------------------------------------------
;
; read or create offset table
;
	s = size(data) & ns = s(1) & ngroups = n_elements(data)/ns
	ndim = s(0) 
	if ndim lt 3 then nreads=1 else nreads=s(3)	;slices*nreads

	if strtrim(table) eq '' then begin
		if strtrim(stable) eq '' then begin
			print,'CALFOS_OFF - OFF_CORR selected and no OFFTAB ',$
			      '             or CCS7 reference filename supplied'
			retall
		endif
		fdecomp,rootname,disk,dir,name
		fos_gimp,rootname,name+'_gimp',x_offset,y_offset,reftable=stable
		hist = 'GIMP offsets computed and applied '
		if strtrim(stable) ne '' then hist=hist+' using '+stable
	    end else begin
		table_ext,table,'OFFSET_X',x_offset
		y_offset = offset*0
		if n_elements(x_offset) ne ngroups then begin
			PRINT,'CALFOS_OFF - OFFTAB '+strtrim(table)+ $
				' has the wrong number of rows'
			RETALL
		endif
		hist = 'Data offsets from table '+strtrim(table,2)+' applied'
	end
;
; convert offsets to integer pixel shifts
;
	nxsteps = pattern(3)
	offset = fix(x_offset*nxsteps+1000.5)-1000
;
; propagate errors?
;
	if n_elements(err) gt 1 then err_corr = 1 else err_corr = 0
;
;  if non-destructive readouts, destruct them
;
	nread_per_clear = sxpar(h,'nread')
	if nread_per_clear gt 1 then begin
		if nread_per_clear ne nreads then $
			print,'WARNING - NREAD does not match' + $
				' number of readouts in data'
;
; scale data by number of readouts
;
	    for i=1,nreads-1 do begin
		data(0,0,i) = data(*,*,i)*(i+1)
		if err_corr then err(0,0,i) = err(*,*,i)*(i+1)
	    end
	    if err_corr then err = err^2				;square the errors
;
; subtract total for previous readouts for each readout
;
	    for i=nreads-1,1,-1 do begin
		data(0,0,i) = data(*,*,i) - data(*,*,i-1)
		if err_corr then err(0,0,i) = err(*,*,i) - err(*,*,i-1)
	    end
;
; set to data values to zero where round off made then a little bit different
; from zero.
;
	    max_for_zero = 0.5/expomax
	    zero = where(data lt max_for_zero,nzero)
	    if nzero gt 0 then begin
		data(zero) = 0.0
	 	if err_corr then err(zero) = 0.0
	    endif
	end
;
; loop on spectra
;
	for i=0,ngroups-1 do begin
	    off = offset(i)
	    i1 = ns*i & i2 = i1+ns-1
	    if off ne 0 then begin
;
; shift data
;
		data(i1) = shift(data(i1:i2),off)
		if err_corr then err(i1) = shift(err(i1:i2),off)
		eps(i1) = shift(eps(i1:i2),off)
;
; fill ends
;
		if off gt 0 then begin
			first = i1
			last = i1+off-1
		    end else begin
			first = i1+ns+off
			last = i1+ns-1
		end

		data(first:last) = 0.0
		if err_corr then err(first:last) = 0.0
		eps(first:last) = 700
	    end
	end
;
; if we destructed the data then undestruct the data
;
	if nread_per_clear gt 1 then begin
;
; make each readout include sum of all previous readout
;

		for i=1,nreads-1 do begin
			data(0,0,i) = data(*,*,i)+data(*,*,i-1)
			if err_corr then err(0,0,i) = err(*,*,i)+err(*,*,i-1)
			eps(0,0,i) = eps(*,*,i)>eps(*,*,i-1)
		endfor
;
; convert back to count rate
;
		if err_corr then err = sqrt(err>0.0)
		for i=1,nreads-1 do begin
			data(0,0,i) = data(*,*,i)/(i+1)
			if err_corr then err(0,0,i) = err(*,*,i)/(i+1)
		end
		bad = where(eps ge 700) & nbad=!err
		if nbad gt 0 then begin
			data(bad) = 0.0
			if err_corr then err(bad) = 0.0
		endif
	endif
;
;update group parameter block if x_offset,y_offset in gpar
;
	v = sxgpar(h,gpar(*,0,0),'X_OFFSET',dtype1,sbyte1)
	if !err ge 0 then begin
		v = sxgpar(h,gpar(*,0,0),'Y_OFFSET',dtype2,sbyte2)
		psize = n_elements(gpar(*,0,0))
		for i=0,ngroups-1 do begin
			gpar(psize*i+sbyte1) = byte(float(x_offset(i)),0,4)
			gpar(psize*i+sbyte2) = byte(float(y_offset(i)),0,4)
		end
	end
	if !dump ge 1 then print,hist
	sxaddhist,hist,h
return
end