package Subs::BATImages;
##############################################################################
#
# DESCRIPTION: Accumulate detector plane images in the various combinations
# that are needed.
#
# Port of Craig Markwardt's BAT::dpi, image modules to SDC.
#
# HISTORY: $Log: BATImages.pm,v $
# HISTORY: Revision 1.27 2014/02/27 09:22:47 apsop
# HISTORY: Don't use uat attitude file, at request of BAT Team/C.Markwardt.
# HISTORY:
# HISTORY: Revision 1.26 2012/08/30 07:04:48 apsop
# HISTORY: sub plot_images: Note source of trigtime. (Info not currently used,
# HISTORY: done for symmetry with eg. UvotProduct::AddTrigtime.)
# HISTORY:
# HISTORY: Revision 1.25 2012/01/12 06:52:03 apsop
# HISTORY: Changes going to proc3.15.03
# HISTORY:
# HISTORY: 2011-09-19 JRG as apsop: When deleting HDUNAME kwd, use deleteall
# HISTORY: which doesn't complain if it's missing as delete does.
# HISTORY:
# HISTORY: Revision 1.24 2011/01/20 17:22:02 apsop
# HISTORY: Added code to use UVOT attitude file if available
# HISTORY: Modified plotting subroutine to create plots consistent with format
# HISTORY: used in UVOT plots
# HISTORY: Added routine rearrange_images so that extesnion BAT_IMAGE_TOT is the
# HISTORY: first one
# HISTORY:
# HISTORY: Revision 1.23 2008/05/15 20:20:31 apsop
# HISTORY: Run batimgstatpos on imag status telemetry.
# HISTORY:
# HISTORY: Revision 1.22 2007/10/23 20:52:17 apsop
# HISTORY: Use burst pos to make postage stamp images, instead of pointing pos.
# HISTORY:
# HISTORY: Revision 1.21 2007/01/31 21:15:10 apsop
# HISTORY: Do not make postage stamp images outside the FOV. Improve and enable postage stamp plots.
# HISTORY:
# HISTORY: Revision 1.20 2006/10/29 19:30:19 apsop
# HISTORY: Use BAT_DPI_TOT ext name instead of BAT_IMAGE_TOT for detector images;
# HISTORY: First version of plotting code (not run).
# HISTORY:
# HISTORY: Revision 1.19 2006/09/10 20:07:22 apsop
# HISTORY: Add new distfile parameter for build 19.
# HISTORY:
# HISTORY: Revision 1.18 2006/08/02 19:47:30 apsop
# HISTORY: Change failure of sky2xyto a level 1 error.
# HISTORY:
# HISTORY: Revision 1.17 2006/08/01 20:57:35 apsop
# HISTORY: Trap the case where batbinevt does not produce an output image due to an
# HISTORY: empty filtered file. Continue processing.
# HISTORY:
# HISTORY: Revision 1.16 2006/07/06 18:16:09 apsop
# HISTORY: Change ext name of 1chan image to BAT_IMAGE_TOT. Test for presence of
# HISTORY: BAT_CATALOG ext in 1chan image before copying.
# HISTORY:
# HISTORY: Revision 1.15 2006/05/10 18:42:37 apsop
# HISTORY: Better trapping of empty source list, and keep ps images from extracting
# HISTORY: beyond the edges of the input image.
# HISTORY:
# HISTORY: Revision 1.14 2006/05/10 15:26:55 apsop
# HISTORY: Trap case where batcelldetect finds no sources.
# HISTORY:
# HISTORY: Revision 1.13 2005/11/08 17:21:51 apsop
# HISTORY: Change calls for qualcal and skyimage filenames. Append BAT_CATALOG
# HISTORY: extension to preslew image.
# HISTORY:
# HISTORY: Revision 1.12 2005/07/06 20:36:55 apsop
# HISTORY: Implemented BAT position refinement.
# HISTORY:
# HISTORY: Revision 1.11 2005/05/16 14:15:33 apsop
# HISTORY: Handle missing input files more gracefully when creating images. Pass
# HISTORY: CALDB for ebounds parameter when creating mask tagged light curves.
# HISTORY:
# HISTORY: Revision 1.10 2005/05/13 19:38:02 apsop
# HISTORY: Implemented product agreements between HEASARC and BAT team.
# HISTORY:
# HISTORY: Revision 1.9 2005/04/06 15:41:05 apsop
# HISTORY: Change to using CALDB for cal parameters.
# HISTORY:
# HISTORY: Revision 1.8 2005/03/07 20:24:01 apsop
# HISTORY: Change detimage type to dpimage.
# HISTORY:
# HISTORY: Revision 1.7 2005/02/10 00:08:35 apsop
# HISTORY: Added message identifiers.
# HISTORY:
# HISTORY: Revision 1.6 2005/02/08 19:15:46 apsop
# HISTORY: Fix problem with BAT image names which was causing images not to be produced.
# HISTORY:
# HISTORY: Revision 1.5 2004/12/31 01:34:09 apsop
# HISTORY: Comment out 4 channel images, as they are not official products. Change
# HISTORY: 1chan images to proper file name.
# HISTORY:
# HISTORY: Revision 1.4 2004/12/06 00:58:17 apsop
# HISTORY: Fix typo - info() should be entry()
# HISTORY:
# HISTORY: Revision 1.3 2004/12/05 23:41:23 apsop
# HISTORY: Change pcodeimg error message to an info message
# HISTORY:
# HISTORY: Revision 1.2 2004/11/16 14:24:26 apsop
# HISTORY: Only try to process files that exist.
# HISTORY:
# HISTORY: Revision 1.1 2004/11/08 18:40:39 apsop
# HISTORY: Module for creating BAT image products.
# HISTORY:
# HISTORY: Revision 1.1 2004/09/24 20:51:19 wiegand
# HISTORY: Initial revision
# HISTORY:
#
# VERSION: $Revision: 1.27 $
#
#
##############################################################################
use Subs::Sub;
use Util::Parfile;
use Util::Ftool;
use Util::HEAdas;
use Util::BATCave;
use Util::CoreTags;
use Util::SwiftTags;
use Util::SimpleFITS;
use Astro::FITS::CFITSIO qw(:constants);
use Subs::UvotProduct;
@ISA = ("Subs::Sub");
use strict;
sub new {
my $proto=shift;
my $self=$proto->SUPER::new();
$self->{DESCRIPTION}= 'Processing BAT images';
$self->{POSCAT} = 'posrefine.cat';
$self->{POSREG} = 'posrefine.reg';
return $self;
}
##################
# METHODS:
##################
sub body {
my $self = shift;
$self->detector_plane_images;
$self->sky_images;
# $self->partial_coding_maps;
$self->postage_stamp_images;
$self->refine_position;
$self->glom_images;
$self->rearrange_images();
$self->plot_images;
unlink $self->{POSREG}, $self->{POSCAT};
$self->image_status_pos;
}
sub detector_plane_images
{
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $procpar = $self->procpar;
my $jobpar = $self->jobpar;
$log->entry('Accumulating BAT detector plane images');
my @config = (
{ key => 'preburst',
events => 'evshps',
gti => 'GTI_BKG1',
mode => 'evpb',
},
{ key => 'preslew',
events => 'evshps',
gti => 'GTI_TOT',
mode => 'evps',
},
{ key => 'postslew',
events => 'evshas',
gti => 'NONE',
mode => 'evas',
},
);
my %info = (
qmap => $filename->get('qualcal', 'bat', ''),
);
foreach my $c (@config) {
my @events = $filename->getExisting(
'unfiltered', 'bat', $c->{events});
next if not @events;
$info{files} = \@events;
$info{gti} = Util::BATCave::get_gti($self, $c->{gti});
$info{energybins} = Util::BATCave::chan1;
$info{outfile} = $filename->get('dpimage', 'bat',
$c->{mode} . '1chan', 0),
$self->dpiMake(\%info);
$info{energybins} = Util::BATCave::chan4;
$info{outfile} = $filename->get('dpimage', 'bat',
$c->{mode} . '4chan', 0),
$self->dpiMake(\%info);
}
} # end of body method
# BAT::dpi->make
sub dpiMake
{
my ($self, $info) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $procpar = $self->procpar;
my $jobpar = $self->jobpar;
my $dpifile = $info->{outfile};
my $erange = $info->{energybins} || '-';
my $qmap = $info->{qmap} || 'NONE';
my $gti = $info->{gti} || 'NONE';
my $inlist = join(',', @{ $info->{files} });
unlink($dpifile);
my $batbinevt = Util::HEAdas->new('batbinevt')
->params({
infile => $inlist,
outfile => $dpifile,
outtype => 'DPI',
timedel => 0,
timebinalg => 'uniform',
energybins => $erange,
detmask => $qmap,
ecol => 'ENERGY',
weighted => 'NO',
outunits => 'COUNTS',
gtifile => $gti,
clobber => 'yes',
chatter => 3,
});
$batbinevt->seriousness(1);
$batbinevt->run();
if( $batbinevt->had_error() == 2 ){
$log->error(2, "batbinevt level 2 error");
}elsif( $batbinevt->had_error() == 1 ){
##################################################################
# Note: this case is not fatal, *IF* there were no overlapping
# good times between the input file and the good time interval
# file. In that case batbinevt does not create an output file.
#################################################################
my $errout = $batbinevt->stderr();
foreach ( $errout =~ /^.*$/gm ){
if( ! /^=+$/ && ! /WARNING: no overlapping good time intervals were found/ ){
$log->error(2, "batbinevt level 2 error");
last;
}
}
}
if (not -f $dpifile) {
$log->entry("warning: batbinevt did not create DPI $dpifile");
}
}
sub sky_images
{
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $procpar = $self->procpar;
my $jobpar = $self->jobpar;
$log->entry('Computing sky images ...');
my %common = (
teldef => 'CALDB',
attfile => $filename->get('attitude', 's'),
corrections => 'autocollim,flatfield,ndets,pcode,maskwt',
aperture => 'CALDB',
qmap => $filename->get('qualcal', 'bat', ''),
bat_z => $jobpar->read('bat_z'),
origin_z => $jobpar->read('bat_origin_z'),
# Partial coding threshold. Minimum detector plane exposure
# threshold.
pcodethresh => 0.05, # Fraction of 1.0
pcodemap => 'APPEND_LAST',
);
# TODO: check for %common files or return
my @config = (
{ interval => 'preburst',
mode => 'evpb',
},
{ interval => 'preslew',
mode => 'evps',
},
{ interval => 'postslew',
mode => 'evas',
},
);
foreach my $c (@config) {
my @chan_ranges = qw(1chan 4chan);
# can truncate to 1chan if $run_for_speed
my $done = 0;
my @files;
foreach my $chan (@chan_ranges) {
my $mode = $c->{mode} . $chan;
my $dpifile = $filename->get('dpimage', 'bat', $mode);
next if not -f $dpifile;
my $imgfile = $filename->get('skyimage', 'bat', $mode, 0);
my $bkgfile = 'NONE';
if ($c->{interval} eq 'preslew') {
# Pre-slew interval uses preburst background
my $name = $filename->get('dpimage', 'bat', 'evpb' . $chan);
$bkgfile = $name if -f $name;
}
my %info = (
%common,
dpifile => $dpifile,
imgfile => $imgfile,
bkgfile => $bkgfile,
);
$self->imageSky(\%info);
$done = 1;
}
if ($done) {
$log->entry("... $c->{interval} done");
}
}
}
# BAT::image->sky
sub imageSky
{
my ($self, $info) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $procpar = $self->procpar;
my $jobpar = $self->jobpar;
my $imgfile = $info->{imgfile};
my $bkgfile = $info->{bkgfile} || 'NONE';
my $pcodemap = $info->{pcodemap} || 'NO';
unlink($imgfile);
# XXX NOTE: clobber=NO is a workaround for a bug in the build 9
# batfftimage task. Since we unlink($imgfile) just above, this is
# equivalent to clobber=yes
my $batbinevt = Util::HEAdas->new('batfftimage')
->params({
infile => $info->{dpifile},
outfile => $imgfile,
attitude => $info->{attfile},
bkgfile => $bkgfile,
bat_z => $info->{bat_z},
origin_z => $info->{origin_z},
teldef => $info->{teldef},
pcodethresh=> $info->{pcodethresh},
corrections=> $info->{corrections},
detmask => $info->{qmap},
aperture => $info->{aperture},
pcodemap => $pcodemap,
clobber => 'no',
chatter => 3,
})
->run;
}
sub partial_coding_maps
{
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $procpar = $self->procpar;
my $jobpar = $self->jobpar;
$log->entry('Computing partial coding maps...');
my %common = (
teldef => 'CALDB',
attfile => $filename->get('attitude', 's'),
# since pcodemap == imageSky(bkgfile=NONE, pcodemap=YES)
bkgfile => 'NONE',
pcodemap => 'YES',
corrections => 'autocollim,flatfield,ndets,pcode,maskwt',
aperture => 'CALDB',
qmap => $filename->get('qualcal', 'bat', ''),
bat_z => $jobpar->read('bat_z'),
origin_z => $jobpar->read('bat_origin_z'),
# Partial coding threshold. Minimum detector plane exposure
# threshold.
pcodethresh => 0.05, # Fraction of 1.0
);
# Only the pre-slew and post-slew segments are meaningful for the
# partial coding map (during the slew doesn't make sense)
my @config = (
{ interval => 'preslew',
mode => 'evps',
},
{ interval => 'postslew',
mode => 'evas',
},
);
foreach my $c (@config) {
my $done = 0;
# Only one partial coding map per interval
foreach my $chan (qw(1chan)) {
my $mode = $c->{mode} . $chan;
# TODO: file types?
my $dpifile = $filename->get('dpimage', 'bat', $mode);
next if not -f $dpifile;
my $pcodefile = $filename->get('expimage', 'bat', $c->{mode}, 0);
my %info = (
%common,
dpifile => $dpifile,
imgfile => $pcodefile,
);
$self->imageSky(\%info);
$done = 1;
}
if ($done) {
$log->entry("... $c->{interval} done");
}
}
my $pcodeimg = $filename->get('expimage', 'bat', 'evps');
if (not -f $pcodeimg) {
$log->entry('no BAT preslew pcodeimg, unable to set pcode');
return;
}
my $ra = $jobpar->read('burst_ra');
my $dec = $jobpar->read('burst_dec');
my $value = $self->pcodeFromImage($pcodeimg, $ra, $dec);
if (defined($value)) {
if (undef) {
$jobpar->set({
bat_pcode => $value,
});
}
$log->entry("determined BAT pcode => $value");
}
else {
$log->error(1, 'unable to set BAT pcode');
}
}
sub sky2pix
{
my ($image, $ra, $dec) = @_;
my $sky2xy = Util::Ftool->new('sky2xy')
->params({
infile => $image,
xsky => $ra,
ysky => $dec,
});
$sky2xy->seriousness(1);
$sky2xy->run();
return if $sky2xy->had_error();
# grab xpix, ypix
my $skypars = Util::Parfile->new('sky2xy.par');
my $xpix = $skypars->read('xpix');
my $ypix = $skypars->read('ypix');
return [ $xpix, $ypix ];
}
# BAT::pcode->fromimage / BAT::imageutils
sub pcodeFromImage
{
my ($self, $path, $ra, $dec) = @_;
my $pixpos = sky2pix($path, $ra, $dec);
return if not $pixpos;
my ($xpix, $ypix) = map { sprintf('%d', $_) } @$pixpos;
my $fimgpar = Util::Ftool->new('fimgpar')
->params({
fitsfile => $path,
pixel => "$xpix,$ypix",
})
->run;
return if $fimgpar->had_error;
my $imgpars = Util::Parfile->new('fimgpar.par');
my $undef = $imgpars->read('undef');
return if $undef =~ m/^y/i;
my $value = $imgpars->read('outvalue');
return $value;
}
sub postage_stamp_images
{
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $procpar = $self->procpar;
my $jobpar = $self->jobpar;
$log->entry('Extracting postage stamp images...');
my $ra = $jobpar->read('burst_ra');
my $dec = $jobpar->read('burst_dec');
my $postsize = 100;
my @config = (
{ interval => 'preburst',
mode => 'evpb',
},
{ interval => 'preslew',
mode => 'evps',
},
{ interval => 'postslew',
mode => 'evas',
},
);
foreach my $c (@config) {
# Only one partial coding map per interval
foreach my $chan (qw(1chan)) {
my $mode = $c->{mode} . $chan;
my $imgfile = $filename->get('skyimage', 'bat', $mode);
next if not -f $imgfile;
my $imgfits = Util::FITSfile->new($imgfile, 0);
my $xnaxis = $imgfits->keyword('NAXIS1');
my $ynaxis = $imgfits->keyword('NAXIS2');
my $postfile = $filename->get('postimg', 'bat', $mode, 0);
unlink($postfile);
my $pixpos = sky2pix($imgfile, $ra, $dec);
if (not $pixpos) {
$log->error([ 1, BAT_TASK_ERROR ],
"unable to make postage stamp image for $imgfile");
next;
}
my ($xpix, $ypix) = @$pixpos;
my $xstart = int($xpix - $postsize / 2);
my $xstop = $xstart + $postsize;
my $ystart = int($ypix - $postsize / 2);
my $ystop = $ystart + $postsize;
$xstop = $xnaxis if $xstop > $xnaxis;
$ystop = $ynaxis if $ystop > $ynaxis;
if ($xstart < 1) { $xstart = 1 };
if ($ystart < 1) { $ystart = 1 };
if( $xstop < 1 || $ystop < 1 || $xstart > $xnaxis || $ystart > $ynaxis ){
$log->error(1, "Postage stamp image outside of sky image. " .
"Will not make postage stamp $postfile .");
next;
}
my $copier = Util::HEAdas->new('ftcopy')
->params({
infile => $imgfile . "[$xstart:$xstop,$ystart:$ystop]",
outfile => $postfile,
})
->run;
}
}
}
sub refine_position
{
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $procpar = $self->procpar;
my $jobpar = $self->jobpar;
$log->entry('BAT position refinement...');
my $mode = 'evps1chan';
my $ackpath = Util::BATCave::get_tdrss_ack($self);
if (not $ackpath) {
$log->entry('TDRSS ACK unavalable, so no position refinement');
return;
}
my $pointSource = 0;
my $imageTrigger = 0;
my $status = Util::SimpleFITS->readonly($ackpath)
->readkey(POINTSRC => $pointSource)
->readkey(IMAGETRG => $imageTrigger)
->close
->status;
if (not $pointSource or $imageTrigger) {
$log->entry('this is an image trigger or not a point source, so no position refinement');
return;
}
my $imgfile = $filename->get('skyimage', 'bat', $mode, '*');
if (not $imgfile) {
$log->entry('preslew sky image unavalable, so no position refinement');
return;
}
my $pcodefile = $imgfile . '[BAT_PCODE_1]';
my %info = (
ra => $jobpar->read('burst_ra'),
dec => $jobpar->read('burst_dec'),
err_rad => 4 / 60, # deg
incat => 'input.cat',
outcat => $self->{POSCAT},
# $filename->get('srccat', 'bat', '', 0);
region => $self->{POSREG},
imgfile => $imgfile,
pcodefile => $pcodefile,
trigger => $jobpar->read('target'),
);
unlink($info{incat}, $info{outcat});
$self->refine_position_aux(\%info);
}
# BAT::posrefine::refine
sub refine_position_aux
{
my ($self, $info) = @_;
my $log = $self->log;
my $filename = $self->filename;
# Make input catalog
my $incat = $info->{incat};
my $fits = Util::SimpleFITS->create($incat);
my $status = $fits->status();
if ($status) {
$log->error(1, "could not open $incat for writing");
return;
}
# Write catalog columns
$status = $fits
->createtab("BAT_CATALOG")
->writekey("NAXIS2",1)
->insertcol({TTYPE => ["NAME", "Source Name"],
TFORM => "20A"})
->insertcol({TTYPE => ["RA_OBJ", "Source Right Ascension"],
TFORM => "1D", TUNIT => "deg"})
->insertcol({TTYPE => ["DEC_OBJ", "Source Declination"],
TFORM => "1D", TUNIT => "deg"})
->insertcol({TTYPE => ["ERR_RAD", "Source Error Radius"],
TFORM => "1D", TUNIT => "deg"})
->writecol("NAME", {},"TRIG_$info->{trigger}")
->writecol("RA_OBJ", {},$info->{ra})
->writecol("DEC_OBJ",{},$info->{dec})
->writecol("ERR_RAD",{},$info->{err_rad})
->status();
if ($status) {
$log->error(1, "could not create table in $incat");
return;
}
$fits->close();
my $region = $info->{region};
unlink ($region) if ($region ne "NONE" && -f $region);
# Run source detection for this source
my $outcat = $info->{outcat};
my $tool = Util::HEAdas->new('batcelldetect')
->params({
infile => $info->{imgfile},
outfile => $outcat,
snrthresh => 6,
incatalog => $incat,
srcdetect => 'NO',
posfit => 'YES',
distfile => 'CALDB',
niter => 1,
regionfile => $region,
pcodefile => $info->{pcodefile},
clobber => 'yes',
})
->run;
if ($tool->had_error or not -f $outcat) {
$log->error(1, 'batcelldetect failed in position refinement');
return;
}
$fits = Util::SimpleFITS->readonly($outcat)->move("BAT_CATALOG");
$status = $fits->status();
if ($status) {
$log->error(1, "could not open $outcat");
return;
}
my (@ra, @dec, @err_rad, @chi2, @snr);
$status = $fits
->readcol("RA_OBJ", TDOUBLE, [ ], \@ra)
->readcol("DEC_OBJ", TDOUBLE, [ ], \@dec)
->readcol("ERR_RAD", TDOUBLE, [ ], \@err_rad)
->readcol("CHI2_NU", TDOUBLE, [ ], \@chi2)
->readcol("SNR", TDOUBLE, [ ], \@snr)
->status();
$fits->setstatus(0)->close();
if ($status) {
$log->error(1, "could not read $outcat");
return;
}
unless(@ra){
$log->entry("No BAT sources detected.");
}else{
$log->entry("refined position:");
$log->entry(sprintf('RA=%.4f DEC=%.4f', $ra[0], $dec[0]));
$log->entry(sprintf('error=%.4f [arcmin]', $err_rad[0] * 60));
$log->entry(sprintf('chi^2=%.4f', $chi2[0]));
$log->entry(sprintf('snr=%.2f', $snr[0]));
}
###############################################
# Append position refinement to BAT image file
###############################################
Util::FITSfile->new($outcat, 'BAT_CATALOG')
->append_to($info->{imgfile});
unlink $outcat, $incat;
}
sub glomImages
{
my ($self, $info) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $imgtype = $info->{sky} ? 'skyimage' : 'dpimage';
my $img1chan = $filename->get($imgtype, 'bat', $info->{mode} . '1chan');
my $img4chan = $filename->get($imgtype, 'bat', $info->{mode} . '4chan');
if ((not $img1chan or not -f $img1chan)
and (not $img4chan or not -f $img4chan)) {
$log->entry("no $imgtype images");
return;
}
my $glomfile = $filename->get($imgtype, 'bat', $info->{mode}, 0);
$log->entry("packaging $info->{key} ${imgtype}s into $glomfile");
my $appender = Util::HEAdas->new('ftappend')
->params({
outfile => $glomfile,
});
my @error;
if (not $img1chan or not -f $img1chan) {
push(@error, "missing BAT total $imgtype");
rename($img4chan, $glomfile)
or push(@error, "unable to rename $img4chan to $glomfile [$!]");
}
elsif (not $img4chan or not -f $img4chan) {
push(@error, "missing BAT 4 channel $imgtype");
rename($img1chan, $glomfile)
or push(@error, "unable to rename $img1chan to $glomfile [$!]");
}
else {
rename($img4chan, $glomfile)
or push(@error, "unable to rename $img4chan to $glomfile [$!]");
}
foreach my $e (@error) {
$log->error(1, $e);
}
if (not @error) {
my $nhdu = 0;
my $status = Util::SimpleFITS->readonly($img1chan)
->nhdu($nhdu)
->close
->status;
if ($status) {
$log->error(2, "unable to open $img1chan");
}
my $hdupath = $img1chan . '[0]';
if($info->{sky}){
$hdupath .= '[col #EXTNAME = \"BAT_IMAGE_TOT\"]';
}else{
$hdupath .= '[col #EXTNAME = \"BAT_DPI_TOT\"]';
}
$appender->params({
infile => $hdupath,
})->run;
if ($appender->had_error) {
$log->error([ 2, HEATOOL_ERROR ],
"unable to append $hdupath to $glomfile");
}
$status = Util::SimpleFITS->readonly($img1chan)
->move('BAT_CATALOG')
->close
->status;
if (!$status && $info->{sky} && $info->{mode} eq 'evps') {
$hdupath = $img1chan . "[BAT_CATALOG]";
$appender->params({
infile => $hdupath,
})->run;
if ($appender->had_error) {
$log->error([ 2, HEATOOL_ERROR ],
"unable to append $hdupath to $glomfile");
}
}
unlink($img1chan) or $log->error(2, "unable to remove $img1chan [$!]");
}
}
sub glom_images
{
my $self = shift;
my $log = $self->log;
# sky: 1 channel + 4 channel + EBOUNDS + GTI + partial coding map
# det: 1 channel + 4 channel + EBOUNDS + GTI
my @config = (
# DET images
{ key => 'preburst',
mode => 'evpb',
},
{ key => 'preslew',
mode => 'evps',
},
{ key => 'postslew',
mode => 'evas',
},
# SKY images
{ key => 'preburst',
sky => 1,
mode => 'evpb',
},
{ key => 'preslew',
sky => 1,
mode => 'evps',
},
{ key => 'postslew',
sky => 1,
mode => 'evas',
},
);
foreach my $c (@config) {
$self->glomImages($c);
}
}
sub rearrange_images{
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $imgtype = 'skyimage';
my @types = qw /evpb evps evas/;
my $stat = Util::HEAdas->new('ftstat');
foreach my $t (@types){
my $img = $filename->get($imgtype, 'bat', $t);
next if (!-e $img);
my $nhdu = 0;
my $status = Util::SimpleFITS->readonly($img)->nhdu($nhdu)->close->status;
my $extnum = undef;
for (my $i=0; $i<$nhdu; $i++){
my $ext = $i;
my $infile = $img."\[$ext\]";
$stat->params({infile => $infile})->run();
my $stdo = $stat->stdout();
my $extname = $self->getExt($stdo, 'extname');
if(defined $extname and $extname =~ /BAT_IMAGE_TOT/){
$extnum = $i;
}
if(defined $extnum){
my $newfile = $img.'_new';
my $fits = Util::FITSfile->new($newfile);
Util::HEAdas->new('ftcopy')
->params({
infile => "$img\[$extnum\]",
outfile => "$newfile",
copyall => 'NO',
})
->run();
Util::HEAdas->new('fthedit')
->params({
infile => $newfile.'[0]',
keyword => 'EXTNAME',
operation => 'add',
value => 'BAT_IMAGE_TOT'
})
->run();
Util::HEAdas->new('fthedit')
->params({
infile => $newfile.'[0]',
keyword => 'HDUNAME',
operation => 'deleteall'
})
->run();
for (my $i=0; $i<$nhdu; $i++){
next if $i == $extnum;
Util::HEAdas->new('ftappend')
->params({
infile => "$img\[$i\]",
outfile => "$newfile",
})
->run();
if($i==0){
Util::HEAdas->new('fthedit')
->params({
infile => $newfile.'[1]',
keyword => 'EXTNAME',
operation => 'add',
value => 'BAT_IMAGE_1'
})
->run();
Util::HEAdas->new('fthedit')
->params({
infile => $newfile.'[1]',
keyword => 'HDUNAME',
operation => 'deleteall'
})
->run();
}
}
if(-e $newfile){
unlink $img;
my $rv = system("mv $newfile $img");
if($rv != 0){
}
}
last;
}
}
}
}
sub getExt {
my $self = shift;
my ($str, $pat) = @_;
my @tar = split/\n/, $str;
my $quest = undef;
foreach my $l (@tar){
next if($l =~ /^\s*$/ or $l =~ /^\s*\=/);
$l =~ s/^\s+//;
if($l =~ /$pat\:/){
$quest = (split/\:\s+/, $l)[-1];
last;
}
}
return $quest;
}
sub plot_images {
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $jobpar = $self->jobpar;
my $title = uc($jobpar->read('object')) .' SWIFT BAT '.
$jobpar->read('sequence') .' ('.$jobpar->read('obsdate').')';
my $msbce = $filename->get('tdmess', 'bat', 'ce', 0);
my $msbce1 = Util::FITSfile->new($msbce,0);
my $trigdate = undef;
my $trigtime = undef;
$trigdate = $msbce1->keyword('DATETRIG');
$trigtime = $msbce1->keyword('TRIGTIME');
my $trigtimeSrc = "TRIGTIME keyword";
if(!defined $trigtime or $trigtime == 0){
$trigtime = $self->Subs::UvotProduct::getTrigFromDB();
$trigtimeSrc = "TDRSS Catalog";
if(!defined $trigtime){
$trigtime = $self->Subs::UvotProduct::getTrigFromSWIFTCatalog();
$trigtimeSrc = "Lorella Catalog";
if(!defined $trigtime){
$trigtime = $self->Subs::UvotProduct::getTrigFromJDCatalog();
$trigtimeSrc = "JD Catalog";
if(!defined $trigtime){
$trigtime = $self->Subs::UvotProduct::getTrigFromLocalCatalog();
$trigtimeSrc = "Local Catalog";
}
}
}
}
if(!defined $trigdate and defined $trigtime){
my $dateobj = Util::Date->new($trigtime);
$trigdate = $dateobj->date().'T'.$dateobj->time();
}
my $title2 = "Time(s) since BAT trigger time";
if(defined $trigtime){
$title2 .= "(UT $trigdate/MET $trigtime)";
}
my $region = $self->{POSREG};
my @postfiles = $filename->get('postimg', 'bat', '*', 0);
return unless @postfiles;
my %modes = ('evpb' => 'Before Burst', 'evps' => 'Before Slew', 'evas' => 'After Slew');
my $plot_file = $filename->get('skyplot', 'bat', 'ev', 0);;
my $circle;
if( -f $region && open(REG, $region) ){
while(<REG>){
if( /^circle\(([\.\d]+)d,([-\.\d]+)d,([\.\d]+)d\)/ ){
$circle = "ra_dec_to_pixel/ra=$1/dec=$2/color=0/circle=". $3*3600;
}
}
close REG;
}
my $ximage = Util::Xanadu->new("ximage");
my @titlepos = ('/vx=0.2/vy=0.8', '/vx=0.7/vy=0.8', '/vx=0.2/vy=0.4', '/vx=0.7/vy=0.4');
my @titlepos2 = ('/vx=0.12/vy=0.78/csize=0.65', '/vx=0.57/vy=0.78/csize=0.65', '/vx=0.12/vy=0.38/csize=0.65', '/vx=0.57/vy=0.38/csize=0.65');
my $viewports = 'viewports.tmp';
open VIEW, ">$viewports";
print VIEW "0.1 0.45 0.5 0.75\n";
print VIEW "0.55 0.9 0.5 0.75\n";
print VIEW "0.1 0.45 0.1 0.35\n";
print VIEW "0.55 0.9 0.1 0.35\n";
close VIEW;
my @commands;
push @commands, ('cpd /vgif', 'cey 2000');
push @commands, ("viewport/file=$viewports");
push @commands, ('color/setcolor=0/namecolor=white');
push @commands, ('color/setcolor=1/namecolor=black');
push @commands, ('cct/set bb');
push @commands, ('levels/num=239');
my $stat = Util::HEAdas->new('ftstat')
->params({centroid => 'no'});
my $nview = 1;
foreach my $mode (keys %modes){
my $file = ( grep(/${mode}/, @postfiles) )[0];
if($file){
my $fits = Util::FITSfile->new($file,0);
my $Tstart = $fits->keyword('TSTART');
my $Tstop = $fits->keyword('TSTOP');
my $dif1 = sprintf("%.2f", $Tstart-$trigtime);
my $dif2 = sprintf("%.2f", $Tstop-$trigtime);
my $dif3 = sprintf("%.2f", $Tstop - $Tstart);
if($dif1 >= 0.0){
$dif1 = '+'.$dif1;
}
if($dif2 >= 0.0){
$dif2 = '+'.$dif2;
}
# if($dif3 >= 0.0){
# $dif3 = '+'.$dif3;
# }
my $ptitle = 'From T'.$dif1.'s to T'.$dif2.'s = '.$dif3.'s';
$stat->params({infile => $file . '[0]'})
->run();
my $par = $stat->parfile();
push @commands, ("read/fits/mapid=$nview $file");
push @commands, ("disp/lin/mapid=$nview/min=". $par->read('min') ."/max=". $par->read('max'));
push @commands, ("map $nview");
push @commands, ('grid/csize=0.55');
push @commands, ($circle) if $circle;
push @commands, ("label/color=1$titlepos[$nview-1] \"$modes{$mode}\"");
push @commands, ("label/color=1$titlepos2[$nview-1] \"$ptitle\"");
push @commands, ('scale/curvp');
$nview++;
}
}
# push @commands, ("label/vx=0.3/vy=0.9/csize=1.1/color=1 \"BAT Sky Images, ". $jobpar->read('sequence') .'"');
push @commands, ("label/vx=0.17/vy=0.9/csize=1.0/color=1 \"$title\"");
push @commands, ("label/vx=0.125/vy=0.025/csize=0.75/color=1 \"$title2\""); push @commands, 'exit';
$ximage->script(@commands)->run();
rename 'pgplot.gif', $plot_file;
unlink $viewports;
}
sub image_status_pos {
my ($self) = @_;
my $log = $self->log;
my $filename = $self->filename;
my $jobpar = $self->jobpar;
my $tmp = 'img_status.tmp';
my $attitude = $filename->get('attcorr', 'p');
if (-e $attitude) {
$log->entry("Got pat attitude file $attitude");
} else {
$log->error(1, "$attitude pat attitude file does not exist, trying sat file");
$attitude = $filename->get('attitude', 's');
if (-e $attitude) {
$log->entry("Got sat attitude file $attitude");
} else {
$log->error(1, "Unable to find attitude file");
return;
}
}
my $imgstatpos = Util::HEAdas->new('batimgstatpos')
->params({teldef => 'CALDB',
distfile => 'NONE',
outfile => $tmp,
attitude => $attitude});
foreach my $file ($filename->get('btbimgtr', 'bat', '', '*')){
$imgstatpos->params({infile => $file})
->run();
unless( $imgstatpos->had_error() ){
rename $tmp, $file;
}else{
unlink $tmp;
}
}
}
1;