#!/usr/bin/perl -w
#-------------------------------------------------------------------------------
#Purpose     : generate reduce script
#Author      : Robert Greimel (greimel@uvastro.phys.uvic.ca,greimel@ing.iac.es)
#Last Change : 21-Feb-2000
#-------------------------------------------------------------------------------
use Scripts;

##
# get directory name (which is the observing date) and calc observation date
##
$ARGV[0] =~ s./$..;
$obsdate = (split "/",$ARGV[0])[-1];
print "generating reduction script for $obsdate\n";

%month=("jan" => "01","feb" => "02","mar" => "03","apr" => "04",
        "may" => "05","jun" => "06","jul" => "07","aug" => "08",
        "sep" => "09","oct" => "10","nov" => "11","dec" => "12");
@date = split "-",$obsdate;
$nobsdate = $date[2].$month{$date[0]}.$date[1];

%ccdinfo=("UBC-1"     => ["4096","200"],
          "UBC4K-LAB" => ["4096","200"],
          "SITE2-LAB" => ["1752","532"],
          "SITe4"     => ["4096","2048"],
          "SITe5"     => ["1024","1024"],
         );

##
# make sure directory ends with a "/"
##
$dir = $ARGV[0];
if ($dir !~ m|/$|) {$dir = $dir."/"};

##########
#read generation options
##########
%filenames=();
print "$0: reading filename configuration ... ";
&Scripts::read_filenames(\%filenames,"config.names");
print "done\n";

%options=();
print "$0: reading default options ... ";
( &Scripts::read_options(\%options,$filenames{"default_options"}) ) ? print "successful\n" : print "failed\n" ;

print "$0: reading directory specific options ... ";
( &Scripts::read_options(\%options,$dir.$filenames{"custom_options"}) ) ? print "successful\n" : print "failed\n" ;

if ($options{"directory"} eq "yes")
  {
  print "directory option is on\n";
  $dir_inout=$dir.$filenames{"dir_inout"}."/";
  $nam_inout=$filenames{"dir_inout"}."/";
  $dir_sum=$dir.$filenames{"dir_sum"}."/";
  $nam_sum=$filenames{"dir_sum"}."/";
  if ( ! -e $dir_sum ) {mkdir $dir_sum,0755;}
  }
else
  {
  print "directory option is off\n";
  $dir_inout=$dir;
  $nam_inout="";
  $dir_sum=$dir;
  $nam_sum="";
  }

