Astro::FITS::HdrTrans::IRCAM - UKIRT IRCAM translations

  use Astro::FITS::HdrTrans::IRCAM;

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

 $Id$

package Astro::FITS::HdrTrans::IRCAM;

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

# Inherit from UKIRT "Old"
use base qw/ Astro::FITS::HdrTrans::UKIRTOld /;

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.

# Note that header merging fails with IRCAM in some cases because
# some items are duplicated in the .HEADER and .I1 but using different
# comment strings so the merging routine does not realise they are the
# same header. It is arguably an error that Astro::FITS::Header looks
# at comments.

my %UNIT_MAP = (
                AIRMASS_START        => 'AMSTART',
                # IRCAM Specific
                OBSERVATION_NUMBER   => 'RUN', # cf. OBSNUM
                DEC_TELESCOPE_OFFSET => 'DECOFF',
                DETECTOR_BIAS        => 'DET_BIAS',
                RA_TELESCOPE_OFFSET  => 'RAOFF',
               );

# END observation unit maps
my %ENDOBS_MAP = (
                  AIRMASS_END         => 'AMEND',
                  NUMBER_OF_EXPOSURES => 'NEXP', # need it from the last subheader
                 );

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

# Im

sub this_instrument {
  return qr/^IRCAM\d?/i;
}

sub to_DEC_SCALE {
  my $self = shift;
  my $FITS_headers = shift;
  my $scale;
  my $pixelsiz = $FITS_headers->{PIXELSIZ};
  my $ctype2 = $FITS_headers->{CTYPE2};
  my $cdelt2 = $FITS_headers->{CDELT2};
  my $utdate = $self->to_UTDATE( $FITS_headers );

  # The CDELTn headers may be part of a WCS in expressed in the AIPS-convention
  # measured in degrees (but protect against cases where it may have been in
  # arcsec).
  if ( defined( $cdelt2 ) && defined( $ctype2 ) && $ctype2 eq "DEC--TAN" ) {
    $scale = $cdelt2;
    if ( abs( $scale ) < 1.0E-3 ) {
      $scale *= 3600.0;
    }
  } else {
    $scale = $pixelsiz;
  }

  # Use the default scales.  The first IRCAM scale did vary with time,
  # but the information is no longer on the UKIRT web site.
  if ( ! defined( $scale ) ) {
    if ( $utdate > 19990901 ) {
      $scale = 0.08144;
    } else {
      $scale = 0.286;
    }
  }

  # Headers may be in scientific notation, but with a 'D' instead of
  # an 'E'.  Translate to an 'E' so Perl doesn't fall over.
  $scale =~ s/D/E/;

  return abs( $scale );
}

sub from_DEC_SCALE {
  my $self = shift;
  my $generic_headers = shift;
  my $scale = abs( $generic_headers->{DEC_SCALE} );

  # Need to find way to allow for new and old headers with differing units.
  return ( "PIXELSIZ", $scale );
}

sub to_POLARIMETRY {
  my $self = shift;
  my $FITS_headers = shift;
  if ( exists( $FITS_headers->{FILTER} ) &&
       $FITS_headers->{FILTER} =~ /pol/i ) {
    return 1;
  } else {
    return 0;
  }
}

sub to_RA_SCALE {
  my $self = shift;
  my $FITS_headers = shift;
  my $scale;
  my $pixelsiz = $FITS_headers->{PIXELSIZ};
  my $ctype1 = $FITS_headers->{CTYPE1};
  my $cdelt1 = $FITS_headers->{CDELT1};
  my $utdate = $self->to_UTDATE( $FITS_headers );

  # The CDELTn headers may be part of a WCS in expressed in the AIPS-convention
  # measured in degrees (but protect against cases where it may have been in
  # arcsec).
  if ( defined( $cdelt1 ) && defined( $ctype1 ) && $ctype1 eq "RA---TAN" ) {
    $scale = $cdelt1;
    if ( abs( $scale ) < 1.0E-3 ) {
      $scale *= 3600.0;
    }
  } else {
    $scale = $pixelsiz;
  }

  # Use the default scales.  The first IRCAM scale did vary with time,
  # but the information is no longer on the UKIRT web site.
  if ( ! defined( $scale ) ) {
    if ( $utdate > 19990901 ) {
      $scale = -0.08144;
    } else {
      $scale = -0.286;
    }
  }

  # Headers may be in scientific notation, but with a 'D' instead of
  # an 'E'.  Translate to an 'E' so Perl doesn't fall over.
  $scale =~ s/D/E/;

  # Correct erroneous positive RA scale in some headers.
  if ( $scale > 0.0 ) {
    $scale *= -1.0;
  }

  return $scale;
}

sub from_RA_SCALE {
  my $self = shift;
  my $generic_headers = shift;
  my $scale = abs( $generic_headers->{RA_SCALE} );

  # Need to find way to allow for new and old headers with differing units.
  return ( "PIXELSIZ", $scale );
}

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

  my $return;
  if ( defined( $FITS_headers->{SPD_GAIN} ) ) {
    $return = $FITS_headers->{SPD_GAIN};
  } else {
    my $detector_bias = $self->to_DETECTOR_BIAS( $FITS_headers );
    if ( $detector_bias > 0.61 && $detector_bias < 0.63 ) {
      $return = "Standard";
    } else {
      $return = "Deepwell";
    }
  }
  return $return;
}

sub from_SPEED_GAIN {
  my $self = shift;
  my $generic_headers = shift;
  return( "SPD_GAIN", $generic_headers->{"SPEED_GAIN"} )
}

sub from_TELESCOPE {
  my $self = shift;
  my $generic_headers = shift;
  my $utdate = $generic_headers->{'UTDATE'};
  if ( $utdate < 20000607 ) {
    return( "TELESCOP", "UKIRT, Mauna Kea, HI" );
  } else {
    return( "TELESCOP", "UKIRT,Mauna_Kea,HI" );
  }
}

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 = 129;
  }
  return $xref;
}

sub from_X_REFERENCE_PIXEL {
  my $self = shift;
  my $generic_headers = shift;
  return ( "CRPIX1", $generic_headers->{"X_REFERENCE_PIXEL"} );
}

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 = 129;
  }
  return $yref;
}

sub from_Y_REFERENCE_PIXEL {
  my $self = shift;
  my $generic_headers = shift;
  return ( "CRPIX2", $generic_headers->{"Y_REFERENCE_PIXEL"} );
}

1;