package Subs::SortTdrss;
##############################################################################
#
# DESCRIPTION:
#
# HISTORY:
# HISTORY: $Log: SortTdrss.pm,v $
# HISTORY: Revision 1.14 2005/03/17 13:39:17 apsop
# HISTORY: Fix bug in reading of jobpar for tstart value
# HISTORY:
# HISTORY: Revision 1.13 2005/03/15 19:26:28 apsop
# HISTORY: Check for presence of xrt no position message when making tdrss cat file. Fix bug in checking for empty diag file. Write DATE-OBS to primary hdu of diag file.
# HISTORY:
# HISTORY: Revision 1.13 2005/03/15 19:03:26 apsop
# HISTORY: Check for presence of xrt no position message when making tdrss cat file.
# HISTORY:
# HISTORY: Revision 1.12 2004/12/03 13:37:12 apsop
# HISTORY: Make compatible with test pipeline: st versus sw
# HISTORY:
# HISTORY: Revision 1.11 2004/11/12 14:21:09 apsop
# HISTORY: Change to using PKTIME as alternate source for DATE-OBS in the tdref file.
# HISTORY:
# HISTORY: Revision 1.10 2004/11/11 23:59:47 apsop
# HISTORY: Add some log entries
# HISTORY:
# HISTORY: Revision 1.9 2004/11/09 23:51:13 apsop
# HISTORY: Combine non-science tdrss messages into one trend data file. New alogorithm for writing DATE-OBS keyword into mspob.fits file which guarantees a value is always written.
# HISTORY:
# HISTORY: Revision 1.8 2004/11/02 21:23:02 apsop
# HISTORY: Write DATE* keywords into tdref files.
# HISTORY:
# HISTORY: Revision 1.7 2004/10/29 20:31:55 apsop
# HISTORY: Fix bugs in source of info
# HISTORY:
# HISTORY: Revision 1.6 2004/10/27 12:44:33 apsop
# HISTORY: Fix bug in extracting pointing RA from FOM message.
# HISTORY:
# HISTORY: Revision 1.5 2004/10/25 14:53:17 apsop
# HISTORY: Use Bobs new FITStable utility to write db table file.
# HISTORY:
# HISTORY: Revision 1.4 2004/10/17 21:19:16 apsop
# HISTORY: Get date and proc version from sources that are actually availabe.
# HISTORY:
# HISTORY: Revision 1.3 2004/10/15 14:59:29 apsop
# HISTORY: Add bat_trigger_stop column and fix format of xrt_time column.
# HISTORY:
# HISTORY: Revision 1.2 2004/10/13 02:13:49 apsop
# HISTORY: Remove redundant tdrss messages, and create tdrss database fits file.
# HISTORY:
# HISTORY: Revision 1.1 2004/09/14 18:55:08 apsop
# HISTORY: First version of module.
# HISTORY:
# HISTORY:
#
# VERSION: 0.0
#
#
##############################################################################
use Subs::Sub;
@ISA = ("Subs::Sub");
use strict;
use Util::HEAdas;
use Util::Date;
use Util::FITStable;
sub new {
my $proto=shift;
my $self=$proto->SUPER::new();
$self->{DESCRIPTION}="Sort and organize TDRSS messages";
return $self;
}
##################
# METHODS:
##################
sub dbTimeString
{
my ($s) = @_;
my $date = Util::Date->new($s);
my $s1 = $date->date;
my $s2 = $date->time;
my $str = qq('$s1 $s2');
return $str;
}
sub body {
my $self=shift;
my $log =$self->log();
my $filename=$self->filename();
my $procpar =$self->procpar();
my $jobpar =$self->jobpar();
my $EXCLUDE = 'PKTTIME,PKTSEC,PKTSUBS,APID';
my @burst_modes = ('al', 'ce', 'no', 'ap', 'di', 'ni', 'fc', 'sm', 'atlc');
my $burst_grep = '('. join('|', @burst_modes) .')';
my $tdrss = $filename->{INFO}->{tdrss};
my @tdrss_types = keys %{$tdrss};
####################################################
# Get a list of obsids that have tdrss messages
###################################################
my %obsids;
foreach my $type (@tdrss_types){
foreach my $file ($filename->any($type)){
if( $file =~ /^s[wt](\d{11})ms/ ){
$obsids{$1} = 1;
}else{
$log->error(1, "Is file $file really tdrss?");
}
}
}
$log->entry('Tdrss obs ids for this run: '. join(' ', keys %obsids) );
############################################################
# Step thru all the messages, and delete any with index > 1
# which contain identical info to the index=0 message
###########################################################
my $diff = Util::Ftool->new('fdiff')
->params({exclude => $EXCLUDE,
verbose => 'yes'});
foreach my $type (@tdrss_types){
foreach my $file ($filename->get($type, '*', '*', 0)){
$diff ->params({file1 => "$file\[0]"});
my ($inst, $mode, $index) = $filename->parse($file, $type);
my $id = ($file =~ /s[wt](\d{11})ms/)[0];
my @files = grep /${id}.*_\d+\./, $filename->get($type, $inst, $mode, '*');
foreach my $index_file (@files){
$diff->params({file2 => "$index_file\[0]"})
->run();
if( $diff->stdout() =~ /No differences/s ){
$log->entry("Deleting redundant tdrss file $index_file");
unlink $index_file;
}
}
}
}
# set up the database columns
my @dbAlert = (
# alert keys
{ name => 'ufcf_corr',
type => '1D',
unit => 's',
key => 'UTCCTIME',
},
{ name => 'trigger_satisfied',
type => '1I',
null => -1,
key => 'TRIGSATF',
},
{ name => 'rate_score',
type => '1E',
key => 'RATESCOR',
},
{ name => 'rate_score_snr',
type => '1E',
key => 'RATESNR',
},
{ name => 'bat_ra',
type => '1D',
unit => 'degree',
disp => 'F10.5',
key => 'BRA_OBJ',
},
{ name => 'bat_dec',
type => '1D',
unit => 'degree',
disp => 'F10.5',
key => 'BDEC_OBJ',
},
);
my @dbAckNack = (
{ name => 'trigger_satisfied1',
type => '1I',
key => 'TRIGSATF',
null => -1,
},
{ name => 'rate_score1',
type => '1E',
key => 'RATESCOR',
},
{ name => 'rate_score_snr1',
type => '1E',
key => 'RATESNR',
},
{ name => 'image_trigger',
type => '1A',
key => 'IMAGETRG',
},
{ name => 'catalog_source',
type => '1A',
key => 'CATSRC',
},
{ name => 'source_interested',
type => '1A',
key => 'INTEREST',
},
{ name => 'point_source',
type => '1A',
key => 'POINTSRC',
},
{ name => 'source_is_grb',
type => '1A',
key => 'GRBDETEC',
},
{ name => 'bat_theta',
type => '1D',
unit => 'degree',
key => 'BATTHETA',
disp => 'F10.5',
},
{ name => 'bat_phi',
type => '1D',
unit => 'degree',
key => 'BATPHI',
disp => 'F10.5',
},
{ name => 'bat_peak_rate',
type => '1D',
key => 'PEAKRATE',
},
{ name => 'bat_tot_counts',
type => '1J',
key => 'TOTCOUNT',
null => -1,
},
{ name => 'bat_back_counts',
type => '1J',
key => 'BACKCONT',
null => -1,
},
{ name => 'bat_net_counts',
type => '1J',
key => 'NETCOUNT',
null => -1,
},
{ name => 'bat_trigger_stop',
type => '1D',
key => 'TRIGSTOP',
},
{ name => 'image_significance',
type => '1E',
key => 'IMGSNR',
},
{ name => 'source_exposure',
type => '1E',
key => 'FOREXPO',
unit => 's',
},
{ name => 'back_exposure',
type => '1E',
key => 'BACKEXPO',
unit => 's',
},
);
my @dbFOM = (
{ name => 'new_at',
type => '1A',
key => 'NEWFOMAT',
},
{ name => 'fom_observe',
type => '1A',
key => 'FOM2OBS',
},
{ name => 'merit',
type => '1A',
key => 'FOMMERIT',
},
);
my @dbFOSC = (
{ name => 'pnt_ra',
type => '1D',
unit => 'degree',
key => 'RA_PNT',
disp => 'F10.5',
},
{ name => 'pnt_dec',
type => '1D',
unit => 'degree',
key => 'DEC_PNT',
disp => 'F10.5',
},
{ name => 'pnt_roll',
type => '1D',
unit => 'degree',
key => 'PA_PNT',
disp => 'F10.5',
},
{ name => 'sc_observe',
type => '1A',
key => 'SCREPLY',
},
{ name => 'wait_time',
type => '1D',
unit => 's',
key => 'WAITSEC',
},
{ name => 'wait_constraint',
type => '1D',
unit => 's',
key => 'PREDSEC',
},
);
my @dbXRTPosition = (
{ name => 'xrt_ra',
type => '1D',
disp => 'F10.5',
unit => 'degree',
key => 'XRA_OBJ',
},
{ name => 'xrt_dec',
type => '1D',
disp => 'F10.5',
unit => 'degree',
key => 'XDEC_OBJ',
},
{ name => 'rate_dn',
type => '1E',
key => 'RATEDN',
},
);
my @dbXRTImage = (
# XRT image
{ name => 'xrt_flux',
type => '1D',
key => 'FLUX',
},
{ name => 'rate_dn1',
type => '1E',
key => 'RATEDN',
},
{ name => 'xrt_exposure',
type => '1D',
unit => 's',
key => 'EXPOSURE',
},
{ name => 'xrt_pos_err',
type => '1D',
key => 'ERRCTRD',
},
{ name => 'xrt_dn',
type => '1D',
key => 'DN',
},
);
# this collects all the groups together
my @db = (
{ name => 'target_id',
type => '1J',
disp => 'I8',
null => -1,
},
{ name => 'obs_segment',
type => '1J',
disp => 'I3',
null => -1,
},
{ name => 'obs_number',
type => '11A',
},
{ name => 'ra',
type => '1D',
disp => 'F10.5',
unit => 'degree',
},
{ name => 'dec',
type => '1D',
disp => 'F10.5',
unit => 'degree',
},
{ name => 'pos_flag',
type => '1I',
null => -1,
},
{ name => 'time',
type => '24A',
},
{ name => 'time_seconds',
type => '1D',
unit => 's',
},
@dbAlert,
{ name => 'time1',
type => '24A',
},
{ name => 'time_seconds1',
type => '1D',
unit => 's',
},
@dbAckNack,
@dbFOM,
@dbFOSC,
@dbXRTPosition,
{ name => 'xrt_time',
type => '24A',
},
@dbXRTImage,
# pipeline
{ name => 'processing_date',
type => '24A',
},
{ name => 'processing_version',
type => '40A',
},
{ name => 'num_processed',
type => '1I',
null => -1,
},
);
my $db = Util::FITStable->new(\@db,
log => $log,
which => 'tdrss',
);
my $headfile = 'tdrss_head.tmp';
my $create = Util::Ftool->new('fimgcreate')
->params({bitpix => 8,
naxes => '0',
datafile => 'none',
headfile => $headfile,
clobber => 'yes'});
my $append = Util::Ftool->new('fappend')
->params({pkeywds => 'yes'});
my $now = Util::Date->new();
foreach my $id (keys %obsids) {
################################################
# Make an index file for each tdrss observation
################################################
open HEAD, ">$headfile";
print HEAD "OBS_ID=$id / Observation ID\n";
print HEAD "DATE = ", $now->date(), 'T', $now->time(), "\n";
close HEAD;
$log->entry("Processing obs $id");
my $other_file = $jobpar->read('mission').$id.'mssdi.fits';
$create->params({outfile => $other_file})
->run();
$append->params({outfile => $other_file});
foreach my $type (@tdrss_types){
my @files = grep /${id}.*\.fits$/, $filename->any($type);
foreach my $file (grep !/ms.${burst_grep}.*\.fits$/, @files){
$log->entry("Appending file $file to $other_file.");
$append->params({infile => $file .'[0]'})
->run();
unlink $file;
}
}
my $other_fits = Util::FITSfile->new($other_file);
my $nhdus = $other_fits->nhdus();
if( $nhdus > 1 ){
my $tstart = 1.E10;
for(my $i=1; $i<$nhdus; $i++){
$other_fits->ext($i);
$other_fits->keyword('EXTNAME', $other_fits->keyword('MESGNAME'));
my $start = $other_fits->keyword('TSTART');
$start = $other_fits->keyword('TRIGTIME')
unless $start;
$tstart = $start
if ( $start && $start < $tstart );
}
$tstart = $jobpar->read('tstart')
unless $tstart < 1.E10;
my $first = Util::Date->new($tstart);
$other_fits->ext(0);
# $other_fits->keyword('TSTART', $tstart);
$other_fits->keyword('DATE-OBS', $first->date().'T'.$first->time() );
}else{
unlink $other_file;
}
#####################################################
# Get the keyword lists needed for the tdrss db file
#####################################################
my %alert_keys;
my $file = ( grep /${id}/, $filename->get('tdmess', 'bat', 'al', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%alert_keys = $fits->keywords();
}
my %ack_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'bat', 'ce', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%ack_keys = $fits->keywords();
}
my %nack_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'bat', 'no', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%nack_keys = $fits->keywords();
}
my %xce_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'xrt', 'ce', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%xce_keys = $fits->keywords();
}
my %xno_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'xrt', 'no', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%xno_keys = $fits->keywords();
}
my %xim_keys;
$file = ( grep /${id}/, $filename->get('tdimage', 'xrt', '', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%xim_keys = $fits->keywords();
}
my %fom_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'fom', 'ap', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%fom_keys = $fits->keywords();
}
my %fosc_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'swift', 'ap', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%fosc_keys = $fits->keywords();
}
my %all_keys = (%alert_keys, %ack_keys, %nack_keys, %xce_keys, %xno_keys, %xim_keys, %fom_keys, %fosc_keys);
#############################
# No keywords, no tdrss.
#############################
next unless %all_keys;
my $ref_file = $jobpar->read('mission').$id.'mspob.cat';
$log->entry("Make trdss ref file $ref_file.");
$create->params({outfile => $ref_file})
->run();
my $tdref = Util::FITSfile->new($ref_file, 0);
################################################
# Compile the data needed for the tdrss db file
################################################
# observation
{
$db->set(target_id => "'" . substr($id, 0, 8) . "'");
$db->set(obs_segment => "'" . substr($id, 8, 3) . "'");
$db->set(obs_number => "'$id'");
}
{
my ($ra, $dec, $posFlag);
# TODO: should this really be defined instead of boolean context?
if ($xce_keys{RA} && $xce_keys{DEC} ){
$ra = $xce_keys{RA};
$dec = $xce_keys{DEC};
$posFlag = 2;
}
else {
$ra = $ack_keys{BRA_OBJ} || 'INDEF';
$dec = $ack_keys{BDEC_OBJ} || 'INDEF';
$posFlag = ($ack_keys{BRA_OBJ} && $ack_keys{BDEC_OBJ}) ? 1 : 0;
}
$db->set(ra => $ra);
$db->set(dec => $dec);
$db->set(pos_flag => $posFlag);
}
{
#########################################################
# Take this opportunity to fill in the DATE_OBS keyword
# in the tdrss reference file
#########################################################
my ($time, $timeSeconds, $Ttime);
unless( $alert_keys{TRIGTIME} && $alert_keys{UTCCTIME} ) {
$time = 'INDEF';
$timeSeconds = 'INDEF';
$Ttime = dbTimeString( $all_keys{'PKTTIME'} );
} else {
$timeSeconds = $alert_keys{TRIGTIME} + $alert_keys{UTCCTIME};
$time = $Ttime = dbTimeString($timeSeconds);
}
$Ttime =~ s/ /T/;
$tdref->keyword('DATE-OBS', $Ttime);
$db->set(time => $time);
$db->set(time_seconds => $timeSeconds);
}
foreach my $e (@dbAlert) {
$db->set($e->{name} => \%ack_keys);
}
###############################################################
# Use ack or nack keywords, depending on which message we have
###############################################################
my %ack_nack_keys = $ack_keys{DATE} ? %ack_keys : %nack_keys;
{
my ($time1, $timeSeconds1);
unless ($ack_nack_keys{TRIGTIME} && $ack_nack_keys{UTCCTIME}) {
$time1 = 'INDEF';
$timeSeconds1 = 'INDEF';
} else {
$timeSeconds1 = $ack_nack_keys{TRIGTIME} + $ack_nack_keys{UTCCTIME};
$time1 = dbTimeString($timeSeconds1);
}
$db->set(time1 => $time1);
$db->set(time_seconds1 => $timeSeconds1);
}
foreach my $e (@dbAckNack) {
$db->set($e->{name} => \%ack_nack_keys);
}
########################################################################
# FOM
########################################################################
foreach my $e (@dbFOM) {
$db->set($e->{name} => \%fom_keys);
}
foreach my $e (@dbFOSC) {
$db->set($e->{name} => \%fosc_keys);
}
########################################################################
# XRT position
########################################################################
foreach my $e (@dbXRTPosition) {
$db->set($e->{name} => \%xce_keys);
}
{
my $time;
unless($xce_keys{FRAMTIME} && $xce_keys{UTCCTIME}) {
$time = 'INDEF';
}
else {
$time = dbTimeString($xce_keys{FRAMTIME} + $xce_keys{UTCCTIME});
}
$db->set(xrt_time => $time);
}
########################################################################
# XRT image
########################################################################
foreach my $e (@dbXRTImage) {
$db->set($e->{name} => \%xim_keys);
}
$db->set(processing_date => Util::Date->new->date);
$db->set(processing_version => $procpar->read('version'));
$db->set(num_processed => int($jobpar->read('seqprocnum')));
my $outfile = $filename->get('tddb', 'proc', '', 0);
$db->write($outfile);
}
unlink($headfile);
} # end of body method