Viewing contents of file '../idllib/ghrs/pro/calfos_rdflt.pro'
pro calfos_rdflt,name,config,pattern,h,flat
;
;+
;			CALFOS_RDFLT
;
; read flat feild reference file
;
; CALLING SEQUENCE:
;	calfos_rdflt,name,config,pattern,h,flat
;
; INPUTS:
;	name - reference file name
;	config - configuration vector (from CALFOS_RD)
;	pattern - pattern vector (from CALFOS_RD)
;
; INPUT/OUTPUTS:
;	h - FITS header
;	flat - flat field array of size (nchnls+overscan-1)*xsteps x 2
;		On the first call (for FL1HFILE) flat will be created
;		and the proper row filled in.  On the second call
;		(FL2HFILE) the new row will simply be inserted.
; HISTORY:
;	version 1.0 D. Lindler  Jan 1980
;-
;--------------------------------------------------------------------------
	fname = strtrim(name)
	if fname eq '' then return		;file needed?
;
; extract configuration and pattern info from input vectors
;
	detector = strtrim(config(0))
	polar_id = strtrim(config(2))
	aper_id = strtrim(config(1))
	fgwa_id = strtrim(config(3))
	fchnl = pattern(0)
	nchnls = pattern(1)
	overscan = pattern(2)
	nxsteps = pattern(3)
	ns = pattern(8)
;
; if first call, create flat field array
;
	if n_elements(flat) le 1 then flat = replicate(1e38,ns,2)
;
; open file and get pattern info from header
;
	sxopen,1,fname,href
	det = strtrim(sxpar(href,'detector',fname))
	polar = strtrim(sxpar(href,'polar_id',fname))
	fgwa = strtrim(sxpar(href,'fgwa_id',fname))
	aper = strtrim(sxpar(href,'aper_id',fname))
	if polar_id ne 'C' then pass_dir=strtrim(sxpar(href,'pass_dir',fname)) $
		  	   else aper_pos=strtrim(sxpar(href,'aper_pos',fname))
	fc = sxpar(href,'fchnl',fname)
	nc = sxpar(href,'nchnls',fname)
	nxs = sxpar(href,'nxsteps',fname)
	oscn = sxpar(href,'overscan',fname)
;
; check consistency
;
	if (det ne detector) and (det ne 'ANY') then begin
	    print,'CALFOS_RDFLT-- Reference file '+fname+' detector mismatch'
	    retall
	endif

	if (fgwa ne fgwa_id) and (fgwa ne 'ANY') then begin
	    print,'CALFOS_RDFLT-- Reference file '+fname+' fgwa_id mismatch'
	    retall
	endif

	if (polar ne polar_id) and (polar ne 'N') then begin
	    print,'CALFOS_RDFLT-- Reference file '+fname+' polar_id mismatch'
	    retall
	endif

	if (aper ne aper_id) and (aper ne 'ANY') then begin
	    print,'CALFOS_RDFLT-- Reference file '+fname+' aper_id mismatch'
	    retall
	endif

	if (overscan ne oscn) or (fc gt fchnl) or ((fc+nc) lt (fchnl+nchnls)) $
	   or (nxs lt nxsteps) then begin
		print,'CALFOS_RDFLT -- inconsistent pattern information in '+ $
			fname+' with input observation'
		retall
	endif
;
; read flat field and extract correct portion
;
	ff = sxread(1)
	nff = n_elements(ff)

	if (fc ne fchnl) or (nchnls ne nc) then begin
		first = (fchnl-fc)*nxs
		last = first + (nchnls+overscan-1)*nxs - 1
		ff = ff(first:last)
	endif

	if (nxs ne nxsteps) then ff = ff(indgen(ns)*nxs/nxsteps)
;
; insert into correct location (single, upper or pass_dir 1   row 0
;				        lower or pass_dir 2   row 1)
;
	if polar_id ne 'C' then begin
		pos = pass_dir - 1
		type = 'PASS_DIR = '+strtrim(pass_dir,2)
	   end else begin
		if aper_pos eq 'LOWER' then pos = 1 else pos = 0
		type = aper_pos +' aperture'
	end
	flat(0,pos) = ff

	hist = 'Flat Field ('+type+') reference file: '+fname
	sxaddhist,hist,h
	if !dump gt 0 then print,hist
return
end