package Subs::XRTDB;
##############################################################################
#
# DESCRIPTION:
#
# HISTORY:
# HISTORY: $Log: XRTDB.pm,v $
# HISTORY: Revision 1.11 2007/03/23 13:08:52 apsop
# HISTORY: Add support for new xrt modes.
# HISTORY:
# HISTORY: Revision 1.10 2006/04/28 18:45:39 apsop
# HISTORY: Fix problem with too many warning messages from empty LOWRATE exposures.
# HISTORY:
# HISTORY: Revision 1.9 2006/04/26 20:47:05 apsop
# HISTORY: Better reporting for exposures with no event file.
# HISTORY:
# HISTORY: Revision 1.8 2006/04/24 13:28:33 apsop
# HISTORY: Skip entries with no lowrate event list. All for either INDEF or NULL values returned from FITSfile class.
# HISTORY:
# HISTORY: Revision 1.7 2006/02/13 18:25:50 apsop
# HISTORY: Workaround problem when more than one event file is select for and exposure. Needs more permanent, accurate fix.
# HISTORY:
# HISTORY: Revision 1.6 2005/12/19 16:27:27 apsop
# HISTORY: Put quotes around object names so as not to confuse fcreate.
# HISTORY:
# HISTORY: Revision 1.5 2005/12/19 16:25:40 apsop
# HISTORY: Fix bug in flip-flop algo when testing for non-flip modes.
# HISTORY:
# HISTORY: Revision 1.4 2005/11/08 20:04:23 apsop
# HISTORY: <Previous comment bogus>Lots of changes for calculating flip-flop intervals, and other changes.
# HISTORY:
# HISTORY: Revision 1.3 2005/11/08 19:22:28 apsop
# HISTORY: Populate the TIMELIST and DATALIST hashes. Used to be an SWCheckInput.
# HISTORY:
# HISTORY: Revision 1.2 2005/08/30 14:18:10 apsop
# HISTORY: First production version.
# HISTORY:
# HISTORY:
#
# VERSION: 0.0
#
#
##############################################################################
use strict;
use Subs::Sub;
our @ISA = ("Subs::Sub");
use Carp;
use Data::Dumper;
$Data::Dumper::Indent = 3;
use Astro::FITS::CFITSIO qw(:constants);
use Util::Date;
use Util::FITStable;
use Util::SimpleFITS;
sub new
{
my($proto) = shift;
my($self) = $proto->SUPER::new;
$self->{DESCRIPTION} = 'Extracting data for XRT exposure database.';
return $self;
}
sub body
{
# Save arguments.
my($self) = shift;
# Get the helper objects.
my($log) = $self->log or croak('No log object!');
my($filename) = $self->filename or croak('No filename object!');
my($procpar) = $self->procpar or croak('No procpar object!');
my($jobpar) = $self->jobpar or croak('No jobpar object!');
my $SLEW_GAP = 15;
my $FLIP_END_NUM = 11;
my @NOFLIP_MODES = (2, 3, 8, 9);
my @MODE_NAMES = (undef, undef, 'SHORTIMA', 'LONGIMA', 'PILEDUP',
'LOWRATE', 'WINDOWED', 'PHOTON', 'RAWIMA', 'BIASIMA');
my %WAVE_MODES = ( PILEDUP => { 80 => 'REFRESHPCP',
81 => 'PHOTONP',
82 => 'WINDOWEDP'},
LOWRATE => { 80 => 'REFRESHPCL',
81 => 'PHOTONL',
82 => 'WINDOWEDL'}
);
# Set up FITS column descriptions of the fields that make up the
# exposure database record.
my(@db) =
(
{
name => 'name',
type => '80A',
},
{
name => 'orig_target_id',
type => '1J',
},
{
name => 'target_id',
type => '1J',
},
{
name => 'ra',
type => '1D',
},
{
name => 'dec',
type => '1D',
},
{
name => 'roll_angle',
type => '1D',
},
{
name => 'start_time',
type => '22A',
},
{
name => 'stop_time',
type => '22A',
},
{
name => 'orig_obs_segment',
type => '1I',
},
{
name => 'obs_segment',
type => '1I',
},
{
name => 'orig_obsid',
type => '11A',
},
{
name => 'obsid',
type => '11A',
},
{
name => 'exposure',
type => '1D',
},
{
name => 'integration_time',
type => '1D',
},
{
name => 'window_size',
type => '9A',
},
{
name => 'ccdtemp',
type => '1D',
},
{
name => 'bias',
type => '3A',
},
{
name => 'operation_mode',
type => '10A',
},
{
name => 'pointing_mode',
type => '8A',
},
{
name => 'filename',
type => '80A',
},
{
name => 'flipflop',
type => '3A',
}
);
# print 'db = ', Dumper \@db;
#--------------------------------------------------------------------------
# Create a new FITS file for the exposure database records.
my($db) = Util::FITStable->new(\@db, log => $log, which => 'xrt');
if (not $db) {
$log->entry('Unable to create FITStable object!');
return;
}
# Compute the path to the required XRT housekeeping file.
my($hk_path) = $filename->get('hk', 'xrt', 'hd');
$log->entry("hk_path = $hk_path");
if (not $hk_path or not -f $hk_path) {
$log->entry("Unable to locate XRT HK file $hk_path");
return;
}
# Open the XRT HK file.
my($xrt_hk) = Util::SimpleFITS->open("<$hk_path");
if (not $xrt_hk) {
$log->error(2, "Undefined SimpleFITS object for XRT HK file $hk_path");
return;
}
my($status) = $xrt_hk->status;
if ($status) {
$log->error(2, "Unable to open XRT HK file $hk_path [$status]");
return;
}
# Move to the FRAME extension.
$xrt_hk->move('FRAME');
if ($xrt_hk->status) {
$log->error(2, "Unable to move to FRAME extension in $hk_path");
return;
}
# Fetch the number of frames in the housekeeping file.
my($num_frames);
$xrt_hk->handle->get_num_rows($num_frames, $status);
$log->entry("num_frames = $num_frames");
if ($num_frames < 1) {
$log->error(2, "No frames in XRT HK file $hk_path!");
return;
}
#--------------------------------------------------------------------------
# Extract required data from the job parameter file.
# All records are for the same object.
my($object) = $jobpar->read('object');
$log->entry("object = $object");
if (not $object) {
$log->error(2, 'No object in jobpar!');
return;
}
# All records are for the same original target.
my($target) = $jobpar->read('target');
$log->entry("target = $target");
if (not $target) {
$log->error(2, 'No target in jobpar!');
return;
}
my($obs) = $jobpar->read('obs');
$log->entry("obs = $obs");
if (not $obs) {
$log->error(2, 'No obs in jobpar!');
return;
}
# All records are for the same final target.
my($sequence) = $jobpar->read('sequence');
$log->entry("sequence = $sequence");
if (not $sequence) {
$log->error(2, 'No sequence in jobpar!');
return;
}
my($target_id) = substr($sequence, 0, 8);
$log->entry("target_id = $target_id");
if (not $target_id) {
$log->error(2, 'Unable to compute target ID from sequence ' .
"$sequence!");
return;
}
# Extract the observation segment from the sequence.
my($segment) = substr($sequence, 8);
$log->entry("segment = $segment");
if (not defined $segment) {
$log->error(2, 'Unable to compute segment from sequence ' .
"$sequence!");
return;
}
# Fetch the target RA, DEC, and roll.
my($ra) = $jobpar->read('ra');
$log->entry("ra = $ra");
if (not defined $ra) {
$log->error(2, 'Undefined ra from jobpar!');
return;
}
my($dec) = $jobpar->read('dec');
$log->entry("dec = $dec");
if (not defined $dec) {
$log->error(2, 'Undefined dec from jobpar!');
return;
}
my($roll) = $jobpar->read('roll');
$log->entry("roll = $roll");
if (not defined $roll) {
$log->error(2, 'Undefined roll from jobpar!');
return;
}
#--------------------------------------------------------------------------
# Fetch required data from the frame data in the XRT housekeeping
# file.
# Fetch the XRTMode column to begin determination of the start and
# end of each frame set.
my(@XRTMode);
$status = $xrt_hk->readcol('XRTMode' => TBYTE, [], \@XRTMode);
# print 'XRTMode = ', Dumper \@XRTMode;
if (not $status) {
$log->error(2, 'Unable to fetch XRTMode column!');
return;
}
# Fetch the Settled column, which is used to determine the
# satellite observation mode.
my(@Settled);
$status = $xrt_hk->readcol('Settled' => TBYTE, [], \@Settled);
# print 'Settled = ', Dumper \@Settled;
if (not $status) {
$log->error(2, 'Unable to fetch Settled column!');
return;
}
# Fetch the In10Arcm column, which is used to determine the
# satellite observation mode.
my(@In10Arcm);
$status = $xrt_hk->readcol('In10Arcm' => TBYTE, [], \@In10Arcm);
# print 'In10Arcm = ', \@In10Arcm;
if (not $status) {
$log->error(2, 'Unable to fetch In10Arcm column!');
return;
}
# Fetch the TIME column (seconds of the frame start time).
my(@TIME);
$status = $xrt_hk->readcol('TIME' => TDOUBLE, [], \@TIME);
# print 'FSTS = ', Dumper \@FSTS;
if (not $status) {
$log->error(2, 'Unable to fetch TIME column!');
return;
}
# Fetch the ENDTIME column (seconds of the frame end time).
my(@ENDTIME);
$status = $xrt_hk->readcol('ENDTIME' => TDOUBLE, [], \@ENDTIME);
# print 'FETS = ', Dumper \@FETS;
if (not $status) {
$log->error(2, 'Unable to fetch ENDTIME column!');
return;
}
# Fetch the PDBIASLEVEL column (a small double-precision value).
my(@PDBIASLVL);
$status = $xrt_hk->readcol('PDBIASLVL' => TDOUBLE, [], \@PDBIASLVL);
# print 'PDBIASLVL = ', Dumper \@PDBIASLVL;
if (not $status) {
$log->error(2, 'Unable to fetch PDBIASLVL column!');
return;
}
# Fetch the IMBLvl column (a small double-precision value).
my(@IMBLvl);
$status = $xrt_hk->readcol('IMBLvl' => TDOUBLE, [], \@IMBLvl);
# print 'IMBLvl = ', Dumper \IMBLvl;
if (not $status) {
$log->error(2, 'Unable to fetch IMBLvl column!');
return;
}
# Fetch the WinHalfW column (window half-width).
my(@WinHalfW);
$status = $xrt_hk->readcol('WinHalfW' => TINT, [], \@WinHalfW);
# print 'WinHalfW = ', Dumper \@WinHalfW;
if (not $status) {
$log->error(2, 'Unable to fetch WinHalfW column!');
return;
}
# Fetch the WinHalfH column (window half-height).
my(@WinHalfH);
$status = $xrt_hk->readcol('WinHalfH' => TINT, [], \@WinHalfH);
# print 'WinHalfH = ', Dumper \@WinHalfH;
if (not $status) {
$log->error(2, 'Unable to fetch WinHalfH column!');
return;
}
# Fetch the telemRow column (telemetry row count in image modes).
my(@telemRow);
$status = $xrt_hk->readcol('telemRow' => TINT, [], \@telemRow);
# print 'telemRow = ', Dumper \@telemRow;
if (not $status) {
$log->error(2, 'Unable to fetch telemRow column!');
return;
}
# Fetch the telemCol column (telemetry column count in image
# modes).
my(@telemCol);
$status = $xrt_hk->readcol('telemCol' => TINT, [], \@telemCol);
# print 'telemCol = ', Dumper \@telemCol;
if (not $status) {
$log->error(2, 'Unable to fetch telemCol column!');
return;
}
# Fetch the WaveID column (CCD waveform ID).
my(@WaveID);
$status = $xrt_hk->readcol('WaveID' => TBYTE, [], \@WaveID);
# print 'WaveID = ', Dumper \@WaveID;
if (not $status) {
$log->error(2, 'Unable to fetch WaveID column!');
return;
}
# Fetch the CCDTemp column (CCD temperature in degrees Celsius
# during the frame).
my(@CCDTemp);
$status = $xrt_hk->readcol('CCDTemp' => TFLOAT, [], \@CCDTemp);
# print 'CCDTemp = ', Dumper \@CCDTemp;
if (not $status) {
$log->error(2, 'Unable to fetch CCDTemp column!');
return;
}
####################################################
# Remove the last from from consideration if it has
# unknown mode
####################################################
$num_frames-- if $XRTMode[$num_frames-1]==0;
####################################################
# Determine the event file for each frame, based on
# the mode
####################################################
my(@evt_path, @win_map, @timedel, @gti_starts, @gti_stops, $keyword, @frame_exp);
$win_map[6] = { 50 => 'w1',
100 => 'w2',
150 => 'w3',
200 => 'w4',
250 => 'w5' };
$win_map[7] = { 245 => 'w1',
250 => 'w2',
300 => 'w3',
240 => 'w4' };
my @warnings;
my $prev_paths = " ";
for (my $f = 0; $f < $num_frames; $f++) {
my $mode =$XRTMode[$f];
my $path;
if($mode >= 2){
my $mode_name = (undef, undef, 'im', 'im', 'pu', 'lr', 'wt', 'pc', '', '')[$mode];
if($mode == 6 || $mode == 7){
my $win_name = $win_map[$mode]->{$WinHalfW[$f]};
$mode_name .= $win_name ? $win_name : 'w?';
}elsif($mode == 4 || $mode == 5){
if( $WaveID[$f] >= 80 && $WaveID[$f] <= 82 ){
my $sub_mode = ('r', 'p', 'w')[$WaveID[$f]-80];
$mode_name = $sub_mode . substr($mode_name,0,1);
}
if ($PDBIASLVL[$f]) {
$mode_name .= 'b1';
} else {
$mode_name .= 'b0';
}
}
if($mode >= 4 && $mode <= 7){
if ($Settled[$f]) {
$mode_name .= 'po';
} elsif ($In10Arcm[$f]) {
$mode_name .= 'st';
} else {
$mode_name .= 'sl';
}
}
my $type = (undef, undef, 'rawimage', 'rawimage',
'unfiltered', 'unfiltered', 'unfiltered', 'unfiltered',
'xrawmode', 'xbiasmode')[$mode];
# $log->entry("mode_name: $mode_name type: $type");
my @paths = $filename->get($type, 'xrt', $mode_name, '*');
if(@paths > 1){
my $curr_paths = join(' ', @paths);
if($curr_paths ne $prev_paths){
$log->error(1, "More than one event file found for mode $mode_name: " . $curr_paths);
$prev_paths = $curr_paths;
}
}
if(@paths == 0){
push @warnings, "No event file found for mode $mode_name";
}
$path = $paths[0];
}
#########################################################
# Fetch required data from the header of the event file.
#########################################################
$timedel[$f] = 'INDEF';
if( $path ){
my($xrt_file) = Util::SimpleFITS->open( '<'.$path );
$status = $xrt_file->status;
if (not $xrt_file or $status) {
$log->error(1, "Unable to open XRT file $path [$status], " .
'skipping fetch of integration time (TIMEDEL).');
}else{
my $mode = $XRTMode[$f];
unless( grep($mode==$_, (2,3,8,9)) ){
$xrt_file->move('EVENTS');
unless($xrt_file->status){
$xrt_file->handle->read_keyword('TIMEDEL', $timedel[$f], $keyword,
$status);
$timedel[$f] = 'INDEF' if $status;
}
}
}
}else{
$path = 'INDEF';
}
$evt_path[$f] = $path;
}
# $log->entry('evt_path = '. Dumper \@evt_path);
# $log->entry('timedel = '. Dumper \@timedel);
#--------------------------------------------------------------------------
# Compute dynamic values.
# Compute the XRT mode string for each frame.
my(@XRTMode_string);
for (my $f = 0; $f < $num_frames; $f++) {
$XRTMode_string[$f] = $MODE_NAMES[$XRTMode[$f]];
if( defined $XRTMode_string[$f] ){
my $wave_mode = $WAVE_MODES{$XRTMode_string[$f]}{$WaveID[$f]};
$XRTMode_string[$f] = $wave_mode if $wave_mode;
}else{
$XRTMode_string[$f] = 'UNKNOWN';
}
}
# print 'XRTMode_string = ', Dumper \@XRTMode_string;
# Compute the values of the satellite observation mode based on
# the Settled and In10Arcm flags.
my(@ObservationMode);
for (my $f = 0; $f < $num_frames; $f++) {
if ($Settled[$f]) {
$ObservationMode[$f] = 'pointing';
} elsif ($In10Arcm[$f]) {
$ObservationMode[$f] = 'settling';
} else {
$ObservationMode[$f] = 'slewing';
}
}
# print 'ObservationMode = ', Dumper \@ObservationMode;
# Compute the bias setting based on the XRTMode and PDBIASLVL
# columns.
my(@bias) = ('Y') x $num_frames;
for (my $f = 0; $f < $num_frames; $f++) {
if( ($XRTMode[$f] == 4 or $XRTMode[$f] == 5)
and ! $PDBIASLVL[$f] ){
$bias[$f] = 'N';
}elsif( ($XRTMode[$f] == 2 or $XRTMode[$f] == 3)
and ! $IMBLvl[$f] ){
$bias[$f] = 'N';
}elsif($XRTMode[$f] == 8 or $XRTMode[$f] == 9){
$bias[$f] = 'N';
}
}
# print 'bias = ', Dumper \@bias;
# Compute the Window string for each frame.
my(@Window);
for (my $f = 0; $f < $num_frames; $f++) {
if ($XRTMode[$f] == 2 or $XRTMode[$f] == 3 or $XRTMode[$f] == 8) {
$Window[$f] = "${telemRow[$f]}x${telemCol[$f]}";
} elsif ($XRTMode[$f] == 4 or $XRTMode[$f] == 5) {
$Window[$f] = 'NA';
} elsif ($XRTMode[$f] == 6) {
if ($WaveID[$f] == 6) {
$Window[$f] = 100;
} elsif ($WaveID[$f] == 60) {
$Window[$f] = 200;
} elsif ($Window[$f] == 61) {
$Window[$f] = 300;
} elsif ($WaveID[$f] == 62) {
$Window[$f] = 400;
} elsif ($WaveID[$f] == 63) {
$Window[$f] = 500;
} else {
$Window[$f] = 'INDEF';
}
} elsif ($XRTMode[$f] == 7) {
$Window[$f] = 2 * $WinHalfW[$f] . 'x' . 2 * $WinHalfH[$f];
} else {
$Window[$f] = 'INDEF';
}
}
# print 'Window = ', Dumper \@Window;
#--------------------------------------------------------------------------
# First pass: Look for the start of a series of flip-flops. A
# flip-flop series can start at the first frame. The first frame
# in a flip-flop series is the frame _before_ the first
# out-of-the-ordinary frame.
my ($flip_mode, $flip_other) = (-1) x 2;
$log->entry("Identifying flip-flop series start and stop frames.");
my(@flip_flop_start) = (0) x $num_frames;
my(@flip_flop_series_start);
my(@flip_flop_end) = (0) x $num_frames;
my(@flip_flop_series_end);
for (my $f = 0; $f < $num_frames; $f++) {
if($flip_mode == -1){
my $this_mode = $XRTMode[$f];
my $next_mode = $XRTMode[$f+1];
next if (grep /^${this_mode}$/, @NOFLIP_MODES);
next if( $next_mode &&(grep /^${next_mode}$/, @NOFLIP_MODES) );
if ( $f < ($num_frames-2)
and
$this_mode != $next_mode
and
( $this_mode == $XRTMode[$f + 2] or
(defined($XRTMode[$f + 3]) and $this_mode == $XRTMode[$f + 3]) or
(defined($XRTMode[$f + 4]) and $this_mode == $XRTMode[$f + 4]) )
){
# $log->entry("Flip-flop series starting at frame $f.");
$flip_flop_start[$f] = 1;
push(@flip_flop_series_start, $f);
$flip_mode = $this_mode;
$flip_other = $next_mode;
}
}else{
my $ffend=0;
$ffend = 1 if( ( defined($XRTMode[$f + 1]) and
( ($XRTMode[$f + 1] != $flip_mode and $XRTMode[$f + 1] != $flip_other)
or
( $TIME[$f+1] - $ENDTIME[$f] > $SLEW_GAP )
) ) );
unless($ffend){
my $stable_mode = -1;
$stable_mode = $flip_other if $XRTMode[$f] == $flip_mode;
$stable_mode = $flip_mode if $XRTMode[$f] == $flip_other;
if($stable_mode != -1){
$ffend=1;
for(my $i=1; $i <= $FLIP_END_NUM; $i++){
$ffend = $ffend && (!defined($XRTMode[$f+$i]) or $XRTMode[$f+$i] == $stable_mode);
}
}
}
if($ffend){
# $log->entry("Flip-flop series ending at frame $f.");
$flip_flop_end[$f] = 1;
push(@flip_flop_series_end, $f);
$flip_mode = -1;
}
}
}
if($flip_mode != -1){
# $log->entry('Flip-flop series ending at frame '. ($num_frames - 1) );
$flip_flop_end[$num_frames - 1] = 1;
push(@flip_flop_series_end, $num_frames - 1);
}
# $log->entry('flip_flop_start = '. Dumper \@flip_flop_start);
# $log->entry('flip_flop_series_start = '. Dumper \@flip_flop_series_start);
# $log->entry('flip_flop_end = '. Dumper \@flip_flop_end);
# $log->entry('flip_flop_series_end = '. Dumper \@flip_flop_series_end);
# Make sure the starts and ends of flip-flop series match up.
if (@flip_flop_series_start != @flip_flop_series_end) {
$log->error(2, 'Flip-flop series starts and ends do not match up!');
return;
}
# Save the number of flip-flop series.
my($num_flip_flop_series) = scalar(@flip_flop_series_start);
$log->entry("num_flip_flop_series = $num_flip_flop_series");
$log->entry("The following flip-flop series were found:");
for (my $ffs = 0; $ffs < $num_flip_flop_series; $ffs++) {
$log->entry("$flip_flop_series_start[$ffs]\t$flip_flop_series_end[$ffs]");
}
# Create an array of flags which track frames that are part of
# flip-flop series, or ignored for other reasons.
my(@use_frame) = (1) x $num_frames;
# Mask out the flip-flop series frames
$log->entry("Masking out flip-flop series frames.");
for (my $ffs = 0; $ffs < $num_flip_flop_series; $ffs++) {
for (my $f = $flip_flop_series_start[$ffs] + 1;
$f <= $flip_flop_series_end[$ffs]; $f++) {
$use_frame[$f] = 0;
}
}
# Second pass: Determine the indices of the starting frames for
# each frame set. A frame set begins when one of the following
# conditions is met:
# 0) The first frame.
# 1) The XRTMode changes.
# 2) The observation mode changes.
# 3) The window changes.
# 4) The bias changes.
# 5) There is a large time gap between frames
# 6) End of a flip-flop series
# Note that a frame set can consist of a single frame - the start
# and end frame indices will be equal.
$log->entry("Determining start and end frames for frame sets.");
# The first frame set always starts at the first frame.
my(@frame_start) = (0);
my(@frame_end);
$log->entry("First frame set starts at frame 0.");
# Find the start frame for each frame set.
for (my $f = 1; $f < $num_frames; $f++) {
# Skip this frame if it is ignorable.
if (not $use_frame[$f]) {
# $log->entry("Skipping frame $f.");
next;
}
# Does this frame start a new frame set? If so, record it, and
# close the previous frame set.
if ($XRTMode[$f] != $XRTMode[$frame_start[-1]]) {
# XRT mode changed.
$log->entry('Frame set ends at '. ($f - 1) .", new set starts at $f");
$log->entry('Cause: XRTMode change from ' . $XRTMode[$f - 1] .
" to $XRTMode[$f]");
push(@frame_end, $f - 1);
push(@frame_start, $f);
} elsif ($ObservationMode[$f] ne $ObservationMode[$frame_start[-1]]) {
# ObservationMode changed.
$log->entry('Frame set ends at '. ($f - 1) .", new set starts at $f");
$log->entry('Cause: ObservationMode change from ' .
$ObservationMode[$f - 1] . " to $ObservationMode[$f] for " .
"XRTMode $XRTMode[$f]");
push(@frame_end, $f - 1);
push(@frame_start, $f);
} elsif (($XRTMode[$f] == 6 or $XRTMode[$f] == 7) and
$Window[$f] ne $Window[$frame_start[-1]]) {
# Window changed for XRT mode 6 or 7.
$log->entry('Frame set ends at '. ($f - 1) .", new set starts at $f");
$log->entry('Cause: Window change from ' . $Window[$f - 1] .
" to $Window[$f] for XRTMode $XRTMode[$f], ObservationMode " .
"$ObservationMode[$f]");
push(@frame_end, $f - 1);
push(@frame_start, $f);
} elsif (($XRTMode[$f] == 4 or $XRTMode[$f] == 5) and
$bias[$f] ne $bias[$frame_start[-1]]) {
# Bias changed for XRT mode 4 or 5.
$log->entry('Frame set ends at '. ($f - 1) .", new set starts at $f");
$log->entry('Cause: bias change from ' . $bias[$f - 1] .
" to $bias[$f] for XRTMode $XRTMode[$f], ObservationMode " .
"$ObservationMode[$f], Window $Window[$f]");
push(@frame_end, $f - 1);
push(@frame_start, $f);
} elsif ($TIME[$f] - $ENDTIME[$f-1] > $SLEW_GAP){
$log->entry('Frame set ends at '. ($f - 1) .", new set starts at $f");
$log->entry('Cause: time gap of ' . ($TIME[$f]-$ENDTIME[$f-1]) .
" for XRTMode $XRTMode[$f], ObservationMode " .
"$ObservationMode[$f], Window $Window[$f]");
push(@frame_end, $f - 1);
push(@frame_start, $f);
} elsif ($flip_flop_end[$f-1]){
$log->entry('Frame set ends at '. ($f - 1) .", new set starts at $f");
$log->entry("Cause: flip_flop series end for " .
"XRTMode $XRTMode[$f], ObservationMode $ObservationMode[$f]");
push(@frame_end, $f - 1);
push(@frame_start, $f);
}
}
# If a frame set is still open, end it on the last frame.
if (@frame_start == @frame_end + 1) {
$log->entry("Ending last frame set at last frame.");
push(@frame_end, $num_frames - 1);
}
# print 'frame_start = ', Dumper \@frame_start;
# print 'frame_end = ', Dumper \@frame_end;
# $log->entry("Frame sets:");
# for (my $fs = 0; $fs < @frame_start; $fs++) {
# $log->entry("$frame_start[$fs]\t$frame_end[$fs]");
# }
# Make sure there are equal numbers of start and end frames.
if (@frame_start != @frame_end) {
$log->error(2, 'Frame set start and end frames do not match up!');
return;
}
# Count the frame sets.
my($num_frame_sets) = scalar(@frame_start);
$log->entry("num_frame_sets = $num_frame_sets");
#--------------------------------------------------------------------------
# Compute the cumulative exposure time for each frame set.
$log->entry("Computing frame set exposure times and mean temperature");
my(@flip_flop) = ('N') x $num_frame_sets;
my(@avg_temp) = (0) x $num_frame_sets;
my(@exposure) = (0) x $num_frame_sets;
for (my $fs = 0; $fs < $num_frame_sets; $fs++) {
my($sum) = 0;
my($tsum) = 0;
my($n) = 0;
my $fstart = $frame_start[$fs];
my $flip_mode = -1;
#####################################################
# If this frame set contains a flip-flop,
# need to setup to mask out the other mode
#####################################################
if( $flip_flop_end[$frame_end[$fs]] ){
my $flip_start;
for(my $n=0; $n < @flip_flop_series_end; $n++){
if($flip_flop_series_end[$n]==$frame_end[$fs]){
$flip_start = $flip_flop_series_start[$n];
last;
}
}
$flip_mode = $XRTMode[$flip_start+1];
$flip_flop[$fs] = 'Y';
############################################
# Create a frame set for the flipped mode
############################################
push @frame_start, $flip_start+1;
push @frame_end, $frame_end[$fs];
push @flip_flop, 'Y';
my ($flt_sum, $fl_sum, $fln) = (0, 0, 0);
for (my $f = $fstart; $f <= $frame_end[$fs]; $f++) {
next if ($XRTMode[$f] != $flip_mode);
my($t_start) = $TIME[$f];
my($t_end) = $ENDTIME[$f];
$fl_sum += ($t_end - $t_start);
$flt_sum += $CCDTemp[$f];
$fln++;
}
push @exposure, $fl_sum;
my $t_mean = -1;
$t_mean = $flt_sum / $fln if $fln > 0;
push @avg_temp, $t_mean;
}
for (my $f = $fstart; $f <= $frame_end[$fs]; $f++) {
next if ($XRTMode[$f] == $flip_mode);
my($t_start) = $TIME[$f];
my($t_end) = $ENDTIME[$f];
$sum += ($t_end - $t_start);
$tsum += $CCDTemp[$f];
$n++;
}
$exposure[$fs] = $sum;
my $t_mean = -1;
$t_mean = $tsum / $n if $n > 0;
$avg_temp[$fs] = $t_mean;
}
# $log->entry('exposure = '. Dumper \@exposure);
# $log->entry('avg_temp = '. Dumper \@avg_temp);
#--------------------------------------------------------------------------
# Assemble an array of indices containing the start frame for each
# frame set.
my(@record_sets);
for (my $fs = 0; $fs < @frame_start; $fs++) {
push @record_sets, $fs
unless $evt_path[$frame_start[$fs]] eq 'INDEF' &&
$XRTMode_string[$frame_start[$fs]] eq 'LOWRATE';
}
# Compute the final number of records.
@record_sets = sort { $frame_start[$a] <=> $frame_start[$b] } @record_sets;
my($num_records) = scalar(@record_sets);
$log->entry("num_records = $num_records");
$log->entry('record_sets = '. Dumper \@record_sets);
$log->entry("Record frame sets, adjusted rows:");
for (my $fs = 0; $fs < @record_sets; $fs++) {
$log->entry( ($frame_start[$record_sets[$fs]]+1) ."\t".
($frame_end[$record_sets[$fs]]+1) );
}
#--------------------------------------------------------------------------
# Assemble the arrays for the database columns.
my(@NAME) = ("'". $object ."'") x $num_records;
$log->entry('NAME = '. Dumper \@NAME);
my(@ORIG_TID) = (int($target)) x $num_records;
$log->entry('ORIG_TID = '. Dumper \@ORIG_TID);
my(@FINL_TID) = (int($target_id)) x $num_records;
$log->entry('FINL_TID = '. Dumper \@FINL_TID);
my(@ORIG_SEG) = (int($obs)) x $num_records;
$log->entry('ORIG_SEG = '. Dumper \@ORIG_SEG);
my(@FINL_SEG) = (int($segment)) x $num_records;
$log->entry('FINL_SEG = '. Dumper \@FINL_SEG);
my(@ORIG_SEQUENCE) = ($target . $obs) x $num_records;
$log->entry('ORIG_SEG = '. Dumper \@ORIG_SEQUENCE);
my(@FINL_SEQUENCE) = ($sequence) x $num_records;
$log->entry('FINL_SEG = '. Dumper \@FINL_SEQUENCE);
my(@RA) = (sprintf '%.5f', $ra) x $num_records;
$log->entry('RA = '. Dumper \@RA);
my(@DEC) = (sprintf '%.5f', $dec) x $num_records;
$log->entry('DEC = '. Dumper \@DEC);
my(@ROLL) = (sprintf '%.5f', $roll) x $num_records;
$log->entry('ROLL = '. Dumper \@ROLL);
my(@XRT_MODE) = @XRTMode_string[@frame_start[@record_sets]];
$log->entry('XRT_MODE = '. Dumper \@XRT_MODE);
my(@OBS_MODE) = @ObservationMode[@frame_start[@record_sets]];
$log->entry('OBS_MODE = '. Dumper \@OBS_MODE);
# Convert record start times to ISO date strings.
my(@START);
my($secs, $date, $yymmdd, $hhmmss, $datetime);
for (my $fs = 0; $fs < $num_records; $fs++) {
my $fstart = $frame_start[$record_sets[$fs]];
$secs = $TIME[$fstart];
if( $secs > 2.E09 ){
push(@START, 'INDEF');
}else{
$date = Util::Date->new($secs);
$yymmdd = $date->date;
$hhmmss = $date->time;
$datetime = "${yymmdd}T${hhmmss}." . int(100000*($secs-int($secs)));
push(@START, $datetime);
}
}
$log->entry('START = '. Dumper \@START);
# Convert frame set end times to ISO date strings.
my(@END);
for (my $fs = 0; $fs < $num_records; $fs++) {
my $fstop = $frame_end[$record_sets[$fs]];
$secs = $ENDTIME[$fstop];
if( $secs > 2.E09 ){
push(@END, 'INDEF');
}else{
$date = Util::Date->new($secs);
$yymmdd = $date->date;
$hhmmss = $date->time;
$datetime = "${yymmdd}T${hhmmss}." . int(100000*($secs-int($secs)));
push(@END, $datetime);
}
}
$log->entry('END = '. Dumper \@END);
my(@BIAS) = @bias[@frame_start[@record_sets]];
$log->entry('BIAS = '. Dumper \@BIAS);
my(@WINDOW) = @Window[@frame_start[@record_sets]];
$log->entry('WINDOW = '. Dumper \@WINDOW);
my(@INT_TIME) = map {/(INDEF|NULL)/ ? $_ : sprintf('%.5f',$_)} @timedel[@frame_start[@record_sets]];
$log->entry('INT_TIME = '. Dumper \@INT_TIME);
my(@EXPOSURE) = map {/(INDEF|NULL)/ ? $_ : sprintf('%.5f',$_)} @exposure[@record_sets];
$log->entry('EXPOSURE = '. Dumper \@EXPOSURE);
my(@AVG_TEMP) = map {/(INDEF|NULL)/ ? $_ : sprintf('%.5f',$_)} @avg_temp[@record_sets];
$log->entry('AVG_TEMP = '. Dumper \@AVG_TEMP);
my(@EVT_FILE) = @evt_path[@frame_start[@record_sets]];
$log->entry('EVT_FILE = '. Dumper \@EVT_FILE);
my(@FLIP_FLOP) = @flip_flop[@record_sets];
$log->entry('FLIP_FLOP = '. Dumper \@FLIP_FLOP);
#--------------------------------------------------------------------------
# Create the XRT exposure database table.
# Insert required values into the table.
$db->set(name => \@NAME);
$db->set(orig_target_id => \@ORIG_TID);
$db->set(target_id => \@FINL_TID);
$db->set(orig_obs_segment => \@ORIG_SEG);
$db->set(obs_segment => \@FINL_SEG);
$db->set(orig_obsid => \@ORIG_SEQUENCE);
$db->set(obsid => \@FINL_SEQUENCE);
$db->set(ra => \@RA);
$db->set(dec => \@DEC);
$db->set(roll_angle => \@ROLL);
$db->set(operation_mode => \@XRT_MODE);
$db->set(pointing_mode => \@OBS_MODE);
$db->set(start_time => \@START);
$db->set(stop_time => \@END);
$db->set(bias => \@BIAS);
$db->set(window_size => \@WINDOW);
$db->set(integration_time => \@INT_TIME);
$db->set(exposure => \@EXPOSURE);
$db->set(ccdtemp => \@AVG_TEMP);
$db->set(filename => \@EVT_FILE);
$db->set(flipflop => \@FLIP_FLOP);
# Compute the name of the XRT exposure database file.
my($outfile) = $filename->get('xrdb', 'proc', '', 0);
# $log->entry("outfile = $outfile\n");
# Create the XRT exposure database file.
$db->write($outfile);
# Print out accumulated warnings, after removing duplicates
my %messages;
@messages{@warnings} = (1) x @warnings;
foreach (keys %messages){
$log->error(1, $_);
}
$log->entry("Ending XRTDB::body().");
}
1;