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