##
# read in tables
##
if ( ! -e $dir."bias.table" ) {die "no BIAS table found\n";}
open TBIAS,$dir."bias.table";
while (<TBIAS>)
  {
  next if (m/^#/);
  chomp $_;
  push @tbias,$_;
  }
close TBIAS;
if ( ! -e $dir."flat.table" ) {die "no FLAT table found\n";}
open TFLAT,$dir."flat.table";
while (<TFLAT>)
  {
  next if (m/^#/);
  chomp $_;
  push @tflat,$_;
  }
close TFLAT;
if ( ! -e $dir."arc.table" ) {die "no ARC table found\n";}
open TARC,$dir."arc.table";
while (<TARC>)
  {
  next if (m/^#/);
  chomp $_;
  push @tarc,$_;
  }
close TARC;
if ( ! -e $dir."object.table" ) {die "no OBJECT table found\n";}
open TOBJECT,$dir."object.table";
while (<TOBJECT>)
  {
  next if (m/^#/);
  chomp $_;
  push @tobject,$_;
  }
close TOBJECT;
%star_name=();
if ( ! -e "stars.coo" ) {die "no stars.coo file found\n";}
&read_star ("stars.coo");
if ( -e $dir."addstars.coo" ) {&read_star ($dir."addstars.coo");}
if ( ! -e $dir.$filenames{"inst_data"} ) {die "no INSTRUMENT file found\n";}
open TINST,$dir.$filenames{"inst_data"};
while (<TINST>)
  {
  next if (m/^#/);
  @o=split " ",$_;
  if ( $o[0] eq "NAXIS1" ) {$naxis1=$o[2];next;}
  if ( $o[0] eq "NAXIS2" ) {$naxis2=$o[2];next;}
  if ( $o[0] eq "INSTRUME=" ) {$ccd=$o[1];next;}
  }
close TINST;
%frame_type = ();
open TFRAME,$dir.$filenames{"type_file"};
while (<TFRAME>)
  {
  chomp;
  @in=split;
  $in[0] =~ m/\.([0-9]+)$/;
  $frame_type{$1}=$in[-1];
  }
close TFRAME;

##
# setup variables
##
open IN,$dir_inout."object.in";
$_=<IN>;
$fprefix = substr $_,0,-(length $_)+(rindex $_,".");
close IN;

open IN,$dir.$filenames{"data_rows"};
while(<IN>) {$in=$_;}
close IN;
chomp $in;

@default_imrow=split " ",$in;
$reduce_script=$dir.$filenames{"reduce_script"};

##
# find flatfield combinations
##
%fcomb = ();
foreach $i (@tobject)
  {
  @oinfo = split " ",$i;
  @combine = split /\+/,$oinfo[2];
  if ( $#combine == 0 ) {next;}
  $fcomb{$oinfo[2]}=1;
  }

##
# find bias combinations
##
%bcomb = ();
foreach $i (@tobject,@tflat,@tarc)
  {
  @oinfo = split " ",$i;
  @combine = split /\+/,$oinfo[1];
  if ( $#combine == 0 ) {next;}
  $bcomb{$oinfo[1]}=1;
  }

##########
# CCD specific settings (default)
##########
if ($ccd eq "UBC-1" || $ccd eq "UBC4K-LAB")
  {
  $sample="4104:4200";
  $xspec="1:4096";
  $badpix="3882 3888 1 20\n";
  $cr_threshold=20;
  $cr_fluxratio=5;
  }
elsif ($ccd eq "SITE2-LAB")
  {
  $sample="1:17,1778:1900";
  $xspec="23:1772";
  $badpix="1421 1422 1 40\n";
  $cr_threshold=20;
  $cr_fluxratio=2;
  }
elsif ($ccd eq "SITe-4")
  {
  $sample="4104:4200";
  $xspec="1:4096";
  $badpix="\n";
  $cr_threshold=20;
  $cr_fluxratio=2;
  }
elsif ($ccd eq "SITe-5")
  {
  $sample="1030:1080";
  $xspec="1:1024";
  $badpix="\n";
  $cr_threshold=20;
  $cr_fluxratio=2;
  }
else
  {
  print "\n  WARNING - CCD id ".$ccd." unknown \n\n";
  $sample=":";
  $xspec="*";
  $badpix="\n";
  $cr_threshold=20;
  $cr_fluxratio=5;
  }
##########
# modify default settings if specified by user
##########
if ( $options{"cosmicrays.threshold"} !~ m/[^0-9\.]/)
  {$cr_threshold=$options{"cosmicrays.threshold"};}
if ( $options{"cosmicrays.fluxratio"} !~ m/[^0-9\.]/)
  {$cr_fluxratio=$options{"cosmicrays.fluxratio"};}

##########
# generate reduce script
##########
print " started creating reduction script for ".$ccd."\n";
open OUT,">$reduce_script";

print OUT "#########################################\n";
print OUT "### To reduce ".$ccdinfo{$ccd}[0]."x".$ccdinfo{$ccd}[1]." binned spectra ###\n";
print OUT "#########################################\n";
print OUT "dataio.\n";
print OUT "images.\n";
print OUT "images.imfilter.\n";
print OUT "proto.\n";
print OUT "noao.\n";
print OUT "noao.imred.\n";
print OUT "noao.imred.ccdred.\n";
print OUT "noao.imred.generic.\n";
print OUT "noao.imred.crutil.\n";
print OUT "noao.onedspec.\n";
print OUT "###############################\n";
print OUT 'rfits.datatype="ushort"',"\n";
print OUT 'imarith.calctyp="real"',"\n";
print OUT 'imarith.pixtype="real"',"\n";
print OUT "unlearn imcombine", "\n";
print OUT 'imcombine.outtype="real"',"\n";
print OUT 'imcombine.weight="none"',"\n";
print OUT 'imcombine.combine="average"',"\n";
print OUT "###############################\n";
print OUT "# to construct badpixel mask\n";
print OUT "#text2mask.ncol=".$naxis1."\n";
print OUT "#text2mask.nlines=".$naxis2."\n";
print OUT "#text2mask badpixfile mask ncol=".$naxis1." nlines=".$naxis2."\n";
print OUT "###############################\n";

##########
# bias header
##########
print " bias ...";

print OUT "###############################\n";
print OUT "#to read bias\n";
print OUT "#to average bias\n";
print OUT "#to delete raw bias\n";
print OUT "####################\n";
print OUT "# bias????.in contains the raw FITS names of the bias data files,\n";
print OUT "#   e.g., rawdat/c122_98.1234\n";
print OUT "# bias????.out contains the IRAF names of the bias files, e.g., bias.1234\n";
print OUT "####################\n";

##########
# bias
##########
foreach $i (@tbias)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  $in = $nam_inout.$in;
  $out = $in; $out =~ s/.in/.out/;
  print OUT "rfits @".$in." * @".$out."\n";
  print OUT "cosmicrays @".$out." @".$out." interac=no threshold=".$cr_threshold." fluxratio=".$cr_fluxratio."\n";
  print OUT "imcombine @".$out." ".$ave." reject=pclip\n";
  print OUT "#fixpix ".$ave." mask linterp=1\n";
  print OUT "imdelete @".$out."\n";
  print OUT "#\n";
  }
foreach $i ( keys %bcomb )
  {
  @combine = split /\+/,$i;
  foreach $j ( @combine )
    {
    $in = $nam_inout."bias".$j.".in";
    $out = $nam_inout."bias".$j.".out";
    print OUT 'rfits @'.$in.' * @'.$out."\n";
    print OUT 'cosmicrays @'.$out.' @'.$out." interac=no threshold=".$cr_threshold." fluxratio=".$cr_fluxratio."\n";
    }
  map {$_='@'.$nam_inout."bias".$_.".out"} @combine;
  $out = join ",",@combine;
  $ave = "bias".$i.".ave";
  print OUT "imcombine ".$out." ".$ave." reject=pclip\n";
  print OUT "#fixpix ".$ave." mask linterp=1\n";
  print OUT "imdelete ".$out."\n";
  print OUT "#\n";
  }
print "done\n";

##########
# flat header
##########
print " flat ...";

print OUT "#####################\n";
print OUT "#to read dome flat\n";
print OUT "#to average dflat\n";
print OUT "#to delete raw dflat\n";
print OUT "####################\n";
print OUT "# dflat????.in contains the raw FITS names of the dflat data files,\n";
print OUT "#   e.g., rawdat/c122_98.1234\n";
print OUT "# dflat????.out contains the IRAF names of the dflat files, e.g., dflat.1234\n";
print OUT "####################\n";

##########
# flat
##########
foreach $i (@tflat)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  $in = $nam_inout.$in;
  $out = $in; $out =~ s/.in/.out/;
  print OUT "rfits @".$in." * @".$out."\n";
  print OUT "#cosmicrays @".$out." @".$out." interac=no threshold=".$cr_threshold." fluxratio=".$cr_fluxratio."\n";
  print OUT "imcombine @".$out." ".$ave." reject=none\n";
  print OUT "#fixpix ".$ave." mask linterp=1\n";
  print OUT "imdelete @".$out."\n";
  print OUT "#\n";
  }
foreach $i ( keys %fcomb )
  {
  @combine = split /\+/,$i;
  foreach $j ( @combine )
    {
    $in = $nam_inout."flat".$j.".in";
    $out = $nam_inout."flat".$j.".out";
    print OUT 'rfits @'.$in.' * @'.$out."\n";
    print OUT '#cosmicrays @'.$out.' @'.$out." interac=no threshold=".$cr_threshold." fluxratio=".$cr_fluxratio."\n";
    }
  map {$_='@'.$nam_inout."flat".$_.".out"} @combine;
  $out = join ",",@combine;
  $ave = "flat".$i.".ave";
  print OUT "imcombine ".$out." ".$ave." reject=none\n";
  print OUT "#fixpix ".$ave." mask linterp=1\n";
  print OUT "imdelete ".$out."\n";
  print OUT "#\n";
  }

print OUT "############################\n";
print OUT "#to subtract bias from dflat\n";
print OUT "############################\n";
print OUT "# badpixfile contains the bad columns (before trimming)\n";
print OUT "############################\n";
print OUT "#\n";

foreach $i (@tflat)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  $dflat = "d".$in;$dflat =~ s/.in//;
  $bave = "bias".(split " ",$i)[1].".ave";
  print OUT "imarith ".$ave." - ".$bave." dflat\n";
  print OUT 'cosmicrays @dflat.dark @dflat.dark interac=no threshold='.$cr_threshold." fluxratio=".$cr_fluxratio."\n";
  print OUT '#background dflat spec axis=1 naverage=5 interac=no sample="'.$sample.'"',"\n";
  print OUT "imcopy dflat spec","\n";
  print OUT '#lineclean spec '.$dflat.' interac=no grow=0 sample="*"',"\n";
  print OUT "imcopy spec ".$dflat."\n";
  print OUT "imdelete dflat,spec,".$ave."\n";
  print OUT "#\n";
  }

foreach $i ( keys %fcomb )
  {
  @combine = split /\+/,$i;
  ($if) = grep /flat$combine[1]/,@tflat;
  $ave = "flat".$i.".ave";
  $dflat = "dflat".$i;
  $bave = "bias".(split " ",$if)[1].".ave";
  print OUT "imarith ".$ave." - ".$bave." dflat\n";
  print OUT 'cosmicrays @dflat.dark @dflat.dark interac=no threshold='.$cr_threshold." fluxratio=".$cr_fluxratio."\n";
  print OUT '#background dflat spec axis=1 naverage=5 interac=no sample="'.$sample.'"',"\n";
  print OUT "imcopy dflat spec","\n";
  print OUT '#lineclean spec '.$dflat.' interac=no grow=0 sample="*"',"\n";
  print OUT "imcopy spec ".$dflat."\n";
  print OUT "imdelete dflat,spec,".$ave."\n";
  print OUT "#\n";
  }
print "done\n";

##########
# star
##########
print " star ...";
print OUT "##############\n";
print OUT "#to read star\n";
print OUT "##############\n";
foreach $i (@tobject)
  {
  $out = (split " ",$i)[0];
  $out =~ /.*\.([0-9]+)[A-z]*$/;
  $num = $1;
  print OUT "rfits ".$fprefix.".".$num.".fits * ".$out."\n";
  }

##########
# star header
##########
print OUT "############################\n";
print OUT "#to subtract bias from star\n";
print OUT "############################\n";
print OUT "#####################################\n";
print OUT "# star.drk contains the dark rows of the spectrum star, e.g., star[,1], star[,2], star[,8], star[,9] etc\n";
print OUT "#    procedure:\n";
print OUT "#          subtract mean bias\n";
print OUT "#          fixpix the bad pixels,\n";
print OUT "#          background to fine correct bias level,\n";
print OUT "#          imcombine the dark rows\n";
print OUT "#          gauss smooth the dark before subtraction\n";
print OUT "#####################################\n";
print OUT "#\n";

foreach $i (@tobject)
  {
  $out = (split " ",$i)[0];
  $bave = "bias".(split " ",$i)[1].".ave";
  print OUT "imarith ".$out." - ".$bave." starb\n";
  print OUT "#fixpix starb mask linterp=1\n";
  print OUT 'cosmicrays @star.dark @star.dark interac=no threshold='.$cr_threshold." fluxratio=".$cr_fluxratio."\n";
  print OUT '#background starb star axis=1 naverage=5 interac=no sample="'.$sample.'"',"\n";
  print OUT "imcopy starb star\n";
  print OUT 'imcombine @star.drk dark reject=pclip',"\n";
  print OUT "gauss dark drk 2.0\n";
  print OUT "imarith star - drk ".$out.".b\n";
  print OUT "imdelete dark,drk\n";
  print OUT "imdelete star,starb\n";
  print OUT "#\n";
  }

print OUT "###################\n";
print OUT "#to delete raw star\n";
print OUT "###################\n";
foreach $i (@tobject)
  {
  $out = (split " ",$i)[0];
  print OUT "imdelete ".$out."\n";
  }

print OUT "########################\n";
print OUT "#to divide star by dflat\n";
print OUT "########################\n";
foreach $i (@tobject)
  {
  @oinfo = split " ",$i;
  $out = $oinfo[0];
  $fave = "dflat".$oinfo[2];
  @imrow = splice @oinfo,5;
  foreach $j (@imrow)
    {
    print OUT "imdivide ".$out.".b[".$xspec.",".$j."] ".$fave."[".$xspec.",".$j."] ".$out.".bf".$j."\n";
    }
  print OUT "#\n";
  }

print OUT "######################\n";
print OUT "#to delete biased star\n";
print OUT "######################\n";
foreach $i (@tobject)
  {
  $out = (split " ",$i)[0];
  print OUT "imdelete ".$out.".b\n";
  }
foreach $i (@tflat)
  {
  $in = (split " ",$i)[0];
  $dflat = "d".$in;$dflat =~ s/.in//;
  print OUT "imdelete ".$dflat."\n";
  }
foreach $i ( keys %fcomb )
  {
  $dflat = "dflat".$i;
  print OUT "imdelete ".$dflat."\n";
  }
print "done\n";

##########
# arc header
##########
print " arc ...";
print OUT "###################\n";
print OUT "#to read arc\n";
print OUT "#to average arc\n";
print OUT "#to delete raw arc\n";
print OUT "####################\n";
print OUT "# tharc????.in contains the raw FITS names of the arc data files,\n";
print OUT "#   e.g., rawdat/c122_98.1234\n";
print OUT "# tharc????.out contains the IRAF names of the arc files, e.g., tharc.1234\n";
print OUT "####################\n";
print OUT "#\n";

##########
# arc
##########
# arcs are a special case - if a character follows the number only the name
# up to the number has to be used as the .in and .out file.
##########
foreach $i (@tarc)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  $in =~ s/(.*[0-9]+).*/$1\.in/;
  $in = $nam_inout.$in;
  $out = $in; $out =~ s/.in/.out/;
  print OUT "rfits @".$in." * @".$out."\n";
  print OUT "imcombine @".$out." ".$ave." reject=none\n";
  print OUT "imdelete @".$out."\n";
  print OUT "#\n";
  }
print OUT "###########################\n";
print OUT "#to subtract bias from arc\n";
print OUT "###########################\n";
foreach $i (@tarc)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  $bave = "bias".(split " ",$i)[1].".ave";
  print OUT "imarith ".$ave." - ".$bave." arc\n";
  print OUT "#fixpix arc mask linterp=1\n";
  print OUT "#background arc ".$ave.'.b axis=1 naverage=5 interac=no sample="'.$sample.'"',"\n";
  print OUT "imcopy arc ".$ave.".b\n";
  print OUT "imdelete arc\n";
  print OUT "#\n";
  }
print "done\n";

##########
# delete
##########
print " delete ...";
print OUT "######################\n";
print OUT "#to delete average arc\n";
print OUT "######################\n";
foreach $i (@tarc)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  print OUT "imdelete ".$ave."\n";
  }
print OUT "######################\n";
print OUT "#to delete average bias\n";
print OUT "######################\n";
foreach $i (@tbias)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  print OUT "imdelete ".$ave."\n";
  }
