pro calfos_wav,coef,ypos,config,pattern,h,wave
;+
;			CALFOS_WAV
;
; Determine FOS wavelengths
;
; CALLING SEQUENCE:
;	calfos_wav,coef,ypos,config,pattern,h,wave
;
; INPUTS:
;	coef - dispersion coefficients (from routine calfos_ccs6)
;	ypos - ybases of the upper and lower aperture of an aperture
;		pair (from routine calfos_ccs1)
;	config - configuration vector (from calfos_rd)
;	pattern - pattern vector (from calfos_rd)
;
; INPUTS/OUTPUTS:
;	h - FITS header
;
; OUTPUTS:
;	wave - wavelength array
;
; HISTORY:
;	version 1  D. Lindler  Jan 1990
;-
;----------------------------------------------------------------------------
;
; extract pattern and configuration
;
	ybase = pattern(4)
	yrange = pattern(5)
	ysteps = pattern(6)
	ns = pattern(8)
	slices = pattern(9)
	nreads = pattern(10)
	nframes = slices*nreads
	fchnl = pattern(0)
	nxsteps = pattern(3)
	polar_id = strtrim(config(2))
	if strtrim(config(7)) eq 'PAIR' then paired=1 else paired=0
	ytypes = strarr(3)
	for i=0,2 do ytypes(i) = config(i+4)
	fgwa_id = strtrim(config(3))
;
; determine number of object spectra
;
	if ysteps le 3 then begin
		nobj = 0
		ystep = intarr(3)
		for i=0,2 do begin
		    if strtrim(ytypes(i)) eq 'OBJ' then begin
			ystep(nobj) = i
			nobj = nobj+1
		    endif
		endfor
	   end else begin
		ystep = indgen(ysteps)		;they are all object
		nobj = ysteps
	end
	if nobj eq 0 then return		;don't need wavelengths
;
; determine which set of dispersion coef. to use
;
	message = strarr(2)
	if polar_id ne 'C' then begin
		set = indgen(nobj)<1
		message(0) = 'pass direction 1'
		message(1) = 'pass direction 2'
	   end else begin
		if paired then begin
			y = ybase + 32*yrange/ysteps*ystep
			set = fix( abs(y-ypos(1)) lt abs(y-ypos(0)) )
			message(0) = 'upper aperture'
			message(1) = 'lower aperture'
		    end else begin
			set = intarr(nobj)
			message(0) = 'single aperture'
		end
	end
	set_used = intarr(2)
	if min(set) eq 0 then set_used(0) = 1	;first set used?
	if max(set) eq 1 then set_used(1) = 1	;second set used?
;
; compute wavelengths for each set used
;
	x = findgen(ns)/nxsteps + fchnl			;x-positions
	w = fltarr(ns,2)
	for i=0,1 do begin
	     c = coef(*,i)
	     if set_used(i) then begin
		if fgwa_id eq 'PRI' then begin		;prism
		    xx = x - c(5)		;subtract xzero
		    good = where(abs(xx) gt 1.0)
		    xx = xx(good)
		    x2 = xx*xx
		    x3 = x2*xx
		    x4 = x3*xx
		    w(good+i*ns) = c(0) + c(1)/xx + c(2)/x2 + c(3)/x3 + c(4)/x4
		    ndisp = 6	;number of coefficients used
		  end else begin
		    x2 = x*x
		    x3 = x2*x
		    w(0,i) = c(0) + c(1)*x + c(2)*x2 + c(3)*x3
		    ndisp = 4
		end
	     endif
	endfor
;
; limit wavelengths to range 900 to 10000 Angstroms
;
	bad = where((w lt 900.0) or (w gt 10000.)) & nbad = !err
	if nbad gt 0 then w(bad) = 0.0
;
; loop on frames and object spectra
;
	wave = fltarr(ns,nobj,nframes)
	for frame = 0,nframes-1 do $
	    for i=0,nobj-1 do wave(0,i,frame) = w(*,set(i))
;
; print some history
;

	hist = strarr(total(set_used)*(ndisp+1))
	names = ['COEFF_0','COEFF_1','COEFF_2','COEFF_3','CEOFF_4','XZERO  ']
	ipos = 0
	for i=0,1 do begin
	    if set_used(i) then begin
		hist(ipos) = 'Dispersion coefficients for: '+message(i)
		ipos = ipos + 1
		for k=0,ndisp-1 do hist(k+ipos) = '   '+names(k)+' ='+ $
					string(coef(k,i))
		ipos = ipos+ndisp
	    endif
	endfor
	sxaddhist,hist,h
	if !dump gt 0 then print,hist,format='(a/a)'
return
end