package Subs::ExtractTiming;
##############################################################################
#
# DESCRIPTION:
#
# HISTORY:
# HISTORY: $Log: ExtractTiming.pm,v $
# HISTORY: Revision 1.12 2005/03/15 20:02:59 apsop
# HISTORY: Fix bug in call for getting sc eng hk file name. Remove columns for which UTCF value is set to zero.
# HISTORY:
# HISTORY: Revision 1.12 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.11 2004/11/02 21:17:49 apsop
# HISTORY: Write DATE keyword into timing file.
# HISTORY:
# HISTORY: Revision 1.10 2004/10/25 14:50:01 apsop
# HISTORY: Write standard timing keywords into timing file.
# HISTORY:
# HISTORY: Revision 1.9 2004/08/13 15:41:06 apsop
# HISTORY: Fix to algorithm for thinning time info extensions.
# HISTORY:
# HISTORY: Revision 1.8 2004/07/23 19:50:10 apsop
# HISTORY: Increase allowed string length for deleting rows to 511.
# HISTORY:
# HISTORY: Revision 1.7 2004/07/19 16:00:37 apsop
# HISTORY: Check if string for deleting rows in timing file is too long.
# HISTORY:
# HISTORY: Revision 1.6 2004/07/11 20:39:38 apsop
# HISTORY: Lots of changes to account for bugs in first version
# HISTORY:
# HISTORY: Revision 1.5 2004/06/11 19:51:08 apsop
# HISTORY: Handle case where there are 3 or less attitude entries
# HISTORY:
# HISTORY: Revision 1.4 2004/06/08 00:08:20 apsop
# HISTORY: Fix for handling case with no attitude info.
# HISTORY:
# HISTORY: Revision 1.3 2004/06/07 17:01:27 apsop
# HISTORY: Use ftmerge over fmerge, cause it does not have a file number limit.
# HISTORY:
# HISTORY: Revision 1.2 2004/05/28 19:40:57 apsop
# HISTORY: Bug fixes and enhancement to make first working version
# HISTORY:
# HISTORY: Revision 1.1 2004/05/06 20:02:25 dah
# HISTORY: New module to extract timing info (like UTCF) from the telemetry.
# HISTORY:
# HISTORY:
#
# VERSION: 0.0
#
#
##############################################################################
use Subs::Sub;
@ISA = ("Subs::Sub");
use strict;
sub new {
my $proto=shift;
my $self=$proto->SUPER::new();
$self->{DESCRIPTION}="Extracting Timing Information from Telemetry";
return $self;
}
##################
# METHODS:
##################
sub body {
my $self=shift;
my $log =$self->log();
my $filename=$self->filename();
my $procpar =$self->procpar();
my $jobpar =$self->jobpar();
########################################################
# Extract UTC adjustment parameters from the hk data
########################################################
my $params_tmp = 'utcf_params.tmp';
my $tmp_file = 'time_files.tmp';
my $schk = $filename->get('scenhk', 'swift', '', 0);
if( -f $schk ){
my $specs = "[col EXTNAME='UTCF_PARAMS'; " .
'TIME; ENABLED_A = (INT)(SUDLUPSTAT1_A/2**14)%2==1;' .
'ENABLED_B = (INT)(SUDLUPSTAT1_B/2**14)%2==1;' .
'DIRECTION_A = (INT)(SUDLUPSTAT1_A/2**13)%2==1;' .
'DIRECTION_B = (INT)(SUDLUPSTAT1_B/2**13)%2==1;' .
' INTERVAL == SUDLADJINTCNT]';
my $fstruct = Util::Ftool->new("fstruct")
->verbose(1)
->params({infile => $schk,
outfile => 'STDOUT',
colinfo => 'no'})
->run();
my @hdus = $fstruct->stdout() =~ /(hk00[\d,a-c]x00\d)/gs;
if(@hdus){
open TMP, ">$tmp_file";
foreach (@hdus){
print TMP $schk . "\[$_\]" . $specs, "\n";
}
close TMP;
$log->entry('Extract utcf parameters from house keeping: '. join(' ',@hdus));
Util::HEAdas->new('ftmerge')
->params({infile => '@'.$tmp_file,
outfile => $params_tmp})
->run();
unlink $tmp_file;
}
}
##############################################################
# Extract the value of UTCF as a function of MET from LPD and
# teriary header files
##############################################################
my $extract = Util::Tool->new($procpar->read('fitspackets'), 'extract_utcf');
my $i = 0;
my $utcf_file = $filename->get('timedata', 'swift', '', 0);
open TMP, ">$tmp_file";
my @cpio_apid = (299, 417, 481, 484, 568, 570);
foreach my $tel_file ( $filename->get('telemetry', '*', 'ldp', '*'),
$filename->get('telemetry', '*', 'head3', '*') ){
my ($inst, $mode, $apid) = $filename->parse($tel_file, 'telemetry');
next if grep $_==$apid, @cpio_apid;
my $tmp_utcf = 'utcf_' . ++$i . '.tmp';
$log->entry("Extracting UTCF values from file $tel_file.");
$extract->command_line("-infile $tel_file",
"-apid_list /aps/lists/swift_apids.list",
"-outfile $tmp_utcf")
->run();
print TMP $tmp_utcf."[1][UTCF > 1E-9]\n" unless $extract->had_error();
}
close TMP;
if($i){
Util::HEAdas->new('ftmerge')
->params({infile => '@'.$tmp_file,
outfile => $utcf_file})
->run();
unlink glob('utcf_[0-9]*.tmp'), $tmp_file;
if( -f $params_tmp ){
$log->entry('Appending utcf parameters extension to timing file.');
Util::FITSfile->new($params_tmp, 'UTCF_PARAMS')
->append_to($utcf_file);
unlink $params_tmp;
}
######################################################################
# Trim the tables so that only the rows where changes occur are kept.
# Always keep the first and last row.
######################################################################
my $now = Util::Date->new();
my $Tnow = $now->date() .'T'. $now->time();
my $utcf_fits = Util::FITSfile->new($utcf_file, 0);
$utcf_fits->keyword('DATE', $Tnow);
$utcf_fits->ext(1);
my @redundant;
my $delrow = Util::HEAdas->new('ftdelrow')
->params({outfile => 'none',
confirm => 'yes',
chatter => 0});
$utcf_fits->begin_many_keywords();
$utcf_fits->keyword('DATE', $Tnow);
$utcf_fits->keyword('EXTNAME', 'UTCF');
$utcf_fits->keyword('TIMESYS', 'TT', 'time measured from');
$utcf_fits->keyword('MJDREFI', 51910, 'MJD reference day');
$utcf_fits->keyword('MJDREFF', 7.428703700000000E-04,
'MJD reference (fraction of day)');
$utcf_fits->keyword('CLOCKAPP', 'F', 'default');
$utcf_fits->keyword('TIMEUNIT', 's', 'unit for time keywords');
my $irow;
my $nrows = $utcf_fits->nrows()-1;
if($nrows>1){
$utcf_fits->cols('TIME')->sort();
my @utcf_val = $utcf_fits->cols('UTCF')->table();
for($irow=1; $irow < $nrows; $irow++){
push (@redundant, $irow+1)
if ($utcf_val[$irow]==$utcf_val[$irow-1] && $utcf_val[$irow]==$utcf_val[$irow+1]);
}
if(@redundant){
my $line = shift @redundant;
my $last = $line;
foreach $irow (@redundant){
$line .= "-$last,$irow"
if $last+1!=$irow;
$last = $irow;
}
$line .= '-'. $redundant[-1] if @redundant;
if( length($line) < 511 ){
$log->entry("Deleting redundant rows $line from UTCF extension.");
$delrow->params({infile => $utcf_fits->fullname(),
rows => $line})
->run();
}else{
$log->entry('String for deleting rows from UTCF extension too long (' .
length($line) . '). No rows will be deleted.');
}
}
my @time_val = $utcf_fits->cols('TIME')->table();
$utcf_fits->keyword('TSTART', $time_val[0]);
$utcf_fits->keyword('TSTOP', $time_val[-1]);
$utcf_fits->end_many_keywords();
}
if( $utcf_fits->nhdus() > 2 ){
$utcf_fits->ext(2);
$utcf_fits->begin_many_keywords();
$utcf_fits->keyword('DATE', $Tnow);
$utcf_fits->keyword('TIMESYS', 'TT', 'time measured from');
$utcf_fits->keyword('MJDREFI', 51910, 'MJD reference day');
$utcf_fits->keyword('MJDREFF', 7.428703700000000E-04,
'MJD reference (fraction of day)');
$utcf_fits->keyword('CLOCKAPP', 'F', 'default');
$utcf_fits->keyword('TIMEUNIT', 's', 'unit for time keywords');
##########################################################################
# The TSCALE keyword results in the wrong format for the INTERVAL column
# so delete it if it has the default value
##########################################################################
my $tscal2 = $utcf_fits->keyword('TSCAL2');
if( $tscal2 && $tscal2 == 1 ){
Util::HEAdas->new('fthedit')
->params({infile => $utcf_fits->fullname(),
keyword => 'TSCAL2',
operation => 'delete'})
->run();
}
$nrows = $utcf_fits->nrows()-1;
if($nrows>1){
$utcf_fits->cols('TIME')->sort();
my @interval = $utcf_fits->cols('INTERVAL')->table();
my @enable_a = $utcf_fits->cols('ENABLED_A')->table();
my @enable_b = $utcf_fits->cols('ENABLED_B')->table();
my @direct_a = $utcf_fits->cols('DIRECTION_A')->table();
my @direct_b = $utcf_fits->cols('DIRECTION_B')->table();
@redundant = ();
for($irow=1; $irow < $nrows; $irow++){
push (@redundant, $irow+1)
if( $interval[$irow]==$interval[$irow-1] &&
$interval[$irow]==$interval[$irow+1] &&
$enable_a[$irow] eq $enable_a[$irow-1] &&
$enable_b[$irow] eq $enable_b[$irow-1] &&
$direct_a[$irow] eq $direct_a[$irow-1] &&
$direct_b[$irow] eq $direct_b[$irow-1] );
}
if(@redundant){
my $line = shift @redundant;
my $last = $line;
foreach $irow (@redundant){
$line .= "-$last,$irow"
if $last+1!=$irow;
$last = $irow;
}
$line .= '-'. $redundant[-1] if @redundant;
if( length($line) < 511 ){
$log->entry("Deleting redundant rows $line from UTCF_PARAMS extension.");
$delrow->params({infile => $utcf_fits->fullname(),
rows => $line})
->run();
}else{
$log->entry('String for deleting rows from UTCF_PARAMS extension too long (' .
length($line) . '). No rows will be deleted.');
}
}
}
my @time_val = $utcf_fits->cols('TIME')->table();
$utcf_fits->keyword('TSTART', $time_val[0]);
$utcf_fits->keyword('TSTOP', $time_val[-1]);
$utcf_fits->end_many_keywords();
}
}else{
unlink $params_tmp if -f $params_tmp;
unlink $tmp_file if -f $tmp_file;
}
}
1;