Subs::UVOTDB (version 0.0)


package Subs::UVOTDB;
##############################################################################
#
# DESCRIPTION: 
#
# HISTORY: 
# HISTORY: $Log: UVOTDB.pm,v $
# HISTORY: Revision 1.15  2006/06/15 22:17:00  apsop
# HISTORY: Set asp_corr DB value based on ASPCORR keyword.
# HISTORY:
# HISTORY: Revision 1.14  2006/04/27 15:47:54  apsop
# HISTORY: Allow for either INDEF or NULL values returned from FITSfile class.
# HISTORY:
# HISTORY: Revision 1.13  2006/02/08 18:12:44  apsop
# HISTORY: Set tnull to -1 for led_bias column.
# HISTORY:
# HISTORY: Revision 1.12  2006/01/16 17:52:21  apsop
# HISTORY: Use HEASARC specified mode names.
# HISTORY:
# HISTORY: Revision 1.11  2006/01/11 21:04:36  apsop
# HISTORY: Add columns att_flag, submode, led_bias
# HISTORY:
# HISTORY: Revision 1.10  2005/12/19 16:23:45  apsop
# HISTORY: Put quotes around mode names so as not to confuse fcreate.
# HISTORY:
# HISTORY: Revision 1.9  2005/12/01 20:56:29  apsop
# HISTORY: Fix mapping of extension names which was deleting values. Is this a perl bug?
# HISTORY:
# HISTORY: Revision 1.8  2005/11/08 19:43:57  apsop
# HISTORY: <Previous comment bogus> Add null value for binning column. Add extname column. Handle missing file name.
# HISTORY:
# HISTORY: Revision 1.7  2005/11/08 19:22:28  apsop
# HISTORY: Populate the TIMELIST and DATALIST hashes. Used to be an SWCheckInput.
# HISTORY:
# HISTORY: Revision 1.6  2005/08/30 14:05:31  apsop
# HISTORY: Add new image_loss column.  Rename integration_time to exposure.  Limit precision on floating values.
# HISTORY:
# HISTORY: Revision 1.5  2005/06/01 19:55:49  apsop
# HISTORY: Add binning column to db fits file.
# HISTORY:
# HISTORY: Revision 1.4  2005/06/01 13:59:46  apsop
# HISTORY: Use event or image mode window sizes for window column as appropriate.  More robust method for obtaining pointing_mode.
# HISTORY:
# HISTORY: Revision 1.3  2004/12/22 18:17:06  apsop
# HISTORY: Bug fixes to acquistion of UVOT db values.
# HISTORY:
# HISTORY: Revision 1.2  2004/12/14 02:45:37  apsop
# HISTORY: Test for existence of exposure catalog before making db file.
# HISTORY:
# HISTORY: Revision 1.1  2004/12/10 02:12:44  apsop
# HISTORY: Class for making uvot database files.
# HISTORY:
#
# VERSION: 0.0
#
#
##############################################################################


use Subs::Sub;

@ISA = ("Subs::Sub");
use strict;

use Astro::FITS::CFITSIO qw(:constants);

use Util::HEAdas;
use Util::Date;
use Util::FITStable;

use Subs::UvotNames;

sub new {
    my $proto=shift;
    my $self=$proto->SUPER::new();

    $self->{DESCRIPTION}="Sort and organize UVOT data";

    return $self;
}

##################
# METHODS:
##################

