! @(#)lnreduce.prg	14.1.1.1 (ES0-DMD) 09/16/99 09:40:14
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++
!.COPYRIGHT   (C) 1993 European Southern Observatory
!.IDENT       lnreduce.prg
!.AUTHORS     Pascal Ballester (ESO/Garching) 
!             Cristian Levin   (ESO/La Silla)
!.KEYWORDS    Spectroscopy, Long-Slit
!.PURPOSE     Batch reduction of data.
!.VERSION     1.0  Package Creation  17-MAR-1993  
!-------------------------------------------------------
!
define/param P1 ? CHAR "Input Catalog : "


! Now process the input catalog. The variable image stores the current image.
def/loc exttab/c/1/80 " " all
def/loc extima/c/1/80 " " all
def/loc rebima/c/1/80 " " all
def/loc ndark/c/1/80 " " all
def/loc partbl/c/1/80 " " all
def/loc parwlc/c/1/80 " " all
def/loc image/c/1/80  " " all
def/loc outima/c/1/80 " " all
def/loc partab/c/1/80 " " all
def/loc catal/i/1/1 0
def/loc indx/i/1/1 0
def/loc rebmet/i/1/1 0
def/loc exairm/i/1/1 0
def/loc airm/r/1/1 0
def/loc n_test/i/1/1 0
def/loc redstrt/d/1/1 0.
def/loc redend/d/1/1 0.
def/loc redstp/d/1/1 0.

def/loc idxout/i/1/1 'outnumb'
def/loc incat/c/1/80 " " all

indx = m$index(p1, ".cat")
if indx .eq. 0 then
    write/keyw incat/c/1/80 'p1'.cat
else
    write/keyw incat/c/1/80 'p1'
endif

write/keyw partab/c/1/80 'session'
indx = m$index(session, ".tbl")
if indx .ne. 0 then
    indx = 'indx' - 1
    write/keyw partab/c/1/80 'session(1:{indx})'
endif

!!!!!
LOOP:
!!!!!
write/keyw exttab/c/1/80 " " all
write/keyw extima/c/1/80 " " all
write/keyw partbl/c/1/80 " " all
write/keyw parwlc/c/1/80 " " all
write/keyw ndark/c/1/80 " " all
write/keyw rebima/c/1/80 " " all

store/frame image 'incat' ? CLEAN

VERIFY/LONG 'image' IMA

indx = m$index(image, ".bdf")
if indx .ne. 0 then
    indx = 'indx' - 1
    write/keyw image/c/1/80 'image(1:{indx})'
endif

if outputf(1:1) .eq. " " then
    write/keyw outima/c/1/80 'image'_red
else
    write/keyw outima/c/1/80 'outputf''idxout'
    idxout = 'idxout' + 1
endif
!
write/out processing image 'image'...
!
-COPY 'image'.bdf tmp_comp.bdf
if BIASOPT(1:1) .eq. "Y" then
    n_test = M$TSTNO('bias')
    if n_test .eq. 0 -
        VERIFY/LONG  'bias' IMA
    comp/image tmp_comp1 = tmp_comp - 'bias'
    rename/image tmp_comp1 tmp_comp
endif

if DARKOPT(1:1) .eq. "Y" then
    VERIFY/LONG 'dark'  OTIME
    write/keyw ndark/c/1/80 'dark'
    comp/image tmp_dark = 'dark' / '{dark},o_time(7)' * '{image},o_time(7)'
    comp/image tmp_comp1 = tmp_comp - tmp_dark
    rename/image tmp_comp1 tmp_comp
endif

if FLATOPT(1:1) .eq. "Y" then
    n_test = M$TSTNO('flat')
    if n_test .eq. 0 -
        VERIFY/LONG  'flat'  IMA
    comp/image tmp_comp1 = tmp_comp / 'flat'
    rename/image tmp_comp1 tmp_comp
endif

copy/dd 'image' lhcuts tmp_comp

if ROTOPT(1:1) .eq. "Y" then
    write/out "rotating..."
    rotate/clock tmp_comp tmp_comp_rot
    rename/image tmp_comp_rot tmp_comp
    write/desc tmp_comp start/d/2/1 'rotstep(1)'
    write/desc tmp_comp step/d/2/1  'rotstep(2)'
endif

if TRIMOPT(1:1) .eq. "Y" then
    write/out "extracting subimage..."
    extract/image 'outima' = tmp_comp[@'trim(1)',@'trim(2)':@'trim(3)',@'trim(4)']
    del/image tmp_comp n
else
    -COPY tmp_comp.bdf 'outima'.bdf
endif
!
write/keyw rebima/c/1/80 'image'rb_tmp
if REBOPT(1:1) .eq. "Y" then
    write/out "rebinning..."
    redstrt = '{partab}COE.tbl,REBSTRT'
    redend  = '{partab}COE.tbl,REBEND'
    redstp  = '{partab}COE.tbl,REBSTP'
    REBIN/LONG 'outima' 'rebima' 'redstrt','redend','redstp' 'rebmtd' 'partab'COE.tbl
    -COPY 'rebima'.bdf 'outima'.bdf
endif

write/keyw extima/c/1/80 'image'_ext
if EXTOPT(1:1) .eq. "Y" then
    write/out "extinction correction..."
    EXTINCTION/LONG 'outima' 'extima'
    -COPY 'extima'.bdf 'outima'.bdf
endif


if RESPOPT(1:1) .eq. "Y" then
    write/out "flux calibration..."
    CALIBRATE/FLUX 'outima' tmp_comp1
    rename/image tmp_comp1 'outima'
endif

DELETE/IMAGE  'rebima'.bdf  NO
DELETE/IMAGE  'extima'.bdf  NO
write/out output image is 'outima'...
goto LOOP

CLEAN:
-DELETE tmp_in.cat tmp_dark.bdf tmp_flat.bdf 

write/out
write/out "Batch reduction done."