foreach $i ( keys %bcomb )
  {
  $ave = "bias".$i.".ave";
  print OUT "imdelete ".$ave."\n";
  }
print "done\n";

##########
# 2D -> 1D header
##########
print " 2D -> 1D ...";
print OUT "###################################\n";
print OUT "#to project the 2-D spectra to 1-D\n";
print OUT "###################################\n";
print OUT "# star.???.sum.lis contains the trimmed rows to be summed over to make \n";
print OUT "# up the 1-D spectrum,\n";
print OUT "#                  e.g., star.????.bf[23:1752,7] etc\n";
print OUT "####################################\n";
print OUT 'imcombine.combine="average"',"\n";
print OUT 'imcombine.scale="mean"',"\n";
print OUT 'imcombine.reject="minmax"',"\n";
print OUT 'imcombine.weight="mean"',"\n";
print OUT 'imcombine.nlow=0',"\n";
print OUT 'imcombine.nhigh=1',"\n";
print OUT 'imcombine.rdnoise=6.5',"\n";
print OUT 'imcombine.gain=1.8',"\n";
print OUT "###############################\n";

##########
# 2D -> 1D
##########
$first = 1;
foreach $i (@tobject)
  {
  $out = (split " ",$i)[0];
  $sumfile = $dir_sum.$out.".sum.lis";
  if ( ! -e $sumfile )
    {
    if ( $first )
      {
      print "\n";
      $first = 0;
      }
    print " creating ".$out.".sum.lis ...";
    @oinfo = split " ",$i;
    @imrow = splice @oinfo,5;
    open SUM,">$sumfile";
    foreach $j (@imrow)
      {
      print SUM $out.".bf".$j."\n";
      }
    close SUM;
    print "done\n";
    }
  print OUT "imcombine @".$nam_sum.$out.".sum.lis ".$out.".bfs\n";
  }
