Astro::FITS::HdrTrans::MICHELLE - UKIRT Michelle translations

  use Astro::FITS::HdrTrans::MICHELLE;

  %gen = Astro::FITS::HdrTrans::MICHELLE->translate_from_FITS( %hdr );

 $Id$

package Astro::FITS::HdrTrans::MICHELLE;

use 5.006;
use warnings;
use strict;
use Carp;

# Inherit from UKIRT
# UKIRTNew must come first because of DATE-OBS handling
use base qw/ Astro::FITS::HdrTrans::UKIRTNew /;

use vars qw/ $VERSION /;

$VERSION = "1.50";

# for a constant mapping, there is no FITS header, just a generic
# header that is constant
my %CONST_MAP = (

                );

# unit mapping implies that the value propogates directly
# to the output with only a keyword name change

my %UNIT_MAP = (
                # Michelle Specific
                CHOP_ANGLE           => "CHPANGLE",
                CHOP_THROW           => "CHPTHROW",
                GRATING_DISPERSION   => "GRATDISP",
                GRATING_NAME         => "GRATNAME",
                GRATING_ORDER        => "GRATORD",
                GRATING_WAVELENGTH   => "GRATPOS",
                SAMPLING             => "SAMPLING",
                SLIT_ANGLE           => "SLITANG",

                # CGS4 compatible
                NSCAN_POSITIONS      => "DETNINCR",
                SCAN_INCREMENT       => "DETINCR",

                # UIST compatible
                NUMBER_OF_READS      => "NREADS",
                POLARIMETRY          => "POLARISE",
                SLIT_NAME            => "SLITNAME",

                # UIST + WFCAM compatible
                EXPOSURE_TIME        => "EXP_TIME",

                # UFTI + IRCAM compatible
                SPEED_GAIN           => "SPD_GAIN",

                # CGS4 + UIST + WFCAM
                CONFIGURATION_INDEX  => 'CNFINDEX',
               );

# Derived from end entry in subheader
my %ENDOBS_MAP = (
                  DETECTOR_INDEX => 'DINDEX',
                 );


# Create the translation methods
__PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP, undef, \%ENDOBS_MAP );

sub this_instrument {
  return "MICHELLE";
}

sub to_DEC_TELESCOPE_OFFSET {
  my $self = shift;
  my $FITS_headers = shift;
  my $decoff;

  # Determine the observation mode, e.g. spectroscopy or imaging.
  my $mode = $self->to_OBSERVATION_MODE($FITS_headers);
  if ( $mode eq 'spectroscopy' ) {

    # If the nod iterator is used, then telescope offsets always come out
    # as 0,0.  We need to check if we're in the B beam (the nodded
    # position) to figure out what the offset is using the chop angle
    # and throw.
    if ( exists( $FITS_headers->{CHOPBEAM} ) &&
         $FITS_headers->{CHOPBEAM} =~ /^B/ &&
         exists( $FITS_headers->{CHPANGLE} ) &&
         exists( $FITS_headers->{CHPTHROW} ) ) {

      my $pi = 4 * atan2( 1, 1 );
      my $throw = $FITS_headers->{CHPTHROW};
      my $angle = $FITS_headers->{CHPANGLE} * $pi / 180.0;
      $decoff = $throw * cos( $angle );
    } else {
      $decoff = $FITS_headers->{TDECOFF};
    }

    # Imaging.
  } else {
    $decoff = $FITS_headers->{TDECOFF};
  }

  return $decoff;
}

sub from_DEC_TELESCOPE_OFFSET {
  my $self = shift;
  my $generic_headers = shift;
  my $tdecoff;
  if ($generic_headers->{OBSERVATION_MODE} eq 'spectroscopy') {
    $tdecoff = 0.0;
  } else {
    $tdecoff = $generic_headers->{DEC_TELESCOPE_OFFSET};
  }
  return ("TDECOFF",$tdecoff);
}

sub to_DETECTOR_READ_TYPE {
  my $self = shift;
  my $FITS_headers = shift;

  # cut off date is 20040206
  my $read_type;
  for my $k (qw/ DET_MODE DETMODE /) {
    if (exists $FITS_headers->{$k}) {
      $read_type = $FITS_headers->{$k};
      last;
    }
  }
  return $read_type;
}

