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;