Subs::XrtTdrss (version 0.0)

package Subs::XrtTdrss;
##############################################################################
#
# DESCRIPTION: This subroutine runs the xrttdrss script to process xrt tdrss 
#              data.
#
# HISTORY: 
# HISTORY: $Log: XrtTdrss.pm,v $
# HISTORY: Revision 1.9  2007/07/18 20:13:48  apsop
# HISTORY: Do not write VSUB keywords only if undefined.
# HISTORY:
# HISTORY: Revision 1.8  2007/07/17 18:06:21  apsop
# HISTORY: Propagate keywords for xrt substrate voltage to all tdrss products.
# HISTORY:
# HISTORY: Revision 1.7  2006/05/10 15:14:48  apsop
# HISTORY: Add xrt tdrss event list processing.
# HISTORY:
# HISTORY: Revision 1.6  2006/04/26 20:40:20  apsop
# HISTORY: Update params for xrttdrss, implement xrttdrss2 for images.
# HISTORY:
# HISTORY: Revision 1.5  2006/03/06 15:06:22  apsop
# HISTORY: Use new filenames for xrt tdrss postage stamp images.
# HISTORY:
# HISTORY: Revision 1.4  2006/01/31 16:49:45  apsop
# HISTORY: Fix bugs in renaming and combining postage stamp images.
# HISTORY:
# HISTORY: Revision 1.3  2006/01/29 19:39:47  apsop
# HISTORY: Code for combining multiple tdrss images into one file.
# HISTORY:
# HISTORY: Revision 1.2  2005/11/08 20:10:42  apsop
# HISTORY: New module for processing xrt tdrss data.
# HISTORY:
#
# VERSION: 0.0
#
##############################################################################


use Subs::Sub;
use Util::SwiftTags;

@ISA = ("Subs::Sub");
use strict;

sub new {
    my $proto=shift;
    my $self=$proto->SUPER::new();

    $self->{DESCRIPTION}="Process XRT tdrss messages";

    return $self;
}

##################
# METHODS:
##################

