! @(#)necpreduves.prg	17.1.1.1 (ESO-IPG) 01/25/02 17:51:11
! Procedure for predictive calibration of UVES
!
!
!
!/* The options were    : operatorarrow */
!double sol1(lambda,delta,g)
!double lambda;
!double delta;
!double g;
!{
!  double t14;
!  double t2;
!  double t3;
!  double t4;
!  double t5;
!  double t6;
!  double t7;
!  double t9;
!  double t13;
!
!  t2 = sin(delta);
!  t3 = lambda*g*t2;
!  t4 = lambda*lambda;
!  t5 = g*g;
!  t6 = t4*t5;
!  t7 = t2*t2;
!  t9 = cos(delta);
!  t13 = sqrt(t6*t7+2*t6*t9-2*t6-2*t9*t7+2*t7);
!  t14 = t3/2+t13/2;
!  atan2(t14/t2,-(t3/2-t13/2-t14*t9)/t7);
!}

define/param P1 {WLC}  IMA "Arc frame:" 
define/param P2 thar50.tbl  TAB  "Line catalog:"
define/param P3 UPP       CHAR "Upp/Low"
define/param P4 4000,8000 NUMB "Approx. wav. range"
define/param P5 NO        CHAR "Create  file uves.dat"

define/local WCENT/D/1/1    {{P1},ESO.INS.GRAT2.WLEN}
define/local grating/C/1/10 {{P1},ESO.INS.GRAT2.ID}
define/local groove/D/1/2   0.
define/local delta/D/1/1    45.6   ! Xdisp beam separation
define/local echblaz/D/1/1  75.06  ! Echelle blaze angle
define/local echg/D/1/1     31.6   ! Echelle groove density
define/local T/D/1/14       0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.
define/local xoffset/D/1/1   0.
define/local yoffset/D/1/1   0.
define/local detnam/C/1/40  "{{P1},ESO.DET.NAME}"
define/local wrange/D/1/2   {P4}
define/local P/D/1/3        15000.,0.0006,22.6813


VERIFY/ECHELLE {P1}
SET/ECHELLE    WLC={P1}

if grating(1:4) .EQ. "CD#3" then
      groove(1) = 600.0
      p(3)      = 22.6813
endif

if grating(1:4) .EQ. "CD#4" then 
      xoffset   = 10.
      yoffset   = -12.
      groove(1) = 312.5
      p(3)      = 22.6553
endif

p(2) = groove/1e6

if p3(1:1) .eq. "u" then 
      xoffset = xoffset - 9.
      yoffset = yoffset-2048-90
endif


groove(2) = groove(1)  ! to keep the original value

!wcent  = wcent*1e-9   ! nm to meter conversion
!groove = groove*1e3   ! mm to meter conversion
!t(2)  = m$sin(delta)
!t(3)  = wcent*groove*t(2)
!t(4)  = wcent*wcent
!t(5)  = groove*groove
!t(6)  = t(4)*t(5)
!t(7)  = t(2)*t(2)
!t(9)  = m$cos(delta)
!t(12) = t(6)*t(7)+2*t(6)*t(9)
!t(12) = t(12)-2*t(6)-2*t(9)*t(7)+2*t(7)
!t(13) = M$EXP(M$LN(t(12))/2) ! An expensive square root
!t(14) = t(3)/2+t(13)/2
!t(10) = (t(14)/t(2))
!t(11) = (-(t(3)/2-t(13)/2-t(14)*t(9))/t(7))
!t(1) = m$atan(t(10)/t(11))

! Computing the incidence angle, - sign for the diffracted angle
t(1) = p(3) + M$ASIN(wcent*p(2)/2/M$COS(p(3)))

set/format F12.4
write/out "Detector name: {detnam}"
write/out "Xdisp: {grating}, position angle : {t(1)} degrees"

$./necpreduves.sh {t(1)} {xoffset} {yoffset} {groove(2)} uves.cfg

if p5(1:1) .eq. "y" then

echg = echg*1e-7 ! groove/mm to groove/A conversion
t(1) = 2*m$SIN(echblaz)/echg

select/table {P2} :WAVE.GT.{WRANGE(1)}.AND.:WAVE.LT.{WRANGE(2)}
copy/table {P2}  &l
select/table {P2} ALL

set/format E16.10

compute/table    &l :ORDER = {t(1)}/:WAVE
compute/table    &l :ORDER = INT(:ORDER)
copy/table       &l uvesprj.tbl

define/local CNT/I/1/3 0,0,0
define/local prgs/I/1/1 0

do cnt = 1 {middumml.tbl,TBLCONTR(4)}

  write/out "Line {cnt(1)}"

  cnt(2) = 3*(cnt(1)-1) + 1
  cnt(3) =  {middumml.tbl,:ORDER,@{cnt(1)}} - 1
  write/table uvesprj.tbl @{cnt(2)} :WAVE  {middumml.tbl,:WAVE,@{cnt(1)}}
  write/table uvesprj.tbl @{cnt(2)} :ORDER {cnt(3)}

  cnt(2) = 3*(cnt(1)-1) + 2
  cnt(3) =  {middumml.tbl,:ORDER,@{cnt(1)}} 
  write/table uvesprj.tbl @{cnt(2)} :WAVE {middumml.tbl,:WAVE,@{cnt(1)}}
  write/table uvesprj.tbl @{cnt(2)} :ORDER {cnt(3)}

  cnt(2) = 3*(cnt(1)-1) + 3
  cnt(3) =  {middumml.tbl,:ORDER,@{cnt(1)}} + 1
  write/table uvesprj.tbl @{cnt(2)} :WAVE {middumml.tbl,:WAVE,@{cnt(1)}}
  write/table uvesprj.tbl @{cnt(2)} :ORDER {cnt(3)}
 
enddo

compute/table uvesprj.tbl :XMES = -1.
compute/table uvesprj.tbl :YMES = -1.
compute/table uvesprj.tbl :SLITP = 0.
name/column uvesprj.tbl :ORDER I5

! Update to write additional columns:   -1 -100. 0. 0. 20. -760. 0.
assign/print FILE uvesprj.dat
print/table uvesprj.tbl :XMES :YMES :ORDER :WAVE :SLITP N

endif

set/format F16.10

@ creifnot 1
$$ ./plot.sh

create/table pline.tbl 17 * out.dat
name/column pline.tbl #1 :INDEX I6
name/column pline.tbl #2 :XMES F12.3
name/column pline.tbl #3 :YMES F12.3
name/column pline.tbl #4 :XMOD F12.3
name/column pline.tbl #5 :YMOD F12.3
name/column pline.tbl #6 :XDIF F12.3
name/column pline.tbl #7 :YDIF F12.3
name/column pline.tbl #8 :ORDER  F12.3
name/column pline.tbl #9  :IDENT  F12.3
name/column pline.tbl #10 :SLITP  F12.3
name/column pline.tbl #11 :XGROOV  F12.3
name/column pline.tbl #12 :XINCID  F12.3
name/column pline.tbl #13 :XOFFST  F12.3
name/column pline.tbl #14 :YOFFST  F12.3
name/column pline.tbl #15 :AIRTMP  F12.3
name/column pline.tbl #16 :AIRPRS  F12.3
name/column pline.tbl #17 :AIRWAT  F12.3

select/table pline.tbl :XMOD.GT.0..AND.:XMOD.LT.4096.AND.:YMOD.GT.0..AND.:YMOD.LT.2048
copy/table   pline.tbl &l
copy/table   &l pline.tbl 


set/graph
set/graph color=1 xaxis=0,4096 yaxis=0,2048
plot/tab  pline  :XMOD :YMOD

@ creifnot 2 
load/lut heat
load/ima {P1} 
clear/chan over
copy/table pline &p
compute/table &p :XSTART = :XMOD - 20.
compute/table &p :XEND   = :XMOD + 20.
compute/table &p :YSTART = :YMOD - 20.
compute/table &p :YEND   = :YMOD + 20.
draw/rectangle  middummp.tbl  F 
!load/table pline :XMOD :YMOD ?  0 3