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