sub to_NUMBER_OF_OFFSETS {
  my $self = shift;
  my $FITS_headers = shift;

  # It's normally a ABBA pattern.  Add one for the final offset to 0,0.
  my $noffsets = 5;

  # Look for a defined header containing integers.
  if ( exists $FITS_headers->{NOFFSETS} ) {
    my $noff = $FITS_headers->{NOFFSETS};
    if ( defined $noff && $noff =~ /\d+/ ) {
      $noffsets = $noff;
    }
  }
  return $noffsets;
}

sub to_OBSERVATION_MODE {
  my $self = shift;
  my $FITS_headers = shift;

  my $mode;
  # 20040206
  for my $k (qw/ INSTMODE CAMERA /) {
    if (exists $FITS_headers->{$k}) {
      $mode = $FITS_headers->{$k};
      last;
    }
  }
  return $mode;
}

sub _to_RA_TELESCOPE_OFFSET {
  my $self = shift;
  my $FITS_headers = shift;
  my $raoff;

  # Determine the observation mode, e.g. spectroscopy or imaging.
  my $mode = $self->to_OBSERVATION_MODE($FITS_headers);
  if ( $mode eq 'spectroscopy' ) {

    # If the nod iterator is used, then telescope offsets always come out
    # as 0,0.  We need to check if we're in the B beam (the nodded
    # position) to figure out what the offset is using the chop angle
    # and throw.
    if ( exists( $FITS_headers->{CHOPBEAM} ) &&
         $FITS_headers->{CHOPBEAM} =~ /^B/ &&
         exists( $FITS_headers->{CHPANGLE} ) &&
         exists( $FITS_headers->{CHPTHROW} ) ) {
      my $pi = 4 * atan2( 1, 1 );
      my $throw = $FITS_headers->{CHPTHROW};
      my $angle = $FITS_headers->{CHPANGLE} * $pi / 180.0;
      $raoff = $throw * sin( $angle );

    } else {
      $raoff = $FITS_headers->{TRAOFF};
    }

    # Imaging.
  } else {
    $raoff = $FITS_headers->{TRAOFF};
  }
  return $raoff;
}

sub from_TELESCOPE {
  my $self = shift;
  my $generic_headers = shift;
  my $utdate = $generic_headers->{'UTDATE'};
  if ( $utdate < 20010906 ) {
    return( "TELESCOP", "UKATC" );
  } else {
    return( "TELESCOP", "UKIRT" );
  }
}

sub to_X_REFERENCE_PIXEL{
  my $self = shift;
  my $FITS_headers = shift;
  my $xref;

  # Use the average of the bounds to define the centre.
  if ( exists $FITS_headers->{RDOUT_X1} && exists $FITS_headers->{RDOUT_X2} ) {
    my $xl = $FITS_headers->{RDOUT_X1};
    my $xu = $FITS_headers->{RDOUT_X2};
    $xref = $self->nint( ( $xl + $xu ) / 2 );

    # Use a default of the centre of the full array.
  } else {
    $xref = 161;
  }
  return $xref;
}

sub from_X_REFERENCE_PIXEL {
  my $self = shift;
  return ("CRPIX1", 1.0);
}

sub to_Y_REFERENCE_PIXEL{
  my $self = shift;
  my $FITS_headers = shift;
  my $yref;

  # Use the average of the bounds to define the centre.
  if ( exists $FITS_headers->{RDOUT_Y1} && exists $FITS_headers->{RDOUT_Y2} ) {
    my $yl = $FITS_headers->{RDOUT_Y1};
    my $yu = $FITS_headers->{RDOUT_Y2};
    $yref = $self->nint( ( $yl + $yu ) / 2 );

    # Use a default of the centre of the full array.
  } else {
    $yref = 121;
  }
  return $yref;
}

sub from_Y_REFERENCE_PIXEL {
  my $self = shift;
  return ("CRPIX2", 1.0);
}

1;