Viewing contents of file '../idllib/ghrs/pro/calhrs_dc.pro'
pro calhrs_dc,global,cpos,dc,cpos1,dc1,log
;
;+
;*NAME:
;			calhrs_dc
;
;*PURPOSE:
; Computes dispersion coefficients for given carrousel position by
; one of two methods:
; 1) Interpolates or extrapolates in table of dispersion coefficients
;    to determine coefficients for a specified carrousel position.
; 2) Computes dispersion coefficients using global fit for grating.
;    Global fit models the disp. coef. as a polynomial function of
;    carrousel position.
;*PARAMETERS:
; CALLING SEQUENCE:
;	calhrs_dc,global,cpos,dc,cpos1,dc1,log
;
; INPUTS:
;	global - vector of global fit coefficients.
;		CAP_A, CAP_C, MCENTER, F00, F01, F02, F10, F11, F12,
;		F20, F21, F22, F30, F31, F32, F40, F41, F42, F50, F51, F52
;	cpos - vector of carrousel positions for tabulated
;		dispersion coefficients (used if global_coef is undefined)
;	dc - table of dispersion coefficients.  dc(i,*) contain
;		the coefficients for cpos(i) (used if global_coef is undefined)
;	cpos1 - carrousel position for which disp. coefficients
;		are desired.
;
; OUTPUTS:
;	dc1 - vector of disp. coef. for cpos1
;
; OPTIONAL INPUT/OUTPUT:
;	log - processing log (string array)
;
; HISTORY:
;	version 1  D. Lindler Mar 89
;	version 2  D. LIndler May 92  Added GLOBAL vector as input. It
;		contains the global fit to the dispersion coef. for the
;		grating mode.  Dispersion coef. are computed from the
;		coefficients of the fit.
;	version 2  D. Lindler Nov 12, 1992 added variation of m term with
;		carrousel position.
;-
;------------------------------------------------------------------------
;
; case 0 - use global_coef
;
	if n_elements(global) gt 1 then begin
		type = 0
		cpos1_squared = double(cpos1)^2
		f0 = global(3) + global(4)*cpos1 + global(5)*cpos1_squared
		f1 = global(6) + global(7)*cpos1 + global(8)*cpos1_squared
		f2 = global(9) + global(10)*cpos1 + global(11)*cpos1_squared
		f3 = global(12) + global(13)*cpos1 + global(14)*cpos1_squared
		f4 = global(15) + global(16)*cpos1 + global(17)*cpos1_squared
		f5 = global(18) + global(19)*cpos1 + global(20)*cpos1_squared
		a = global(0) & c = global(1) & mcenter = global(2)
		wcenter = (a/mcenter)*sin((c-cpos1)/10430.378d0)
		k = mcenter*wcenter
		k2 = k*k
		k3 = k*k2
		dc1 = dblarr(10)
		dc1(0) = f0 - f1*k + f2*k2 - f3*k3 - f4*wcenter - f5*mcenter
		dc1(1) = f1 - 2*f2*k + 3*f3*k2
		dc1(2) = f2 - 3*f3*k
		dc1(3) = f5
		dc1(4) = f4
		dc1(7) = f3
		goto,history
	end

	diff=cpos-cpos1
;
; case 1 exact match
;
	match = where(diff eq 0) & nmatch=!err
	if nmatch gt 0 then begin		;exact match found?
		type=1
		match=match(nmatch-1)		;take last one
		dc1=dc(match,*)			;extract coef.
		goto,history			;go do history processing
	endif
;
; case 2 interpolation
;
	upper=where(diff gt 0) & nupper=!err
	lower=where(diff lt 0) & nlower=!err
	if (nupper gt 0) and (nlower gt 0) then begin	;can we interpolate?
		type=2
		minupper=min(diff(upper))
		upper=where(diff eq minupper) & nupper=!err
		pos1=upper(nupper-1)			;choose last one
		maxlower=max(diff(lower))
		lower=where(diff eq maxlower) & nlower=!err
		pos2=lower(nlower-1)			;choose last one
	   end else begin
;
; case 3 extrapolate
;
		type=3
		diff=abs(diff)
		mindiff=min(diff)
		pos1=where(diff eq mindiff) & npos=!err ;closest cpos
		pos1=pos1(npos-1)			;choose last one
		left=where(diff ne mindiff) 		;remaining cpos's
		nleft=!err
 
		if nleft lt 1 then begin		;no other left
							; we can't extrapolate
			print,'CALHRS_DC--only one carrousel position ' + $
				'available for specified grating'
			print,'           and it does not match observation'
			retall
		endif
 
		minleft=min(diff(left))			;minimum of points left
		pos2=where(diff eq minleft) & npos=!err	;their positions
		pos2=pos2(npos-1)			;choose last one
	endelse
;
; interpolate or extrapolate between pos1 and pos2
;
	frac = (cpos1-cpos(pos1))/float((cpos(pos2)-cpos(pos1)))
	dc1 = dc(pos1,*) + frac*(dc(pos2,*)-dc(pos1,*))
;
; do history processing
;
history:
	hist=strarr(7)
	hist(0)='    Dispersion coefficients for carrousel position'+ $
			string(cpos1,'(i6)')
	case type of
	   0: hist(1)='    Computed from global fit for the grating'
	   1: hist(1)='    Exact match found in dispersion coefficient table'
	   2: hist(1)='    Interpolated between carrousel positions'+ $
		   string(cpos(pos1),'(i6)')+' and'+string(cpos(pos2),'(i6)')
	   3: hist(1)='    Extrapolated between carrousel positions' + $
		   string(cpos(pos1),'(i6)')+' and'+string(cpos(pos2),'(i6)')
	endcase
	for i=0,4 do begin
	    st=''
	    for j=0,1 do st=st+'      A'+strtrim(i*2+j,2)+'='+ $
				string(dc1(i*2+j),'(g21.14)')
	    hist(i+2)=st
	endfor
	if !dump gt 0 then printf,!textunit,hist
	if n_elements(log) gt 0 then sxaddhist,hist,log
return
end