sub body
{
    my $self=shift;

    my $log      = $self->log();
    my $filename = $self->filename();
    my $procpar  = $self->procpar();
    my $jobpar   = $self->jobpar();

    my $modeNames = ['NULL', 'NULL', 'Event', 'Image', 'Image/Event', 'NULL', 'RAW', 
		     'CHANNEL', 'NULL', 'INTENSIFIER', 'CENTROID'];

	# set up the database columns
	my @db = (
		# alert keys
		{ name => 'name',
			type => '80A',
			# $jobpar->read('object')
		},
		{ name => 'orig_target_id',
			type => '1J',
			null => -1,
		        # $jobpar->read('target')
		},
		{ name => 'target_id',
			type => '1J',
			null => -1,
			# substr(0, 8, $jobpar->read('sequence'))
		},
		{ name => 'ra',
			type => '1D',
			unit => 'degree',
			disp => 'F10.5',
			# $jobpar->read('ra')
		},
		{ name => 'dec',
			type => '1D',
			unit => 'degree',
			disp => 'F10.5',
			# $jobpar->read('dec')
		},
		{ name => 'roll_angle',
			type => '1D',
			unit => 'degree',
			disp => 'F10.5',
			# $jobpar->read('roll')
		},
		{ name => 'start_time',
			type => '24A',
			# ecat column ESTART
		},
		{ name => 'stop_time',
			type => '24A',
			# ecat column ESTOP
		},
		{ name => 'orig_obs_segment',
			type => '1J',
			disp => 'I3',
			null => -1,
		        # $jobpar->read('obs')
		},
		{ name => 'obs_segment',
			type => '1J',
			disp => 'I3',
			null => -1,
		},
		{ name => 'orig_obsid',
			type => '11A',
		},
		{ name => 'obsid',
			type => '11A',
		},
		{ name => 'exposure',
			type => '1E',
			unit => 's',
		},
		{ name => 'count',
			type => '1J',
			null => -1,
		},
		{ name => 'image_loss',
			type => '1E'
		},
		{ name => 'window_size',
			type => '80A',
		},
		{ name => 'binning',
			type => '1J',
		        null => -1,
		},
		{ name => 'filter',
			type => '80A',
			key => 'FILTER', # to string
		},
		{ name => 'operation_mode',
			type => '80A',
			# value IMAGE|EVENT|IMAGE&EVENT
		},
		{ name => 'pointing_mode',
			type => '80A',
			# SLEW|SETTLING|...
		},
		{ name => 'filename',
			type => '80A',
			# either IFILEREF or EFILEREF
		},
		{ name => 'extname',
			type => '80A',
			# either IMENAME
		},
		{ name => 'att_flag',
			type => '4A',
			# No source of info (yet)
		},
		{ name => 'submode',
			type => '4A',
			# Encode as a hex value string
		},
		{ name => 'led_bias',
			type => '1I',
		        null => -1,
			# Flood LED bias level
		},
	);

	my $db = Util::FITStable->new(\@db,
			log => $log,
			which => 'uvot',
			);


	my $path = $filename->get('hk', 'uvot', 'ct');
	unless( $path && -f $path ) {
		$log->entry("Unable to locate uvot exposure catalog");
		return;
	}

	my $uecat = Util::SimpleFITS->open("<$path");
	my $status = $uecat->status;
	if (not $uecat or $status) {
		$log->error(2, "unable to open uvot exposure catalog [$status]");
		return;
	}

	$uecat->move('EXPCATALOG');
	if ($uecat->status) {
		$log->error(2, 'unable to move to EXPCATALOG extension');
		return;
	}

	################################################
	# Compile the data needed for the UVOT db file
	################################################
	my $rows;
	$uecat->handle->get_num_rows($rows, $status);
	my @indef = ('INDEF') x $rows;

	# observation
	$db->set(name => [ ("'".$jobpar->read('object')."'") x $rows ]);
	$db->set(orig_target_id => [ ($jobpar->read('target')) x $rows ]);
	$db->set(target_id => [ (substr $jobpar->read('sequence'), 0, 8) x $rows ]);

        ####################################################################
        # Early observations (before PPSTs) had multiple pointings, so set
        # pointing to indef
        ####################################################################
        if( $jobpar->read('tstart') > 124383600 ){
	  $db->set(ra => [ (sprintf '%.5f', $jobpar->read('ra')) x $rows ]);
	  $db->set(dec => [ (sprintf '%.5f', $jobpar->read('dec')) x $rows ]);
	  $db->set(roll_angle => [ (sprintf '%.5f', $jobpar->read('roll')) x $rows ]);
	}else{
	  $db->set(ra => \@indef );
	  $db->set(dec => \@indef );
	  $db->set(roll_angle => \@indef );	  
	}

	# per exposure data
	my @estart;
	my @estop;
	my @segment;
	my @enet;
	my @windowDWX;
	my @windowDWY;
	my @windowEVX;
	my @windowEVY;
	my @binning;
	my @filterID;
	my @filterNum;
	my @efile;
	my @ifile;
        my @imename;
        my @mode;
        my @counts;
        my @gevents;
        my @gimage;
        my @submode;
        my @ledbias;
        my @expID;

	$status = $uecat
			->readcol('EXPID'    => TLONG,   [ ], \@expID)
			->readcol('ESTART'   => TDOUBLE, [ ], \@estart)
			->readcol('ESTOP'    => TDOUBLE, [ ], \@estop)
			->readcol('SEGMENT'  => TLONG,   [ ], \@segment)
			->readcol('ENET'     => TDOUBLE, [ ], \@enet)
			->readcol('DW_XSIZ ' => TLONG,   [ ], \@windowDWX)
			->readcol('DW_YSIZ'  => TLONG,   [ ], \@windowDWY)
			->readcol('EV_XSIZ ' => TLONG,   [ ], \@windowEVX)
			->readcol('EV_YSIZ'  => TLONG,   [ ], \@windowEVY)
			->readcol('BINLVL'   => TINT,    [ ], \@binning)
			->readcol('FILTERID' => TSTRING, [ ], \@filterID)
			->readcol('FILTER'   => TINT,    [ ], \@filterNum)
			->readcol('EFILEREF' => TSTRING, [ ], \@efile)
			->readcol('IFILEREF' => TSTRING, [ ], \@ifile)
			->readcol('IMENAME'  => TSTRING, [ ], \@imename)
			->readcol('MODEID'   => TINT,    [ ], \@mode)
			->readcol('NEVENTS'  => TLONG,   [ ], \@counts)
			->readcol('GEVENTS'  => TLONG,   [ ], \@gevents)
			->readcol('GIMAGE'   => TLONG,   [ ], \@gimage)
			->readcol('SUBMODE'  => TINT,    [ ], \@submode)
			->readcol('LEDFLOOD' => TINT,    [ ], \@ledbias)
			->status;

	if ($status) {
		$log->error(2, 'unable to read EXPCATALOG data');
		return;
	}

	my @start = map { $db->timeString($_) } @estart;
	my @stop = map { $db->timeString($_) } @estop;

	$db->set(start_time => \@start);
	$db->set(stop_time => \@stop);

	$db->set(orig_obs_segment => [ ($jobpar->read('obs')) x $rows ]);
	$db->set(obs_segment => [ (substr $jobpar->read('sequence'), 8, 3) x $rows ]);

	$db->set(orig_obsid => [ ($jobpar->read('target') . $jobpar->read('obs')) x $rows ]);
	$db->set(obsid => [ ($jobpar->read('sequence')) x $rows ]);

	$db->set(exposure => [map {$_=sprintf('%.5f',$_) unless /(INDEF|NULL)/ } @enet]);

	my @mode_name = map { "'". $modeNames->[$_] ."'" } @mode;
	$db->set(operation_mode => \@mode_name);

	my @window;
        my @gcount;
	for (my $i = 0; $i < $rows; ++$i) {
	  if( $mode_name[$i] =~ /Event/ ){
	    push(@gcount, $gevents[$i]);
	    push(@window, "'$windowEVX[$i] x $windowEVY[$i]'");
	  }else{
	    push(@gcount, $gimage[$i]);
	    push(@window, "'$windowDWX[$i] x $windowDWY[$i]'");
	  }
	}
	$db->set(window_size => \@window);
	$db->set(binning => \@binning);
	$db->set(filter => \@filterID);
	$db->set(count => \@gcount);

	my @filename = @indef;
        my @pointing_mode = @indef;
        my @asp_corr = @indef;
        my @image_loss = @indef;
	for (my $i = 0; $i < $rows; ++$i) {
	  my ($sky, $ext);
	  if( $efile[$i] ne 'NONE' ){
	    $filename[$i] = $efile[$i];
	    $pointing_mode[$i] = $efile[$i] =~ /po_uf.evt/ ? 'POINTING' : 'SLEW';

	    $sky = $filename->get('rawimage', 'uvot', $$Subs::UvotNames::filterCodes[$filterNum[$i]], 0);
	    $sky =~ s/_rw\./_sk./;
	    $ext = $$Subs::UvotNames::filterCodes[$filterNum[$i]] . $expID[$i] . 'E';
	  }elsif( $ifile[$i] ne 'NONE' ){
	    $sky = $ifile[$i];
	    $sky =~ s/_rw\./_sk./;
	    $ext = $imename[$i];

	    my $ifits = Util::FITSfile->new($ifile[$i], $imename[$i]); 
	    $pointing_mode[$i] = $ifits->keyword('OBS_MODE');
	    $filename[$i] = $ifile[$i];
	    #######################################################
	    # Determine the percentage of NULL pixels in the image
	    #######################################################
	    my $stats=Util::HEAdas->new("ftstat") 
                                  ->params({infile  => $ifits->fullname(),
					    centroid => 'no'})
				  ->verbose(0)
				  ->run();

	    my $parfile = $stats->parfile();
	    my $nulls = $parfile->read('null');
	    if( defined $nulls ){
	      $image_loss[$i] = 0;
	      if( $nulls ){
		$image_loss[$i] = $parfile->read('good') / $nulls;
		$image_loss[$i] = 1/(1+$image_loss[$i]);
	      }
	    }
	  }else{
	    $pointing_mode[$i] = 'UNKNOWN';
	  }
	  if($sky && -f $sky){
	    my $fsky = Util::FITSfile->new($sky, $ext);
	    $asp_corr[$i] = $fsky->keyword('ASPCORR') ? 'Y' : 'N';
	  }
	}
	$db->set(filename => \@filename);
        @imename = map {$_= $_ eq 'NONE' ? 'UNDEF' : $_} @imename; 
	$db->set(extname => \@imename);

	$db->set(pointing_mode => \@pointing_mode);
	$db->set(image_loss => \@image_loss);
        $db->set(att_flag => \@asp_corr);

	my @sub_string = map { "'0x". sprintf("%02x",$_) ."'" } @submode;
        $db->set(submode => \@sub_string);
        
        $db->set(led_bias => \@ledbias);

	my $outfile = $filename->get('uvdb', 'proc', '', 0);

	$db->write($outfile);

} # end of body method