print OUT "#\n";
print OUT 'imcombine.combine="sum"',"\n";
print OUT 'imcombine.scale="mean"',"\n";
print OUT 'imcombine.reject="none"',"\n";
print OUT 'imcombine.weight="none"',"\n";
print OUT "#\n";
foreach $i (@tarc)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  $sumfile = $dir_sum.$ave.".sum.lis";
  if ( ! -e $sumfile )
    {
    print " creating $ave.sum.lis ...";
    @oinfo = split " ",$i;
    @imrow = splice @oinfo,5;
    open SUM,">$sumfile";
    foreach $j (@imrow)
      {
      print SUM $ave.".b[".$xspec.",".$j."]\n";
      }
    close SUM;
    print "done\n";
    }
  print OUT "imcombine @".$nam_sum.$ave.".sum.lis ".$ave.".bs\n";
  }
print OUT "##########################\n";
print OUT "#to delete the 2-D spectra\n";
print OUT "##########################\n";
foreach $i (@tobject)
  {
  $out = (split " ",$i)[0];
  print OUT "imdelete @".$nam_sum.$out.".sum.lis\n";
  }
print OUT "#\n";
foreach $i (@tarc)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  print OUT "imdelete ".$ave.".b\n";
  }
print "done\n";

##########
# JD header
##########
print " the rest ...";
print OUT "###############################\n";
print OUT "#to setup OBSERVAT & ST in header\n";
print OUT "#to calculate JD & midexposure into header\n";
print OUT "#to translate into fits format\n";
print OUT "###############################\n";
print OUT "hedit.verify=no\n";
print OUT "hedit.update=yes\n";
print OUT '#identify.coordli="arcline.dat"',"\n";
print OUT "#identify.maxfeat=77\n";
print OUT "#identify.order=3\n";
print OUT "#identify.fwidth=4\n";
print OUT '#identify.ftype="emission"',"\n";
print OUT '#identify.functio="spline3"',"\n";
print OUT "#reidentify.verbose=yes\n";
print OUT "#dispcor.listonl=no\n";
print OUT "#dispcor.verbose=yes\n";
print OUT "#dispcor.linearize=no\n";
print OUT 'wfits.fextn=""',"\n";
print OUT "########################\n";