sub body {
    my $self=shift;

    my $log     =$self->log();
    my $filename=$self->filename();
    my $procpar =$self->procpar();
    my $jobpar  =$self->jobpar();

    #####################################
    # Processing of postage stamp images
    #####################################
    my $tdrss = Util::HEAdas->new('xrttdrss')
                            ->params({spec1file    => 'NONE',
				      spec2file    => 'NONE',
				      dnthr        => 9,
				      convfact     => 0.0,
				      posfile      => 'CALDB',
				      imbiasfile   => 'CALDB',
				      pdbiasfile   => 'CALDB'})
			    ->is_script(1);

    my @images = $filename->get('tdrawimage', 'x', 'ps', '*');
    foreach my $rw_image (@images){
      my $index = ( $filename->parse($rw_image, 'tdrawimage') )[2];
      my $sk_image = $rw_image;
      $sk_image =~ s/_rw/_sk/;
      $tdrss->params({imagefile    => $rw_image,
		      outimagefile => $sk_image})
	    ->run();
    }

    ###############################################
    # Check it we need to reformat the image files
    ###############################################
    my $tempim = 'xrttdrss_fits.tmp';
    my $create = Util::Ftool->new('fimgcreate')
	                    ->params({bitpix => 8,
				      naxes => '0',
				      datafile => 'none',
				      outfile => $tempim});

    my $append = Util::HEAdas->new('ftappend');
    my $cphead = Util::Ftool->new('cphead');

    foreach my $type ('tdrawimage', 'tdskyimage'){
      @images = sort( $filename->get($type, 'x', 'ps', '*') );
      if(@images){
	my $image = $images[0];
	my $imfits = Util::FITSfile->new($image);
	if( $imfits->nhdus() <= 1 || 
	    $imfits->keyword('EXTNAME') !~ /(LNG|SHT)\d{9}I\d{2}/ ){

	    $create->run();
	    foreach $image (@images){
	      $append->params({infile => $image .'[0]',
			       outfile => $tempim})
		     ->run();
	    }

	    unlink @images;
	    rename $tempim, $image;
	    $imfits = Util::FITSfile->new($image);

	    my ($tstart, $tstop) = (1E10, 0);
	    for(my $ext=1; $ext < $imfits->nhdus(); $ext++){
	      $imfits->ext($ext);
	      my ($start, $stop) = ($imfits->keyword('TSTART'), $imfits->keyword('TSTOP'));
	      $tstart = $start if $start < $tstart;
	      $tstop = $stop if $stop > $tstop;
	      my $int = int($start);
	      my $frac = int( ($start-$int)/2E-2 );

	      my $mode = $imfits->keyword('DATAMODE');
	      my $pneu = 'UNK';
	      $pneu = 'LNG' if $mode =~ /LONGIMA/;
	      $pneu = 'SHT' if $mode =~ /SHORTIMA/;

	      $imfits->keyword('EXTNAME', $pneu.$int.'I'.$frac);
	    }
	    my $start_date = Util::Date->new($tstart);
	    my $stop_date = Util::Date->new($tstop);

	    $imfits->ext(0);
	    $imfits->begin_many_keywords();
	    $imfits->keyword('INSTRUME', 'XRT     ');
	    $imfits->keyword('TSTART', $tstart);
	    $imfits->keyword('TSTOP', $tstop);
	    $imfits->keyword('DATE-OBS', $start_date->date().'T'.$start_date->time() );
	    $imfits->keyword('DATE-END', $stop_date->date().'T'.$stop_date->time() );
	    $imfits->end_many_keywords();
	}
      }
    }
    
    ###################################
    # Processing of Centroiding images
    ###################################
    my $tdrss2 = Util::HEAdas->new('xrttdrss2')
                            ->params({pcfile     => 'NONE',
				      attfile    => 'NONE',
				      outpcfile1 => 'NONE',
				      outpcfile2 => 'NONE',
				      cleanbp    => 'yes',
				      subimbias  => 'no',
				      maxtemp    => 0.0,
				      method     => 'AREA',
				      teldef     => 'CALDB',
				      chatter    => 3,
				      history    => 'yes',
				      interpolation => 'CONSTANT'})
			    ->is_script(1);

    @images = $filename->get('tdrawimage', 'x', 'im', '*');
    foreach my $rw_image (@images){
      my $sk_image = $rw_image;
      $sk_image =~ s/_rw/_sk/;
      $tdrss2->params({imfile    => $rw_image,
		       outimfile => $sk_image})
	    ->run();
    }

    $tdrss2->params({imfile    => 'NONE',
		     outimfile => 'NONE'});
    

    my @events = $filename->get('tdunfilter', 'x', 'pc', '*');
    foreach my $list (@events){
      my $cl_list = $list;
      $cl_list =~ s/_uf/_cl/;
      $tdrss2->params({pcfile    => $list,
		       outpcfile2 => $cl_list})
	    ->run();
    }

    ######################################
    # Propogate XRTVSUB/VSUBBAD keywords.
    ######################################

    if(@images){
      my $imfits = Util::FITSfile->new($images[0], 0);
      my $vsub = $imfits->keyword('XRTVSUB');
      my $vsubbad = $imfits->keyword('VSUBBAD');

      if( $vsub || $vsubbad ){
	my $tdrss = $filename->{INFO}->{tdrss};
	my @txtypes = grep $tdrss->{$_} eq 'x', (keys %{$tdrss});

	foreach my $txtype (@txtypes){
	  foreach my $txfile ($filename->get($txtype, 'x', '*', '*')){
	    my $txfits = Util::FITSfile->new($txfile, 0);
	    for(my $ext=0; $ext < $txfits->nhdus(); $ext++){
	      $txfits->ext($ext);
	      $txfits->keyword('XRTVSUB', $vsub, 'XRT substrate voltage') if defined $vsub;
	      $txfits->keyword('VSUBBAD', $vsubbad) if defined $vsubbad;
	    }
	  }
	}
      }
    }
}

1;