Viewing contents of file '../idllib/ghrs/pro/calhrs_map.pro'
pro calhrs_map,tnames,ih,log
;
;+
; calhrs_map
;
; Routine to perform GHRS mapping function.
;
; CALLING SEQUENCE:
; calhrs_map,tnames,ih,log
;
; INPUTS:
; tnames - string array with 2 elements:
; tnames(0) = line mapping function table
; tnames(1) = sample mapping function table
;
; INPUT/OUTPUT:
; ih - integer*2 header array 128xN
; The following values will be added to IH:
; ih(70:71,*) - starting sample for each bin
; ih(72:73,*) - delta sample for each bin
; ih(74:75,*) - line position for each bin
; These will be stored as real*4 values in the
; integer array IH.
;
; OPTIONAL INPUT/OUTPUT:
; log - processing log (string array)
;
; METHOD:
; Coefficients for the line mapping function are read
; from table tnames(0) for the data's detector. If multiple
; rows in the table are valid, the last valid row is used.
; The photocathode line position is computed by:
; line = L0 + A *(ydef-2048)
; where:
; L0, A are parameters in the table
; ydef - is the ydeflection for the bin of data.
;
; Coefficients for the sample mapping function are read
; from table tnames(1). This table has coefficients
; S0, B, C and E tabulated as a function of DETECTOR and
; YDEF. Interpolation of the coefficients (in YDEF) is
; used to compute coefficients at arbiturary y-deflections.
; If a y-deflection is not within the range of y-deflections
; within the table, extropolation is not done. The coefficients
; for the closest y-deflection in the table are used.
; The starting sample for each bin is computed by:
; SAMPLE = S0 + B*(xdef-2048) + C*(xdef-2048)**2
; and E gives the spacing (deltas) between data points.
;
; HISTORY:
; version 1 D. Lindler March 1989
; Apr 17 1991 JKF/ACC - degenerating array (N)
;-
;---------------------------------------------------------------------------
VERSION = 1.0
;
; extract required header information.
;
xdef=ih(52,*) ; this is the one without combaddition or
; doppler offsets
ydef=ih(42,*)
det=ih(31,0) ; the first one should be the same as all
; bins.
; n = size(ih) & n=n(2) ; number of data bins
n = size(ih) & n=n_elements(ih)/n(1) ; number of data bins
;
; LINE DIRECTION -----------------------------------------------------------
;
tname = strtrim(tnames(0),2)
tab_read,tname,tcb,table ;open table
detectors = tab_val(tcb,table,'DETECTOR') ;read detector numbers
valid = where(detectors eq det) ;valid rows
nv = !err ;number of valid ones
if nv lt 1 then begin
print,'CALHRS_MAP-- no valid row in table '+ $
tname+' found for detector '+strtrim(det)
retall
endif
valid = valid(nv-1) ;use last valid row
L0 = tab_val(tcb,table,'L0',valid) ;read coef.
A = tab_val(tcb,table,'A',valid)
line = L0 + A * (ydef-2048) ;compute line positions
;
; SAMPLE DIRECTION ----------------------------------------------------------
;
tname=strtrim(tnames(1),2)
tab_read,tname,tcb,table
detectors = tab_val(tcb,table,'DETECTOR') ;read detector numbers
valid = where(detectors eq det) ;valid rows
nv = !err ;number of valid ones
if nv lt 1 then begin
print,'CALHRS_MAP-- no valid row in table '+ $
tname+' found for detector '+strtrim(det)
retall
endif
ydef_tab = tab_val(tcb,table,'YDEF',valid) ;y-defs for valid rows
s0 = tab_val(tcb,table,'S0',valid)
b = tab_val(tcb,table,'B',valid)
c = tab_val(tcb,table,'C',valid)
e = tab_val(tcb,table,'E',valid)
;
; compute mapping function for each different y-deflection
;
ydef_u = ydef(rem_dup(ydef)) ;unique ydeflections
nydef = n_elements(ydef_u)
s0_u = fltarr(nydef) ;sample positions
b_u = fltarr(nydef)
c_u = fltarr(nydef)
e_u = fltarr(nydef)
outside = intarr(nydef) ;flag for ydefs outside
; table range
for i=0,nydef-1 do begin ;process each unique ydef
y=ydef_u(i)
match=where(y eq ydef_tab) ;exact match
nmatch=!err
if nmatch gt 0 then begin ;exact match found?
pos=match(nmatch-1) ;last one which matches
goto,no_interp ;don't need to interpolate
endif
above=where(ydef_tab gt y) ;rows with greater ydefs
nabove=!err
below=where(ydef_tab lt y) ;rows with smaller ydef
nbelow=!err
if (nbelow lt 1) or (nabove lt 1) then begin ;both above and below?
diff=abs(ydef_tab-y)
best=where(diff eq min(diff)) ;find closest ydeflection
nbest=!err
pos=best(nbest-1) ;use last one
outside(i)=1 ;flag as outside range
goto,no_interp ;can't interpolate
endif
;
; if wa made it here we want to interpolate
;
diff=abs(ydef_tab(above)-y) ;find best above
best=where(diff eq min(diff))
nbest=!err
above=above(best(nbest-1)) ;use last one
diff=abs(ydef_tab(below)-y) ;find best above
best=where(diff eq min(diff))
nbest=!err
below=below(best(nbest-1)) ;use last one
frac = (y-ydef_tab(below))/float((ydef_tab(above)-ydef_tab(below)))
s0_u(i)= s0(below)+frac*(s0(above)-s0(below))
b_u(i)= b(below)+frac*(b(above)-b(below))
c_u(i)= c(below)+frac*(c(above)-c(below))
e_u(i)= e(below)+frac*(e(above)-e(below))
goto,nexti ;done
no_interp:
s0_u(i)=s0(pos)
b_u(i)=b(pos)
c_u(i)=c(pos)
e_u(i)=e(pos)
nexti:
end; for i
;
; now find coefficients for each y-def in original data
;
s0 = fltarr(n)
b = fltarr(n)
c = fltarr(n)
e = fltarr(n)
for i=0,nydef-1 do begin
good=where(ydef eq ydef_u(i))
s0(good)=s0_u(i)
b(good)=b_u(i)
c(good)=c_u(i)
e(good)=e_u(i)
end
;
; compute mapping function
;
dx = (xdef-2048)
sample = s0 + b*dx + c*dx*dx
;
; update headers
;
ih(70,0) = fix(float(sample),0,2,n)
ih(72,0) = fix(float(e),0,2,n)
ih(74,0) = fix(float(line),0,2,n)
;
; update processing log
;
hist=strarr(6+nydef)
hist(0)='CALHRS_MAP version '+string(version,'(f5.2)')+ $
': photocathode mapping function'
hist(1)=' Line function table '+strtrim(tnames(0),2)
hist(2)=' L0='+string(l0,'(f8.3)')+' A='+string(a,'(f9.6)')
hist(3)=' Sample function table '+strtrim(tnames(1),2)
hist(4)=' ---------- Interpolated Coefficients -------------'
hist(5)=' YDEF S0 B C E'
for i=0,nydef-1 do begin
st = string(ydef_u(i),'(I8)') + $
string(s0_u(i),'(f9.3)') + $
string(b_u(i),'(f9.6)') + $
string(c_u(i),'(g13.6)') + $
string(e_u(i),'(f10.6)')
if outside(i) then st=st+' OUTSIDE TABULATED RANGE'
hist(6+i)=st
endfor
if n_params(0) gt 2 then sxaddhist,hist,log
if !dump gt 0 then printf,!textunit,hist
return
end