##########
# the rest of the story ...
##########
foreach $i (@tobject)
  {
  @oinfo = split " ",$i;
  $out = $oinfo[0];
  ($namealias, $frame) = (split /\./,$out);
  if ( exists $star_name{$namealias} )
    { $name=$star_name{$namealias}; }
  else
    { $name=$namealias; }
  $rowrange=$oinfo[5]."-".$oinfo[-1];
  print OUT "hedit ".$out.'.bfs title "'.$name.": ".$nobsdate.": ".$frame.": bin10,biased,flat-fielded,sum(".$rowrange.')"',"\n";
  print OUT "hedit ".$out.".bfs OBSERVAT DAO add=yes\n";
  print OUT "hedit ".$out.'.bfs ST "(SIDEREAL)" add=yes',"\n";
  print OUT "setairmass ".$out.'.bfs intype="begin" outtype="middle" exposure="EXPTIME"',"\n";
  print OUT "setjd ".$out.'.bfs exposure="EXPTIME"',"\n";
  print OUT "wfits ".$out.".bfs $out.fit\n";
  print OUT "#\n";
  }
$rowrange=$default_imrow[0]."-".$default_imrow[-1];
foreach $i (@tarc)
  {
  @oinfo = split " ",$i;
  $in = $oinfo[0];
  $out = $in;
  $out =~ s/(^.*[0-9]+).*$/$1\.out/;
  $ave = $in; $ave =~ s/.in/.ave/;
  $in =~ m/[A-z]*([0-9]+)(.*)\.in/;
  $num = $1;
  $ext = $2;
  open ARC,$dir_inout.$out;
  @arcfiles=<ARC>;
  close ARC;
  $from=(split /\./,$arcfiles[0])[-1];
  $to=(split /\./,$arcfiles[-1])[-1];
  chomp $from;
  chomp $to;
  $rowrange=$oinfo[5]."-".$oinfo[-1];
  $title = "unknown";$fname="arc";
  if ($frame_type{$num} eq "cdne") {$title = "Cd-Ne Arc";$fname = "cdnearc"}
  if ($frame_type{$num} eq "fear") {$title = "Fe-Ar Arc";$fname = "fearc"}
  if ($frame_type{$num} eq "thar") {$title = "Th-Ar Arc";$fname = "tharc"}
  print OUT "hedit ".$ave.'.bs title "'.$title.': '.$nobsdate.": ".$from."-".$to.": bin10,biased,flat-fielded,sum(".$rowrange.')"',"\n";
  print OUT "hedit ".$ave.".bs OBSERVAT DAO add=yes\n";
  print OUT "setjd ".$ave.'.bs exposure="EXPTIME"',"\n";
  print OUT "#dispcor ".$ave.".bs ".$ave.".bs\n";
  print OUT "wfits ".$ave.".bs ".$fname.".".$num.$ext.".fit\n";
  print OUT "#\n";
  }
