! @(#)ferosdemo.prg	14.1.1.2 (ESO-DMD) 05/10/00 23:23:27
! 
! ferosdemo.prg	
!

  define/local reply/I/1/1 1
  define/local answer/c/1/1 n

WRITE/OUT " "
WRITE/OUT "This tutorial requires a number of frames and tables"
WRITE/OUT " "
WRITE/OUT "It works only, when you have the necessary demo"
WRITE/OUT "and calibration frames installed on your system"
WRITE/OUT " "
WRITE/OUT "You also need sufficient disk space: about 250 MB!..."
WRITE/OUT " "

!---------------------------------------------------------------------------
! copy guess and calibration data to current directory
!---------------------------------------------------------------------------

INQUIRE/KEY answer "Copy frames/tables needed by tutorial? [y/n]"

if "{answer(1:1)}" .eq. "y" then

  WRITE/OUT " *** Copy data to default directory, this may take some time ..."
  !
  if aux_mode .le. 1 then                   !in VMS
    -COPY MID_FEROS:*.* []
    -COPY MID_TEST:fero*.BDF []
  else                                      !in UNIX
    -COPY MID_FEROS:* ./
    -COPY MID_TEST:fero* ./
  endif

  !

  indisk/fits ferosFF.fits ferosFF
  indisk/fits ferosThAr.fits ferosThAr
  indisk/fits ferosHD5980.fits  ferosHD5980
  indisk/fits BLAZE.tfits BLAZE.tbl
  indisk/fits GUESS_GORDER.tfits GUESS_GORDER.tbl
  indisk/fits GUESS_INIT.tfits GUESS_INIT.tbl
  indisk/fits GUESS_LINE1.tfits GUESS_LINE1.tbl
  indisk/fits GUESS_LINE2.tfits GUESS_LINE2.tbl
  indisk/fits GUESS_ORDER.tfits GUESS_ORDER.tbl
  indisk/fits GUESS_TEMPLATE.fits GUESS_TEMPLATE.bdf
  indisk/fits GUESS_WLC1.tfits GUESS_WLC1.tbl
  indisk/fits GUESS_WLC2.tfits GUESS_WLC2.tbl
  indisk/fits IDTAB_REF.tfits IDTAB_REF.tbl
  indisk/fits THAR_REF.fits  THAR_REF.bdf
  indisk/fits ThAr50000.tfits ThAr50000.tbl

else

  WRITE/OUT " "
  INQUIRE/KEY answer "Do you want to continue with existing data? [y/n]"

  IF "{answer(1:1)}" .EQ. "n" THEN
    return/exit
  endif

endif

!------------------------------------------------------------------------------
! initialize displays
!------------------------------------------------------------------------------

RESET/DISPLAY
CREA/DISP 0 512,564,756,406
CREA/GRA 0 625,425,44,129
LOAD/LUT idl4
SET/GRA pmode=1

!------------------------------------------------------------------------------
! initialize parameters
!------------------------------------------------------------------------------
init:

WRITE/OUT " "
WRITE/OUT "*** Initialize keywords..."
WRITE/OUT " "
ECHO/ON
INIT/FEROS GUESS
SET/FEROS RAW_IMG=ferosFF
SET/FEROS GUESS_TBL=orders CENTER_TBL=centers
SET/FEROS STRAIGHT_IMG=str EXT_IMG=extr COEF_COP=cop_coeffs
ECHO/OFF

!*************************************FF*****************************

!------------------------------------------------------------------------------
! locate orders
!------------------------------------------------------------------------------
locate:

WRITE/OUT " "
WRITE/OUT "*** search orders..."
WRITE/OUT " "

ECHO/ON
LOAD/IMA {RAW_IMG} sc=-2,-2 center=0,0 cuts=0,8000
DEFINE/FEROS >Null
ECHO/OFF

WRITE/OUT " "
WRITE/OUT "*** load order definition table..."
WRITE/OUT " "

ECHO/ON
load/tab {CENTER_TBL} :fit_pos :ypos
ECHO/OFF

IF P1(1:1) .NE. "A" THEN
  
  WRITE/OUT " "
  WRITE/OUT "Next step is reduction of FF spectrum"
  WRITE/OUT " "

  INQUIRE/KEY reply "Press return to continue ; -1 to stop " ? 
  IF {reply} .LT. 0 @s ferosdemo,finish
ENDIF

cl/ch over

!------------------------------------------------------------------------------
! background continuous spectrum image
!------------------------------------------------------------------------------
backgroundflat:

WRITE/OUT " "
WRITE/OUT "*** determine and subtract background from FF spectrum..."
WRITE/OUT " "

ECHO/ON
SET/FEROS FLAT_IMG=FFback
BACKGR/FEROS {RAW_IMG}
ECHO/OFF

!------------------------------------------------------------------------------
! straighten orders in FF spectrum
!------------------------------------------------------------------------------
rectifyflat:

WRITE/OUT " "
WRITE/OUT "*** rectify orders in FF spectrum..."
WRITE/OUT " "

ECHO/ON
RECTIFY/FEROS
ECHO/OFF

!------------------------------------------------------------------------------
! extract FF spectra
!------------------------------------------------------------------------------
stdext:

WRITE/OUT " "
WRITE/OUT "*** optimum extraction for both fibers..."
WRITE/OUT "*** this is needed for cross-order profile determination"
WRITE/OUT "*** and may take some time..."
WRITE/OUT " "

ECHO/ON
EXTRACT/FEROS ? extr GOYN >Null
!EXTRACT/FEROS ? extr GOYN
ECHO/OFF

WRITE/OUT " "
WRITE/OUT "*** standard extraction for both fibers..."
WRITE/OUT " "

ECHO/ON
EXTRACT/FEROS ? ff_extr GSNN >Null
!EXTRACT/FEROS ? ff_extr GSNN
ECHO/OFF

IF P1(1:1) .NE. "A" THEN
  
  WRITE/OUT " "
  WRITE/OUT "Next step is reduction of ThAr spectrum"
  WRITE/OUT " "

  INQUIRE/KEY reply "Press return to continue ; -1 to stop " ? 
  IF {reply} .LT. 0 @s ferosdemo,finish
ENDIF

!*************************************ThAr*****************************

LOAD/IMA ferosThAr sc=-2 cuts=0,1000
!------------------------------------------------------------------------------
! background and extract ThAr spectrum image
!------------------------------------------------------------------------------
backgroundthar:

WRITE/OUT " "
WRITE/OUT "*** determine and subtract background form ThAr spectrum..."
WRITE/OUT " "

ECHO/ON
SET/FEROS FLAT_IMG=ThArback
BACKGR/FEROS ferosThAr
RECTIFY/FEROS ? str
SET/FEROS STRAIGHT_IMG=str 
EXTRACT/FEROS ? thar_extr  GSNN >Null
ECHO/OFF

IF P1(1:1) .NE. "A" THEN
  
  WRITE/OUT " "
  WRITE/OUT "Next step is wavelength calibration"
  WRITE/OUT " "

  INQUIRE/KEY reply "Press return to continue ; -1 to stop " ? 
  IF {reply} .LT. 0 @s ferosdemo,finish
ENDIF

!------------------------------------------------------------------------------
! search for emission lines in ThAr spectrum
!------------------------------------------------------------------------------

searchline:

WRITE/OUT " "
WRITE/OUT "*** search for emission lines in ThAr spectrum..."
WRITE/OUT " "

ECHO/ON
SET/FEROS LINE_POS_TBL=linepos
SEARCH/FEROS thar_extr >Null
ECHO/OFF


!------------------------------------------------------------------------------
! wavelength calibration, check it
!------------------------------------------------------------------------------
calibrate:

WRITE/OUT " "
WRITE/OUT "*** wavelength calibration..."
WRITE/OUT " "

ECHO/ON
CALIBRATE/FEROS >Null
set/gra xa ya=-0.02,0.02 colo
plo/tab {LINE_POS_TBL}1 :wave :residual
ECHO/OFF

IF P1(1:1) .NE. "A" THEN
  
  WRITE/OUT " "
  WRITE/OUT "Next step is reduction of object spectrum"
  WRITE/OUT " "

  INQUIRE/KEY reply "Press return to continue ; -1 to stop " ? 
  IF {reply} .LT. 0 @s ferosdemo,finish
ENDIF


!*************************************object*****************************

LOAD/IMA ferosHD5980 sc=-2 cuts=0,1000

!------------------------------------------------------------------------------
! background stellar spectrum image
!------------------------------------------------------------------------------

WRITE/OUT " "
WRITE/OUT "*** determine and subtract background from stellar spectrum..."
WRITE/OUT " "

ECHO/ON
SET/FEROS RAW_IMG=ferosHD5980 FLAT_IMG=HD5980back
BACKGR/FEROS {RAW_IMG}
RECTIFY/FEROS
ECHO/OFF

WRITE/OUT " "
WRITE/OUT "*** optimum extraction for both fibers..."
WRITE/OUT "*** this may take some time..."
WRITE/OUT " "

ECHO/ON
EXTRACT/FEROS ? opt_extr GONN >Null
ECHO/OFF

WRITE/OUT " "
WRITE/OUT "*** standard extraction for both fibers..."
WRITE/OUT " "

ECHO/ON
EXTRACT/FEROS ? std_extr GSNN >Null
ECHO/OFF

IF P1(1:1) .NE. "A" THEN
  
  WRITE/OUT " "
  WRITE/OUT "Next step is flat-fielding and wavelength calibration"
  WRITE/OUT " "

  INQUIRE/KEY reply "Press return to continue ; -1 to stop " ? 
  IF {reply} .LT. 0 @s ferosdemo,finish
ENDIF

!------------------------------------------------------------------------------
! flat-field stellar spectrum 
!------------------------------------------------------------------------------

WRITE/OUT " "
WRITE/OUT "*** flat-fielding stellar spectrum..."
WRITE/OUT " "

ECHO/ON
SET/FEROS UNBLAZED_IMG=std_unbl
FLAT/FEROS std_extr ff_extr
SET/FEROS UNBLAZED_IMG=opt_unbl
FLAT/FEROS opt_extr ff_extr
ECHO/OFF

!------------------------------------------------------------------------------
! rebin stellar spectrum 
!------------------------------------------------------------------------------

rebinlin:

WRITE/OUT " "
WRITE/OUT "*** rebinning stellar spectrum to constant steps in lambda..."
WRITE/OUT " "

ECHO/ON
REBIN/FEROS std_unbl ? std_reb I 0.05
REBIN/FEROS opt_unbl ? opt_reb I 0.05
ECHO/OFF

!------------------------------------------------------------------------------
! merge orders
!------------------------------------------------------------------------------

!mergeorders:

WRITE/OUT " "
WRITE/OUT "*** merge orders..."
WRITE/OUT " "

ECHO/ON
SET/FEROS REBIN_STEP=0.05
MERGE/FEROS std_reb std_mer ? SINC
MERGE/FEROS opt_reb opt_mer ? SINC
MERGE/FEROS opt_reb ? 1,39 NOAVER >Null
ECHO/OFF

!------------------------------------------------------------------------------
! check overlap
!------------------------------------------------------------------------------

WRITE/OUT " "
WRITE/OUT "*** check overlapping of orders..."
WRITE/OUT " "

set/gra xa=5300,6000 ya=0,0.15
SET/GRAP colo=1
plo merged10023
set/gra colo=2
ove merged10022
ove merged10024
ove merged10026
set/gra colo=1 
ove merged10021
ove merged10025
set/gra xa ya

IF P1(1:1) .NE. "A" THEN
  
  WRITE/OUT " "
  WRITE/OUT "Next step is check of optimum extraction"
  WRITE/OUT " "

  INQUIRE/KEY reply "Press return to continue ; -1 to stop " ? 
  IF {reply} .LT. 0 @s ferosdemo,finish
ENDIF

!------------------------------------------------------------------------------
! check optimum extraction
!------------------------------------------------------------------------------

WRITE/OUT " "
WRITE/OUT "*** check optimum extraction..."
WRITE/OUT " "

set/gra xa=4200,4500 ya=0,0.15
SET/GRAP colo=1
plo std_mer1
SET/GRAP colo=2
ove opt_mer1 ? ? -0.02
set/gra colo=1 xa ya

@s ferosdemo,finish


!------------------------------------------------------------------------------
! finish
!------------------------------------------------------------------------------

ENTRY finish
ECHO/OFF

WRITE/OUT " "
WRITE/OUT "*** End of Tutorial ***"
WRITE/OUT " "

RETURN/EXIT