view release on metacpan or  search on metacpan

lib/Astro/FITS/HdrTrans/ACSIS.pm  view on Meta::CPAN

=cut

sub to_VELOCITY {
  my $self = shift;
  my $FITS_headers = shift;
  my $frameset = shift;

  my $velocity = undef;
  if ( defined( $frameset ) &&
       UNIVERSAL::isa( $frameset, "Starlink::AST::FrameSet" ) ) {

    my $sourcesys = "VRAD";
    if ( defined( $FITS_headers->{'DOPPLER'} ) ) {
      if ( $FITS_headers->{'DOPPLER'} =~ /rad/i ) {
        $sourcesys = "VRAD";
      } elsif ( $FITS_headers->{'DOPPLER'} =~ /opt/i ) {
        $sourcesys = "VOPT";
      } elsif ( $FITS_headers->{'DOPPLER'} =~ /red/i ) {
        $sourcesys = "REDSHIFT";
      }
    }
    # Sometimes we do not have a spec frame (broken files)
    eval {
      $frameset->Set( sourcesys => $sourcesys );
      $velocity = $frameset->Get( "sourcevel" );
    };
  } else {

    # We weren't passed a frameset, so try using other headers.
    if ( exists( $FITS_headers->{'DOPPLER'} ) &&
         ( exists( $FITS_headers->{'ZSOURCE'} ) ||
           exists( $FITS_headers->{'SUBHEADERS'}->[0]->{'ZSOURCE'} ) ) ) {
      my $doppler = uc( $FITS_headers->{'DOPPLER'} );
      my $zsource = exists( $FITS_headers->{'ZSOURCE'} ) ?
        $FITS_headers->{'ZSOURCE'}           :
          $FITS_headers->{'SUBHEADERS'}->[0]->{'ZSOURCE'};

      if ( $doppler eq 'REDSHIFT' ) {
        $velocity = $zsource;
      } elsif ( $doppler eq 'OPTICAL' ) {
        $velocity = $zsource * CLIGHT;
      } elsif ( $doppler eq 'RADIO' ) {
        $velocity = ( CLIGHT * $zsource ) / ( 1 + $zsource );
      }
    }
  }

  return $velocity;
}

=item B<to_SUBSYSTEM_IDKEY>

=cut

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

  # Try the general headers first
  my $general = $self->SUPER::to_SUBSYSTEM_IDKEY( $FITS_headers );
  return ( defined $general ? $general : "SUBSYSNR" );
}


=item B<_is_FSW>

Helper function to determine if we are doing frequency switch.

=cut

sub _is_FSW {
  my $class = shift;
  my $FITS_headers = shift;

  my $fsw = $FITS_headers->{SW_MODE};

  if ( defined( $fsw ) &&
       $fsw =~ /freqsw/i ) {
    return 1;
  }
  return 0;
}

=back

=head1 SEE ALSO

C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::Base>

=head1 AUTHORS

Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>,
Brad Cavanagh E<lt>b.cavanagh@jach.hawaii.eduE<gt>.

=head1 COPYRIGHT

Copyright (C) 2016 East Asian Observatory.
Copyright (C) 2007-2013, 2016 Science and Technology Facilities Council.
Copyright (C) 2005-2007 Particle Physics and Astronomy Research Council.
All Rights Reserved.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful,but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place,Suite 330, Boston, MA  02111-1307, USA

=cut

1;