Viewing contents of file '../idllib/ghrs/pro/calhrs_iac.pro'
pro calhrs_iac,iatab,ih,wave,log
;
;+
;			calhrs_iac
; Subroutine of calhrs for applying the incidence angle correction
; to wavelengths for data not taken in the small science aperture.
;
; CALLING SEQUENCE:
;	calhrs_iac,iatab,ih,wave,log
;
; INPUTS:
;	iatab - incidence angle table (CCR8)
;
; INPUT/OUTPUT:
;
;	ih - science record header vectors
;	wave - wavelength vectors
;	log - processing log
;
; HISTORY:
;	version 1 D. Lindler  Mar 1990
;-
;---------------------------------------------------------------------------
 
	VERSION = 1.0
 
;
; Determine grating mode
;
	gmode = ih(48)
	if (gmode lt 1) or (gmode gt 7) then return	;not grating mode
	gratings=['   ','G-1','G-2','G-3','G-4','G-5','E-A','E-B']
	gmode = gratings(gmode)
;
; determine target aperture
;
	sclamp = ih(39)*2 + ih(38)
	binid = ih(53)
	if (binid ne 2) and (sclamp eq 0) then return	;already in SSA
	case 1 of
		sclamp eq 1: aper = 'SC1'
		sclamp eq 2: aper = 'SC2'
		binid eq 2: aper = 'LSA'
		else: begin
			print,'CALHRS_IAC- unable to determine target aperture'
			print,'            No incidence angle correction done'
		      end
	endcase
;
; determine spectral order and carrousel position
;
	order = ih(50)
	cpos = ih(43)
	if cpos lt 0 then cpos = 65536L + cpos
;
; read incidence angle table
;
	tab_read,iatab,tcb,tab
	gratings = tab_val(tcb,tab,'GRATING')
	aperture = tab_val(tcb,tab,'APERTURE')
	sporder = tab_val(tcb,tab,'SPORDER')
	nrows = n_elements(sporder)
;
; find rows that match observations grating, aperture and order
;
	found = sporder eq order
	for i=0,nrows-1 do begin
	   if found(i) then begin
		if (strtrim(gratings(i)) ne gmode) then found(i)=0
		if (strtrim(aperture(i)) ne aper) then found(i)=0
	   endif
	endfor
	good = where(found) & ngood=!err
	if ngood lt 1 then begin
		print,'CALHRS_IAC- no valid rows found in IATAB='+iatab
		print,'           for '+grating+' '+aper+' order'+string(order)
		retall
	endif
;
; read table information for good rows,and sort
;
	carpos = tab_val(tcb,tab,'CARPOS',good)
	a = tab_val(tcb,tab,'A',good)
	b = tab_val(tcb,tab,'B',good)
	sub = sort(carpos)
	carpos = carpos(sub)
	a = a(sub)
	b = b(sub)
;
; if only one value then it better be the right carrousel position
;
	if ngood eq 1 then begin
	    if carpos(0) ne cpos then begin
		print,'CALHRS - unable to interpolate in carr. pos in IATAB'
		print,'           for '+grating+' '+aper+' order'+string(order)
	    endif
	    a_interp = a(0)
	    b_interp = b(0)
	  end else begin
;
; interpolate in carrousel positions
;
	   below = where(carpos le cpos) & nbelow = !err
	   if nbelow lt 1 then begin
		pos1=0
	     end else begin
		if nbelow eq ngood then pos1 = ngood-2 $
				   else pos1 = nbelow-1
	   end
	   pos2 = pos1 + 1
	   c1 = carpos(pos1)
	   frac = (cpos-c1)/double((carpos(pos2) - c1))
	   a_interp = a(pos1) + frac * (a(pos2)-a(pos1))
	   b_interp = b(pos1) + frac * (b(pos2)-b(pos1))
	end
;
; shift wavelegnths
;
	s = size(wave) & ns = s(1) & nvect=n_elements(wave)/ns
	for i=0,nvect-1 do begin
		s0 = float(ih(70:71,i),0)
		ds = float(ih(72:73,i),0)
		s = s0 + findgen(ns)*ds		;sample positions
		delw = (a_interp + b_interp*s)/order
		wave(0,i) = wave(*,i)+delw
	endfor
;
; update header and log
;
	ih(67,0) = ih(67,*) or 4
	hist=strarr(3)
	hist(0) = 'CALHRS_IAC version '+string(version,'(F5.2)')+ $
			': Incidence angle correction'
	hist(1) = '  Wavelengths offset to '+aper+' Using coef. from '+iatab
	hist(2) = '      A='+string(a_interp)+'     B='+string(b_interp)
	sxaddhist,hist,log
	if !dump gt 0 then printf,!textunit,hist
	return
end