print "done\n";

##########
# last delete
##########
print OUT "##########################\n";
print OUT "#to delete the 1-D spectra\n";
print OUT "##########################\n";
foreach $i (@tobject)
  {
  $out = (split " ",$i)[0];
  print OUT "imdelete ".$out.".bfs\n";
  }
print OUT "#\n";
foreach $i (@tarc)
  {
  $in = (split " ",$i)[0];
  $ave = $in; $ave =~ s/.in/.ave/;
  print OUT "imdelete ".$ave.".bs\n";
  }
print OUT "#\n";
print OUT "lo\n";

close OUT;

##########
# now create all the auxiliary files if they do not yet exist
##########
$file=$dir."badpixfile";
if ( ! -e $file )
  {
  print " creating ".$file."\n";
  open FILE,">$file";
  print FILE $badpix;
  close FILE;
  }

$file=$dir."dflat.dark";
if ( ! -e $file )
  {
  print " creating ".$file."\n";
  open FILE,">$file";
  print FILE "dflat[1:".$ccdinfo{$ccd}[0].",1:".($default_imrow[0]-1)."]\n";
  print FILE "dflat[1:".$ccdinfo{$ccd}[0].",".($default_imrow[-1]+1).":".$naxis2."]\n";
  close FILE;
  }

$file=$dir."star.dark";
if ( ! -e $file )
  {
  print " creating ".$file."\n";
  open FILE,">$file";
  print FILE "starb[1:".$ccdinfo{$ccd}[0].",1:".($default_imrow[0]-1)."]\n";
  print FILE "starb[1:".$ccdinfo{$ccd}[0].",".($default_imrow[-1]+1).":".$naxis2."]\n";
  close FILE;
  }

$file=$dir."star.drk";
if ( ! -e $file )
  {
  print " creating ".$file."\n";
  open FILE,">$file";
  foreach $row (1..$default_imrow[0]-3)
    {
    print FILE "star[,".$row."]\n";
    }
  foreach $row ($default_imrow[-1]+3..$naxis2)
    {
    print FILE "star[,".$row."]\n";
    }
  close FILE;
  }

print " \n";
print " make sure you check the following files:\n";
print " \n";
print "  - badpixfile\n";
print "  - dflat.dark\n";
print "  - star.dark\n";
print "  - star.drk\n";
print " \n";
print "  - *.sum.lis\n";
print " \n";
print ' happy reducing (cl < '.$filenames{"reduce_script"}.' >& reduce.log &)',"\n";
print " \n";

################################################################################
#                            S U B R O U T I N E S
################################################################################
sub read_star()
  {
  (my $filename) = @_;
  open TSTARS,$filename;
  while (<TSTARS>)
    {
    next if (m/^#/);
    @o=split " ",$_;
    $star_name{$o[0]}=join " ",(splice @o,3);
    }
  close TSTARS;
  }