view release on metacpan or  search on metacpan

Astro/Misc.pm  view on Meta::CPAN

	     \S+\s+                                # Polar
	     (\d+\.\d*(?:[Ee][\-+]\d+)?)\s+        # Frequency
	     ([-+]?\d+\.\d*(?:[Ee][\-+]\d+)?)\s+   # Velocity
	     ([-+]?\d+\.\d*(?:[Ee][\-+]\d+)?)\s+   # Amplitude - Real
	     ([-+]?\d+\.\d*)                       # Phase - Imag
		 /x) {

      $n++;
      push(@{$$hashref{CHANNEL}},$1);
      push(@{$$hashref{FREQUENCY}},$2);
      push(@{$$hashref{VELOCITY}},$3);
      push(@{$$hashref{AMPLITUDE}},$4);
      push(@{$$hashref{PHASE}},$5);
    } elsif (/\s*\d+.*FLAGGED/) {

    } elsif (/Header/) {  #Next plot
      $eof = 0;
      last;
    } else {
      print STDERR '** ';
      print STDERR;
    }
  }

  croak "$0: No Data read\n" if ($n == 0);

  return $eof;

}

=item B<read_lovas>

 Read_lovas read the Lovas "Recommended Rest Frequencies for Observed
 Interstellar Molecular Microwave Transitions - 1991 Revision"
 (J. Phys. Chem. Ref. Data, 21, 181-272, 1992). Alpha quality!!

   my @lovas = read_lovas($fname);
   my @lovas = read_lovas($fname, $minfreq, $maxfreq);

=cut

# Probably does not work !!!
sub read_lovas ($;$$) {
  warn 'Using Beta routine';
  my($fname, $min, $max) = @_;

  if (!open(LOVAS, $fname)) {
    carp "Could not open $fname: $!\n";
    return undef;
  }

  my ($freq, $calc, $uncert, $molecule, $form, $tsys, $source, $telescope, $ref);
  my @lovas = ();

  while (<LOVAS>) {
    chomp;

    $freq = substr $_, 1, 16;
    $molecule = substr $_, 18, 11;
    $form = substr $_, 29, 28;
    $c = substr $_, 57, 1;  # Could be either formulae or Tsys
    $tsys = substr $_, 58, 7;
    $source = substr $_, 65, 15;
    $telescope = substr $_, 81, 12;
    $ref = substr $_, 94;

    # Clean up the strings

    $freq =~ s/^\s+//;
    $freq =~ s/\s+$//;
    $molecule =~ s/^\s+//;
    $molecule =~ s/\s+$//;
    $source =~ s/^\s+//;
    $source =~ s/\s+$//;
    $telescope =~ s/^\s+//;
    $telescope =~ s/\s+$//;
    $ref =~ s/^\s+//;
    $ref =~ s/\s+$//;

    # Work out the contended column 57;
    if ($c ne ' ') {

      my ($s1) = $tsys =~ /^(\s+)/;
      my ($s2) = $form =~ /(\s+)$/;
      # Assign column 57 to the field with the "nearest"  non-blank (preference 
      # to Tsys).
      if (!defined $s1) {
	$tsys = "$c$tsys";
      } elsif (!defined $s2) {
	$form .= $c;
      }	elsif (length($s2) > length($s1)) {
	$tsys = "$c$tsys";
      } else {
	$form .= $c;
      }
    }

    $form =~ s/^\s+//;
    $form =~ s/\s+$//;
    $tsys =~ s/^\s+//;
    $tsys =~ s/\s+$//;

    # Clean up unidentified molecules
    if ($molecule eq 'unidentifie') {
      $molecule .= $form;
      $form = '';
    }

    if ($freq =~ /(.*)\*$/) {
      my $oldfreq = $freq;
      $freq = $1;
      $calc = 1;
      $freq =~ s/\s+$//;
      print "Using $oldfreq -> \"$freq\"\n";
    } else {
      $calc = 0;
    }

    if ($freq =~ /([^\s\*\(]*[\d\.])\s*(\*)?\s*(\(\s*\d+\))?/) {
      my $oldfreq = $freq;
      $freq = $1;