! @(#)irskysub.prg	14.1.1.1 (ES0-DMD) 09/16/99 09:41:04
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!.COPYRIGHT   (C) 1992 European Southern Observatory
!.IDENT       irskysub.prg
!.AUTHOR      E. Oliva,  Firenze, Arcetri
!.KEYWORDS    Spectroscopy, IRSPEC
!.PURPOSE     Execute command SKYSUB/IRSPEC
!
! used to subtract obj-sky with best choice of fact and shift...
! Detailed descriptions in the various subroutines.
!
!.VERSION     1.0    Creation     02.09.1992   E. Oliva
!
!-------------------------------------------------------
!
! O.K. tested, 21-sep-92 Tino
!
crossref ima1 ima2 out fs sky force cuts debug
def/param p1 ?  cha "Input obj image ? : "
def/param p2 ?  cha "Input sky image ? : "
def/param p3 ?  ima "Output image ? : "
def/param p4 ? num "Factor[,shift[,deltax,deltay]] ... "
def/param p5 cursor  cha "sky table... "
def/param p6 0. num "Force_sky_to_zero_option "
def/param p7 0,0 cha "Load option and cuts to be used in load  "
def/param p8 0  num  "debug option "
!
! global keys used
!    flat
!    dark
!    Iscale
!
def/loc incmd/c/1/132 "{MID$LINE}"
!
def/loc obj/c/1/60
def/loc sky/c/1/60
def/loc out/c/1/60
def/loc reft/c/1/60
def/loc rref/c/1/60
def/loc rr/r/1/4 0.,0.,.1,.1
def/loc fac/r/1/1 0.
def/loc sh/r/1/1 0.
def/loc r1/r/1/1 0.
def/loc r2/r/1/1 0.
def/loc r3/r/1/1 0.
def/loc r4/r/1/1 0.
def/loc i/i/1/1 0
def/loc lopt/c/1/60
def/loc kopt/c/1/1
def/loc yestab/i/1/1 1
def/loc debug/i/1/1/ 0
def/loc sforce/i/1/1 0
!
VERIFY/IRSPEC flatdark=1
@ creifnot 3 heat
!
!
! Remember that verify 'p1' 'p2'
! cannot work here as obj and sky may
! also be arithmetic expressions....
!
out  = p3
write/keyw rr/r/1/4 'p4'
fac = rr(1)
sh  = rr(2)
reft = p5
rref = m$lower(reft)
sforce = 'p6'
lopt = p7
debug = 'p8'
!copy/kk lopt/c/1/1 kopt/c/1/1
kopt = m$lower(lopt(1:1))
!
! Echoes flat and dark used
!
BADPIX/IRSPEC ('p1'-'dark')/'flat' &c l=0
BADPIX/IRSPEC ('p2'-'dark')/'flat' &d l=0 
obj = "&c"
sky = "&d"
comp 'p3' = &c-&d
if kopt .ne. "n" then
  if fac .eq. 1 then
    if sh .eq. 0 goto jump1
  endif
  write/out "Straight difference..."
  load 'p3' scale='Iscale' cuts='p7'
endif
jump1:
!
! Check whether we need a sky_table (key yestab)
!
yestab = 1
if rref .eq. "none" yestab = 0
if sforce .le. 0 then
  if fac .ne. 0. yestab = 0
endif
!
if yestab .eq. 0 goto jump0
if rref .eq. "cursor" then
  if kopt .eq. "n" then
    load 'p3' scale='Iscale' cuts=0,0
  endif
  write/out "Define sky position(s) using cursor"
  get/c cursor ? ? 9999,2
  clea/cha over
endif
jump0:
if fac .eq. 0. then
  if yestab .eq. 0 then
    write/out Cannot work in automatic mode without a sky table!
    goto end
  endif
  run STD_EXE:irskysub.exe
!
! N.B. if automatic failed, program must return with fac=-1
!
  if fac .gt. 0 then
    goto goon
  else
    fac = -1.0
  endif
endif
if fac .gt. 0 then
  run STD_EXE:irskysub.exe
else
  fac = -fac
  r1 = fac-rr(4)
  r2 = fac+rr(4)
  r3 = sh-rr(3)
  r4 = sh+rr(3)
  set/grap yaxis='r1','r2',.05,.01 xaxis='r3','r4',.05,.01 pmode=1
  plot/axes
  overplot/line 1 {r3},{fac} {r4},{fac}
  overplot/line 1 {sh},{r1} {sh},{r2}
  write/out "Choose with graphic cursors..."
  do i = 1 1000
    write/keyw outputr/r/2/1 0  
    if i .eq. 1 then
      lop1:
      get/gc ? ? 1
      if outputr(2) .le. 0 then
        write/out Must enter at least one value!
        goto lop1
      endif 
    else
      get/gc ? ? 1
      if outputr(2) .le. 0 goto out
    endif
    sh = outputr(1)
    fac = outputr(2)
    run STD_EXE:irskysub.exe
    load 'p3' scale='Iscale' cuts='p7'
  enddo
  out:
  set/grap xaxis=auto yaxis=auto
  write/out "factor={fac} shift={sh} "
  copy/dd &c *,3 'p3'
  goto end
endif
goon:
write/out "factor={fac} shift={sh} "
copy/dd &c *,3 'p3'
if kopt .ne. "n" then
  if fac .eq. 1 then
    if sh .eq. 0 then
      load 'p3' scale='Iscale' cuts='p7'
      goto end
    endif
  endif
  write/out "After corrections..."
  load 'p3' scale='Iscale' cuts='p7'
endif
end:
copy/kd incmd/c/1/132 'p3' history/c/-1/132
write/desc 'p3' 'Ifactor' 'fac'
write/desc 'p3' 'Ishift'  'sh'
return