! @(#)irsrespons.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:53:01
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!.COPYRIGHT   (C) 1992 European Southern Observatory
!.IDENT       irsrespons.prg
!.AUTHOR      E. Oliva,  Firenze, Arcetri
!.KEYWORDS    Spectroscopy, IRSPEC
!.PURPOSE     Execute command RESPONSE/IRSPEC
!
! Used to determine the instrumental response (a 1D frame)
! from a 2D star-frame and a flux table.
!
!
!.VERSION     1.0    Creation     24.09.1992   E. Oliva
!
!-------------------------------------------------------
!
!
crossref imain fluxtab imaout yrows observ norm rect
def/param p1 ? ima "Input, wavelength calibrated star image ? : "
def/param p2 ? cha "Table containing the star flux ? : "
def/param p3 ? ima "Output response_image ? : "
def/param p4 -7777 num "Positions (rows) on which extract the star spectrum ? : "
def/param p5 ab cha  "Mode, ab=A-B, os=OBJ-SKY"
def/param p6 1 num "Normalize option (>0 = do)"
def/param p7 1 num "Rectify option (>0 check and do)"
!
def/loc incmd/c/1/132 " " 
copy/key MID$LINE/C/1/132 incmd/C/1/132
!
! global keys used
!   Iscale
!   Idit
!   Iresp
!   Itilt
!
def/loc wl1/d/1/1 0. ? +lower
def/loc dwl/d/1/1 0. ? +lower
def/loc ylim/r/1/2 0.,0. ? +lower
def/loc wl/d/1/1 0.
def/loc nx/i/1/2 0,0 ? +lower
def/loc i/i/1/1 0
def/loc n/i/1/1 0 ? +lower
def/loc yrow/r/1/4 -1e20,-1e20,-1e20,-1e20
!
verify/irspec 'p1' 
@ creifnot 3 heat
!
!
copy/dk 'p1' npix/i/1/1 nx/i/1/1
copy/dk 'p1' npix/i/2/1 n/i/1/1
if n .le. 1 then
  write/out "Input frame is not 2D"
  return/end
endif
copy/dk 'p1' start/d/2/1 wl1/d/1/1
copy/dk 'p1' step/d/2/1 dwl/d/1/1
if dwl .gt. 0. then
  ylim(1) = wl1
  ylim(2) = ylim(1)+(n-1)*dwl
else
  ylim(2) = wl1
  ylim(1) = ylim(2)+(n-1)*dwl
endif
copy/dk 'p1' start/d/1/1 wl1/d/1/1
copy/dk 'p1' step/d/1/1 dwl/d/1/1
if dwl .eq. 1 then
  write/out "Input frame is not wavelength calibrated"
  return/end
endif
write/keyw yrow 'p4'
if yrow(1) .ne. -7777 then
  do i = 1 4
    if 'yrow({i})' .eq. -1e20 then
      write/out "You must specify 4 rows (Y) positions "
      return/end
    endif
  enddo
endif
!
! must average/row and sum star spectra, and use flux-cal table.
!
comp &resi = 'p1'
if 'p7' .ge. 1 then
  RECTIFY/IRSPEC 'p1' &resi verbose=2
endif
if 'p6' .ge. 1 then
  @s irsrespons,normalize &resi
endif
if yrow(1) .eq. -7777. then
  load &resi scale='Iscale' 
  redo:
  clea/cha o
  write/out "Define with cursor the Y-limits of the star spectrum(a)"
  get/c &resa ? ? 999,1
  i = 0
  write/out "In case you made a mess with the cursor....
  inqu/keyw i "...strike return to continue, enter 1 to redo : "
  if i .ge. 1 goto redo
  sort/table &resa :y_coord
  copy/dk &resa.tbl tblcontr/i/4/1 n/i/1/1
  if n .gt. 4 n = 4
  if n .lt. 4 then
    write/out "You must enter 4 positions"
    goto redo
  endif
  do i = 1 'n'
    yrow('i') = '&resa,:y_coord,@{i}' 
  enddo
else
  crea/table &resa 1 4 null
  crea/column &resa :x_coord R*4
  crea/column &resa :y_coord R*4
  wl = wl1+dwl*(nx/2)
  do i = 1 4
    if yrow({i}) .lt. ylim(1) then
      write/out "Row (Y) position {yrow({i})} is outside image limits"
      return/end
    endif
    if yrow({i}) .gt. ylim(2) then
      write/out "Row (Y) position {yrow({i})} is outside image limits"
      return/end
    endif
    &resa,:x_coord,@'i' = 'wl'
    &resa,:y_coord,@'i' = 'yrow({i})'
  enddo
  load &resi scale='Iscale'
  clea/cha over
  log(4) = 2
  load/table &resa :x_coord :y_coord
  log(4) = 0
endif
aver/row &resa = &resi 'yrow(1)','yrow(2)' sum
aver/row &resb = &resi 'yrow(3)','yrow(4)' sum
if p5(1:1) .eq. "a" then
  comp &resc = abs(&resa-&resb)/2.
else
  comp &resc = abs(&resa-&resb)
endif
if p2(1:1) .ne. "0" then
  verify/irspec 'p2'.tbl
  conver/table &resd = 'p2' :wl :flux &resc spline
  comp 'p3' = &resc/&resd
  copy/dd 'p1' *,3 'p3'
  write/descr 'p3' ident "1D response from {p1}, fluxtab={p3}"
  write/descr 'p3' cunit "c/s per flux unit                                   "
  write/descr 'p3' 'Iresp' 1
else
  stat/image &resc opt=rn
  copy/dk &resc statistic/r/3/1 ylim/r/1/1
  comp 'p3' = &resc/'ylim'
  copy/dd 'p1' *,3 'p3'
  write/descr 'p3' ident "1D relative response from {p1} "
  write/descr 'p3' cunit "relative atmospheric response                      "
  write/descr 'p3' 'Iresp' 2
endif
plot 'p3'
copy/kd incmd/c/1/132 'p3' history/c/-1/132
copy/kd yrow/r/1/4 'p3' irs_yrows/r/1/4 
return

entry normalize
!
! Used to normalize a frame by the integration time
!
! Global keys used:
!  Idit
!
crossref ima 
def/param p1 ? ima "Image to normalize to c/s ? : "
!
def/loc val/d/1/1 0 ? +lower
!
copy/dk 'p1' 'Idit' val/d/1/1
write/out "Normalizing to counts/sec using DIT={val}"
comp 'p1' = 'p1'/'val'
return