PaxHeader/Astro-0.78000755 374311 777777 00000000170 12517544347 015330 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178023 23 SCHILY.dev=16777217 24 SCHILY.ino=170391184 19 SCHILY.nlink=10 Astro-0.78/000755 374311 110351500000000000 12517544347 013421 5ustar00phi196at-astro000000 000000 Astro-0.78/PaxHeader/Astro000755 374311 777777 00000000167 12517544347 016426 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178023 23 SCHILY.dev=16777217 24 SCHILY.ino=170391187 18 SCHILY.nlink=5 Astro-0.78/Astro/000755 374311 110351500000000000 12517544347 014511 5ustar00phi196at-astro000000 000000 Astro-0.78/PaxHeader/Changes000644 374311 777777 00000000167 12517544341 016675 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178017 23 SCHILY.dev=16777217 24 SCHILY.ino=170391050 18 SCHILY.nlink=2 Astro-0.78/Changes000644 374311 110351500000003346 12517544341 014714 0ustar00phi196at-astro000000 000000 0.01 Oct 16 1999 - original version based on astro.pm 0.02 Nov 10 1999 - Bug fixes, documentation updates and Misc.pm 0.03 Nov 15 1999 - Bug fixes - Order of returned parameters in mjd2dayno - Calling order in coord_convert - Assuming radians not turns in kindist - Forgot to export routines in Misc.pm - Fixed spelling in PODs 0.5 Nov 19 1999 - First CPAN release - Added README and minor changes 0.51 Nov 17 2000 - Minor Changes - Added j2gal routine 0.6 Nov 2 2001 - Replace J2000 <-> B1950 routines with copies of SLALIB routines - Updated calc_Nl (and bug fix) - Replace Panagia spectral type values by Thompson 0.61 Sep 26 2002 - Allow Bepoch to be set (via "global variable") for fk4fk5 routine. - rad2turn and turn2rad change to accept array of values 0.62-0.63 ?? 0.64 19 Aug 2004 - Fixed minor bug in lst2mjd (error <= 4min in conversion) 0.65 11 Jan 2006 - Fixed fract second error in time2hms - Missing wrapper for fk5fk4r (used in coord_convert) 0.66 12 Jan 2006 - Added support for PDL in Coord.pm - more work probably is needed 0.67 13 Jan 2006 - Minor mistake in PDL support 0.68 22 Jan 2006 - deg2turn and turn2deg work on arrays - Merge galfk4 and galfk4r 0.69 23 Nov 2006 - Added mjd2time function 0.70 27 Jul 2007 - Added month2str and str2month 0.71 18 Aug 2008 - Added $np option to mjd2time 0.72 28 Apr 2010 - Acutally add str2month 0.73 19 Aug 2010 - Added optional argument to eqazel to allow negative ha and az returned 0.74 11 Mar 2011 - Added mjd2weekday and mjd2weekdaystr 0.75 19 Feb 2012 - Added doco for last few functions added 0.76 13 Aug 2014 - Added mjd2epoch 0.77 15 Aug 2014 - Added mjd2vextime 0.78 28 Apr 2015 - Bump version number due to CPAN issue. No real changes Astro-0.78/PaxHeader/Makefile.PL000644 374311 777777 00000000167 12517544304 017353 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178020 23 SCHILY.dev=16777217 24 SCHILY.ino=170391038 18 SCHILY.nlink=2 Astro-0.78/Makefile.PL000644 374311 110351500000000264 12517544304 015366 0ustar00phi196at-astro000000 000000 use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Astro', VERSION => '0.78', DISTNAME => 'Astro', dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz'} ); Astro-0.78/PaxHeader/MANIFEST000644 374311 777777 00000000167 12373304611 016525 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178023 23 SCHILY.dev=16777217 24 SCHILY.ino=170391192 18 SCHILY.nlink=1 Astro-0.78/MANIFEST000644 374311 110351500000000372 12373304611 014540 0ustar00phi196at-astro000000 000000 README Changes MANIFEST Makefile.PL Astro/Time.pm Astro/Coord.pm Astro/Misc.pm test.pl META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Astro-0.78/PaxHeader/META.json000644 374311 777777 00000000167 12517544347 017031 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178023 23 SCHILY.dev=16777217 24 SCHILY.ino=170391199 18 SCHILY.nlink=1 Astro-0.78/META.json000644 374311 110351500000001421 12517544347 015040 0ustar00phi196at-astro000000 000000 { "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Astro", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "version" : "0.78" } Astro-0.78/PaxHeader/META.yml000644 374311 777777 00000000167 12517544347 016661 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178023 23 SCHILY.dev=16777217 24 SCHILY.ino=170391198 18 SCHILY.nlink=1 Astro-0.78/META.yml000644 374311 110351500000000647 12517544347 014701 0ustar00phi196at-astro000000 000000 --- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Astro no_index: directory: - t - inc requires: {} version: 0.78 Astro-0.78/PaxHeader/README000644 374311 777777 00000000165 11204157752 016256 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1423805116 23 SCHILY.dev=16777217 22 SCHILY.ino=9318476 18 SCHILY.nlink=2 Astro-0.78/README000644 374311 110351500000003666 11204157752 014304 0ustar00phi196at-astro000000 000000 Astro:: - Assorted astronomical routines Astro::Time, Astro::Coord and Astro::Misc provide a collection of useful astronomical routines written entirely in Perl (so no hassling about installing external libraries is required). The routines provided include various time conversions (dayno to day/month, local sidereal time, calendar to Modified Julian day) and coordinate transformations (J2000 to B1950, B1950 to Galactic, Az,El to Ha,Dec), string parsing (12:00:00 -> 0.5) as well as a number of astronomical tools (eg observed Galactic velocity to kinematic distance). These routines should be used at your own risk! Most should give reasonable accurate results, but spot checks against your favorite program are recommenced. The B1950/J2000/Galactic coordinate routines are based on SLALIB routines and agree very closely. Please let me know of any bugs you find or if you have other routines you would like to contribute. Requirements: ------------- Only perl. Developed using version 5.6 on Solaris and Linux. Where can I get it from? ------------------------ http://www.perl.com/CPAN-local/modules/by-module/Astro/Astro-?.tar.gz Installation: ------------ % perl Makefile.PL % make % make test % make install Documentation: -------------- Documentation is included in the three modules as POD. Man files should be created in the installation process. Changes: -------- See the Changes file Author: ------- Chris Phillips, CSIRO, Australia Telescope National Facility Chris.Phillips@csiro.au Acknowledgment: --------------- Simon Ellingsen wrote most of the routines in Coord.pm A few of the routines are based in code from Edward King Copyright --------- This module is copyright (C) 1999-2009 Chris Phillips. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The J2000/B1950 routines are based on the FORTRAN version of SLALIB, which is under the GPL. Astro-0.78/PaxHeader/test.pl000755 374311 777777 00000000233 12372524253 016712 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1423805116 38 LIBARCHIVE.creationtime=1299838319 23 SCHILY.dev=16777217 22 SCHILY.ino=9318477 18 SCHILY.nlink=2 Astro-0.78/test.pl000755 374311 110351500000014516 12372524253 014740 0ustar00phi196at-astro000000 000000 #!/usr/local/perl -w use Astro::Time; use Astro::Coord; use Astro::Misc; use strict; my ($day, $month, $dayno, $year, $ut, $mjd, $dUT1, $gst, $lmst, $i); my ($turn, $deg, $rad, $hour, $minute, $sec, $l, $b); my ($str, $ra, $dec, $x, $y, $az, $el, $ha, $nra, $ndec); $day = 17; $month = 11; $year = 1997; my $longitude = 0.417; my $latitude = 0.141; $str = '12:34:45.4'; $turn = str2turn($str, 'H'); printf "str2turn: $str ==> %.4f\n", $turn; $str = turn2str($turn, 'H', 1); printf "turn2str: %.4f ==> $str\n", $turn; $str = '-45 34 12.9'; $turn = str2turn($str, 'D'); printf "str2turn: $str ==> %.4f\n", $turn; $Astro::Time::StrSep = ' '; $str = turn2str($turn, 'D', 1); printf "turn2str: %.4f ==> $str\n", $turn; $str = '13h23m45.3s'; $turn = str2turn($str, 'H'); printf "str2turn: $str ==> %.4f\n", $turn; $Astro::Time::StrSep = 'hms'; $str = turn2str($turn, 'H', 1); printf "turn2str: %.4f ==> $str\n", $turn; $str = '13d03\'45.3"'; $turn = str2turn($str, 'H'); # Note 'H' gets ignored printf "str2turn: $str ==> %.4f\n", $turn; $str = turn2str($turn, 'D', 1, 'deg'); printf "turn2str: %.4f ==> $str\n", $turn; $hour = 12; $minute = 33; $sec = 47; $ut = hms2time($hour, $minute, $sec); printf("hms2time: %02d/%02d/%02d ==> %s\n", $hour, $minute, $sec, turn2str($ut, 'H', 0, ':')); $rad = 0.45; $deg = rad2deg($rad); printf "rad2deg: $rad Radians ==> %.2f degrees\n", $deg; $turn = deg2turn($deg); printf "deg2turn: %.2f degrees ==> %.3f Turns\n", $deg, $turn; $dayno = cal2dayno($day, $month, $year); print "cal2dayno: $day/$month/$year ==> $dayno/$year\n"; ($day, $month) = dayno2cal($dayno, $year); print "dayno2cal: $dayno/$year ==> $day/$month/$year\n"; print "yesterday: The day before $day/$month/$year is "; ($day, $month, $year) = yesterday($day, $month, $year); print "$day/$month/$year\n"; print "Tomorrow: The day after $dayno/$year is "; ($dayno, $year) = tomorrow($dayno, $year); print "$dayno/$year\n"; print "leap:\n"; for ($i=1996; $i<2001; $i++) { if (leap($i)) { print " $i is a leap year\n"; } else { print " $i is NOT a leap year\n"; } } $mjd = now2mjd(); printf "now2mjd: Current MJD = %.2f\n", $mjd; $Astro::Time::StrSep = 'hms'; ($day, $month, $year, $ut) = mjd2cal($mjd); printf("mjd2cal: MJD %.2f ==> %02d/%02d/$year (%s)\n", $mjd, $day, $month, turn2str($ut, 'H', 0)); $mjd = cal2mjd($day, $month, $year, $ut); printf("cal2mjd: %02d/%02d/$year (%s) ==> MJD %.2f \n", $day, $month, turn2str($ut, 'H', 0), $mjd); $Astro::Time::StrSep = ':'; ($dayno, $year, $ut) = mjd2dayno($mjd); printf("mjd2dayno: MJD %.2f ==> %03d/$year (%s)\n", $mjd, $dayno, turn2str($ut,'H',0)); $mjd = dayno2mjd($dayno, $year, $ut); printf("dayno2mjd: %03d/$year (%s) ==> MJD %.2f\n", $dayno, turn2str($ut,'H',0), $mjd); my $mstr = month2str($month); printf("month2str: $month is $mstr\n"); my $dow = mjd2weekday($mjd); my $dowstr = mjd2weekdaystr($mjd, 1); printf("Day of week:$dow $dowstr\n"); $dUT1 = -0.2; $gst = gst($mjd, $dUT1); printf("gst: MJD %.2f (dUT1=$dUT1) ==> GMST %s\n", $mjd, turn2str($gst,'H',0)); $Astro::Time::StrSep = 'hms'; $lmst = cal2lst($day, $month, $year, $ut, $longitude); printf("cal2lst: $day/$month/$year (%s) at %s ==> LMST %s\n", turn2str($ut, 'H', 0), turn2str($longitude, 'D', 1, ':'), turn2str($lmst, 'H', 0)); $lmst = dayno2lst($dayno, $year, $ut, $longitude); printf("dayno2lst: $dayno/$year (%s) at %s ==> LMST %s\n", turn2str($ut, 'H', 0), turn2str($longitude, 'D', 1, ':'), turn2str($lmst, 'H', 0)); $lmst = mjd2lst($mjd, $longitude, $dUT1); printf("mjd2lst: MJD %.6f at %s ==> LMST %s\n", $mjd, turn2str($longitude, 'D', 1, ':'), turn2str($lmst, 'H', 2)); $mjd = lst2mjd($lmst, $dayno, $year, $longitude); printf("lst2mjd: LST %s on $dayno/$year \@ %s ==> MJD %.6f\n", turn2str($lmst,'H',2,'hms'), turn2str($longitude,'D',0,':'), $mjd); $Astro::Time::StrSep = ':'; my $time = mjd2epoch($mjd); printf("mjd2epoch: MJD %.6f is Unix Epoch %d\n", $mjd, $time); $ra = 0.5356; $dec = 0.1025; my ($lst_rise, $lst_set) = rise($ra, $dec, $latitude, deg2turn(15)); printf("rise: %s,%s at %s rise between %s - %s lst\n", turn2str($ra, 'H', 0), turn2str($dec, 'D', 0), turn2str($latitude, 'D', 0), turn2str($lst_rise, 'H', 0), turn2str($lst_set, 'H', 0)); $x = deg2turn(-15.585); $y = deg2turn(+11.507); ($az, $el) = xy2azel($x, $y); printf("xy2azel: %s,%s ==> %s,%s\n", turn2str($x,'D',0), turn2str($y,'D',0), turn2str($az,'D',0), turn2str($el,'D',0)); ($x, $y) = azel2xy($az, $el); printf("azel2xy: %s,%s ==> %s,%s\n", turn2str($az,'D',0), turn2str($el,'D',0), turn2str($x,'D',0), turn2str($y,'D',0)); ($ha, $dec) = eqazel($az, $el, $latitude,1); printf("eqazel: %s,%s ==> %s,%s (azel->hadec)\n", turn2str($az,'D',0), turn2str($el,'D',0), turn2str($ha,'H',0), turn2str($dec,'D',0)); ($ha, $dec) = eqazel($az, $el, $latitude); printf("eqazel: %s,%s ==> %s,%s (azel->hadec)\n", turn2str($az,'D',0), turn2str($el,'D',0), turn2str($ha,'H',0), turn2str($dec,'D',0)); ($az, $el) = eqazel($ha, $dec, $latitude); printf("eqazel: %s,%s ==> %s,%s (hadec->azel)\n", turn2str($ha,'H',0), turn2str($dec,'D',0), turn2str($az,'D',0), turn2str($el,'D',0)); ($nra, $ndec) = fk4fk5($ra, $dec); printf("fk4fk5: %s,%s => %s,%s\n", turn2str($ra,'H',0), turn2str($dec,'D',0), turn2str($nra,'H',0), turn2str($ndec,'D',0)); ($ra, $dec) = fk5fk4($nra, $ndec); printf("fk5fk4: %s,%s => %s,%s\n", turn2str($nra,'H',0), turn2str($ndec,'D',0), turn2str($ra,'H',0), turn2str($dec,'D',0)); ($l, $b) = fk4gal($ra, $dec); printf("fk4gal: %s,%s => %s,%s\n", turn2str($ra,'H',0), turn2str($dec,'D',0), turn2str($l,'D',0), turn2str($b,'D',0)); ($ra, $dec) = galfk4($l, $b); printf("galfk4: %s,%s => %s,%s\n", turn2str($l,'D',0), turn2str($b,'D',0), turn2str($ra,'H',0), turn2str($dec,'D',0)); $dec = 0.2; ($az, $el) = coord_convert($ra, $dec, 4, 1, $mjd, $longitude, $latitude, 0.00005); printf("coord_convert: Source %s, %s\n", turn2str($ra,'H',0), turn2str($dec,'D',0)); printf(" MJD %.2f\n", $mjd); printf(" Observatory %s, %s\n", turn2str($longitude,'D',0,'deg'), turn2str($latitude,'D',0,'deg')); printf(" ==> az,el %s, %s\n", turn2str($az,'D',0), turn2str($el,'D',0)); Astro-0.78/Astro/PaxHeader/Coord.pm000644 374311 777777 00000000165 11502312610 020055 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178020 23 SCHILY.dev=16777217 22 SCHILY.ino=9318478 18 SCHILY.nlink=2 Astro-0.78/Astro/Coord.pm000644 374311 110351500000171372 11502312610 016103 0ustar00phi196at-astro000000 000000 package Astro::Coord; use strict; =head1 NAME Astro::Coord - Astronomical coordinate transformations =head1 SYNOPSIS use Astro::Coord; ($l, $b) = fk4gal($ra, $dec); ($az, $el) = eqazel($ha, $dec, $latitude); =head1 DESCRIPTION Astro::Coord contains an assorted set Perl routines for coordinate conversions, such as hour angle to elevation and J2000 to B1950. =head1 AUTHOR Chris Phillips Chris.Phillips@csiro.au =head1 FUNCTIONS =cut BEGIN { use Exporter (); use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL $bepoch ); $VERSION = '1.43'; @ISA = qw(Exporter); @EXPORT = qw( xy2azel azel2xy eqazel J2000todate fk4fk5 fk5fk4 fk4gal galfk4 j2gal coord_convert haset_ewxy ewxy_tlos haset_azel azel_tlos antenna_rise pol2r r2pol ); @EXPORT_OK = qw ( fk4fk5r fk5fk4r fk4galr galfk4r ephem_vars nutate precsn $bepoch ); @EXPORT_FAIL = qw ( ); use Carp; use POSIX qw( asin acos fmod tan ); use Astro::Time qw( $PI rad2turn turn2rad mjd2lst ); } $bepoch = 1950.0; use constant JULIAN_DAY_J2000 => 2451545.0; use constant JULIAN_DAYS_IN_CENTURY => 36525.0; # The E-terms vector for FK4 <--> other coordinate system transforms # (used in fk4fk5 fk5fk4 fk4gal galfk4) my @eterm = (-1.62557E-06, -0.31919E-06, -0.13843E-06); ## The precession matrix for FK4 <--> FK5 conversions (used in ## fk4fk5 and fk5fk4) #my @btoj = ([+0.999925678186902,-0.011182059642247,-0.004857946558960], # [+0.011182059571766,+0.999937478448132,-0.000027176441185], # [+0.004857946721186,-0.000027147426498,+0.999988199738770]); # The precession matrix for FK4 <--> Galactic conversions (used in # fk4gal and galfk4) my @etog = ([-0.066988739415,-0.872755765852,-0.483538914632], [+0.492728466075,-0.450346958020,+0.744584633283], [-0.867600811151,-0.188374601723,+0.460199784784]); # Values used in SLALIB routines use constant D2PI => 6.283185307179586476925287; # Radians per year to arcsec per century use constant PMF => 100*60*60*360/D2PI; # Small number to avoid arithmetic problems use constant TINY => 1e-30; # Km per sec to AU per tropical century # = 86400 * 36524.2198782 / 149597870 use constant VF => 21.095; # Vectors A and Adot, and matrix M my @a = ( -1.62557e-6, -0.31919e-6, -0.13843e-6, +1.245e-3, -1.580e-3, -0.659e-3); my @ad =(+1.245e-3, -1.580e-3, -0.659e-3); my @em = ([+0.9999256782, -0.0111820611, -0.0048579477], [+0.0111820610, +0.9999374784, -0.0000271765], [+0.0048579479, -0.0000271474, +0.9999881997], [-0.000551, -0.238565, +0.435739], [+0.238514, -0.002667, -0.008541], [-0.435623, +0.012254, +0.002117]); my @emi = ([+0.9999256795, +0.0111814828, +0.0048590039, -0.00000242389840, -0.00000002710544, -0.00000001177742], [-0.0111814828, +0.9999374849, -0.0000271771, +0.00000002710544, -0.00000242392702, +0.00000000006585], [-0.0048590040, -0.0000271557, +0.9999881946, +0.00000001177742, +0.00000000006585, -0.00000242404995], [-0.000551, +0.238509, -0.435614, +0.99990432, +0.01118145, +0.00485852], [-0.238560, -0.002667, +0.012254, -0.01118145, +0.99991613, -0.00002717], [+0.435730, -0.008541, +0.002117, -0.00485852, -0.00002716, +0.99996684]); =item B ($x, $y, $z) = pol2r($polar1, $polar2); Converts a position in polar coordinates into rectangular coordinates $polar1, $polar2 The polar coordinates to convert (turns) $x, $y, $z The rectangular coordinates =cut sub pol2r ($$) { my ($p1, $p2) = @_; # Converts polar coordinates into rectangluar my @rect; $rect[0] = cos(turn2rad($p1))*cos(turn2rad($p2)); $rect[1] = sin(turn2rad($p1))*cos(turn2rad($p2)); $rect[2] = sin(turn2rad($p2)); return(@rect); } =item B ($polar1, $polar2) = r2pol($x, $y, $z); Converts a position in rectangular coordinates into polar coordinates $x, $y, $y The rectangular coordinates to convert $polar1, $polar2 The polar coordinates (turns); Returns undef if too few or too many arguments are passed. =cut sub r2pol (@) { # First check that we have 3 arguments if (scalar @_ != 3) { carp 'Inconsistent arguments'; return undef ; } my ($x, $y, $z) = @_; # Converts rectangular coordinates to polar my ($tmp, $left, $right); $tmp = atan2($y, $x)/(2.0*$PI); if (ref($tmp) =~ /PDL/ ) { # Allow to work with PDL $tmp -> where($tmp<0.0) .= $tmp -> where($tmp<0.0) + 1.0; } elsif ($tmp < 0.0) { $tmp += 1.0; } $left = $tmp; $tmp = sqrt($x*$x + $y*$y + $z*$z); if (ref($tmp) =~ /PDL/) { # Allow to work with PDL $right = &PDL::Math::asin($z/$tmp)/(2.0*$PI); } else { $right = asin($z/$tmp)/(2.0*$PI); } return ($left, $right); } =item B ($az, $el) = xy2azel($x, $y); Converts a telescope position in X,Y coordinates into Az,El coordinates $x, $y The X and Y coordinates (turns) $az, $el The azimuth and elevation (turns) =cut sub xy2azel ($$) { my ($x, $y) = @_; # Convert a position in X,Y to Az,El my @polar = pol2r($x, $y); my $temp = $polar[0]; $polar[0] = $polar[1]; $polar[1] = $polar[2]; $polar[2] = $temp; return (r2pol(@polar)); } =item B ($x, $y) = azel2xy($az, $el); Converts a position in Az,El coordinates into X,Y coordinates $az, $el The azimuth and elevation (turns) $x, $y The X and Y coordinate (turns) =cut sub azel2xy ($$) { my ($az, $el) = @_; # Convert a position in Az,El to X,Y my @polar = pol2r($az, $el); my $temp = $polar[1]; $polar[1] = $polar[0]; $polar[0] = $polar[2]; $polar[2] = $temp; my ($x, $y) = r2pol(@polar); if ($x>0.5) { $x -= 1.0; } if ($y>0.5) { $y -= 1.0; } return ($x, $y); } =item B ($ha, $dec) = eqazel($az, $el, $latitude); ($az, $el) = eqazel($ha, $dec, $latitude); ($ha, $dec) = eqazel($az, $el, $latitude, $allownegative); Converts HA/Dec coordinates to Az/El and vice versa. $ha, $dec Hour angle and declination of source (turns) $az, $el Azimuth and elevation of source (turns) $latitude Latitude of the observatory (turns) $allownegative If true, allow negative $ha or $az on return (Optional) Note: The ha,dec and az,el conversion is symmetrical =cut sub eqazel ($$$;$) { my $sphi = sin(turn2rad($_[2])); my $cphi = cos(turn2rad($_[2])); my $sleft = sin(turn2rad($_[0])); my $cleft = cos(turn2rad($_[0])); my $sright = sin(turn2rad($_[1])); my $cright = cos(turn2rad($_[1])); my $left_out = atan2(-$sleft,-$cleft*$sphi+$sright*$cphi/$cright)/(2.0*$PI); $left_out = ($left_out < 0.0) ? $left_out + 1.0 : $left_out if (!(defined $_[3] && $_[3])); my $right_out= asin($cleft*$cright*$cphi + $sright*$sphi)/(2.0*$PI); return($left_out, $right_out); } =item B ($JRA, $JDec) = fk4fk5($BRA, $BDec); (@fk5) = fk4fk5(@fk4); Converts an FK4 (B1950) position to the equivalent FK5 (J2000) position. $BRA,$BDec fk4/B1950 position (turns) $JRA,$Dec fk5/J2000 position (turns) @fk4 fk4/B1950 position (as a 3-vector) @fk5 fk5/J2000 position (as a 3-vector) Note: This code is based on similar routines from the Fortran SLALIB package, so are quite accurate, but subject to a restrictive license (see README). =cut sub fk4fk5 (@) { # - - - - - - # F K 4 5 Z # - - - - - - # # Convert B1950.0 FK4 star data to J2000.0 FK5 assuming zero # proper motion in the FK5 frame (double precision) # # This routine converts stars from the old, Bessel-Newcomb, FK4 # system to the new, IAU 1976, FK5, Fricke system, in such a # way that the FK5 proper motion is zero. Because such a star # has, in general, a non-zero proper motion in the FK4 system, # the routine requires the epoch at which the position in the # FK4 system was determined. # # The method is from Appendix 2 of Ref 1, but using the constants # of Ref 4. # # Given: # R1950,D1950 dp B1950.0 FK4 RA,Dec at epoch (rad) # BEPOCH dp Besselian epoch (e.g. 1979.3D0) # # Returned: # R2000,D2000 dp J2000.0 FK5 RA,Dec (rad) # # Notes: # # 1) The epoch BEPOCH is strictly speaking Besselian, but # if a Julian epoch is supplied the result will be # affected only to a negligible extent. # # 2) Conversion from Besselian epoch 1950.0 to Julian epoch # 2000.0 only is provided for. Conversions involving other # epochs will require use of the appropriate precession, # proper motion, and E-terms routines before and/or # after FK45Z is called. # # 3) In the FK4 catalogue the proper motions of stars within # 10 degrees of the poles do not embody the differential # E-term effect and should, strictly speaking, be handled # in a different manner from stars outside these regions. # However, given the general lack of homogeneity of the star # data available for routine astrometry, the difficulties of # handling positions that may have been determined from # astrometric fields spanning the polar and non-polar regions, # the likelihood that the differential E-terms effect was not # taken into account when allowing for proper motion in past # astrometry, and the undesirability of a discontinuity in # the algorithm, the decision has been made in this routine to # include the effect of differential E-terms on the proper # motions for all stars, whether polar or not. At epoch 2000, # and measuring on the sky rather than in terms of dRA, the # errors resulting from this simplification are less than # 1 milliarcsecond in position and 1 milliarcsecond per # century in proper motion. # # References: # # 1 Aoki,S., et al, 1983. Astron.Astrophys., 128, 263. # # 2 Smith, C.A. et al, 1989. "The transformation of astrometric # catalog systems to the equinox J2000.0". Astron.J. 97, 265. # # 3 Yallop, B.D. et al, 1989. "Transformation of mean star places # from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space". # Astron.J. 97, 274. # # 4 Seidelmann, P.K. (ed), 1992. "Explanatory Supplement to # the Astronomical Almanac", ISBN 0-935702-68-7. # # Called: sla_DCS2C, sla_EPJ, sla_EPB2D, sla_DCC2S, sla_DRANRM # # P.T.Wallace Starlink 21 September 1998 # # Copyright (C) 1998 Rutherford Appleton Laboratory my ($rect, $w, $i, $j); my (@r0, @a1, @v1, @v2); # Position and position+velocity vectors if (@_==3) { # Rectangular coordinates passed @r0 = @_; $rect = 1; } elsif (@_==2) { # Sperical coordinates @r0 = pol2r($_[0],$_[1]); # Spherical to Cartesian $rect = 0; } elsif (@_>3) { croak "Too many arguments for Astro::fk4fk5 "; } else { croak "Not enough arguments for Astro::fk4fk5 "; } # Adjust vector A to give zero proper motion in FK5 $w=($bepoch-1950)/PMF; for ($i=0; $i<3; $i++) { $a1[$i]=$a[$i]+$w*$ad[$i]; } # Remove e-terms $w=$r0[0]*$a1[0]+$r0[1]*$a1[1]+$r0[2]*$a1[2]; for ($i=0; $i<3; $i++) { $v1[$i]=$r0[$i]-$a1[$i]+$w*$r0[$i]; } # Convert position vector to Fricke system for ($i=0; $i<6; $i++) { $w=0; for ($j=0; $j<3; $j++) { #warn "DEBUG: [$i,$j]\n"; $w=$w+$em[$i][$j]*$v1[$j]; $v2[$i]=$w } } # Allow for fictitious proper motion in FK4 $w=(epj(epb2d($bepoch))-2000)/PMF; for ($i=0; $i<3; $i++) { $v2[$i]=$v2[$i]+$w*$v2[$i+3]; } if ($rect) { return @v2[0..2]; } else { # Revert to spherical coordinates return r2pol(@v2[0..2]); } } =item B @fk5 = fk4fk5r(@fk4); Converts an FK4 (B1950) position to the equivalent FK5 (J2000) position. Note: Convert equitoral positions to/from 3-vectors using pol2r and r2pol. @fk4 fk4 position (as a 3-vector, turns) @fk5 fk5 position (as a 3-vector, turns) Note: Just a wrapper to fk4fk5 which now handler polar and rectangular arguments =cut sub fk4fk5r (@) { return fk4fk5(@_); } #sub fk4fk5r (@) { # # First check that we have 3 arguments # if (scalar @_ < 3) { # croak 'Not enough arguments for Astro::Coord::fk4fk5r at '; # } elsif (scalar @_ > 3) { # croak 'Too many arguments for Astro::Coord::fk4fk5r at '; # } # # my ($i, $j, @temp, @fk5); # my $w = 0.0; # # # Add the eterms # for ($i=0 ; $i<3 ; $i++) { # $w += $_[$i] * $eterm[$i]; # } # for ($i=0 ; $i<3 ; $i++) { # $temp[$i] = $_[$i] - $eterm[$i] + $w * $_[$i]; # } # # # Precess from FK4 to FK5 # for ($i=0 ; $i<3 ; $i++) { # $fk5[$i] = 0.0; # for ($j=0 ; $j<3 ; $j++) { # $fk5[$i] += $btoj[$i][$j] * $temp[$j]; # } # } # # return(@fk5); #} =item B ($JRA, $JDec) = fk4fk5($BRA, $BDec); ($@fk5) = fk4fk5(@fk4); Converts an FK5 (J2000) position to the equivalent FK4 (B1950) position. $JRA,$Dec fk5/J2000 position (turns) $BRA,$BDec fk4/B1950 position (turns) @fk5 fk5/J2000 position (as a 3-vector) @fk4 fk4/B1950 position (as a 3-vector) Note: This code is based on similar routines from the Fortran SLALIB package, so are quite accurate, but subject to a restrictive license (see README). =cut sub fk5fk4 (@) { #+ # - - - - - - # F K 5 2 4 # - - - - - - # # Convert J2000.0 FK5 star data to B1950.0 FK4 (double precision) # # This routine converts stars from the new, IAU 1976, FK5, Fricke # system, to the old, Bessel-Newcomb, FK4 system. The precepts # of Smith et al (Ref 1) are followed, using the implementation # by Yallop et al (Ref 2) of a matrix method due to Standish. # Kinoshita's development of Andoyer's post-Newcomb precession is # used. The numerical constants from Seidelmann et al (Ref 3) are # used canonically. # # Given: (all J2000.0,FK5) # R2000,D2000 dp J2000.0 RA,Dec (rad) # DR2000,DD2000 dp J2000.0 proper motions (rad/Jul.yr) # P2000 dp parallax (arcsec) # V2000 dp radial velocity (km/s, +ve = moving away) # # Returned: (all B1950.0,FK4) # R1950,D1950 dp B1950.0 RA,Dec (rad) # DR1950,DD1950 dp B1950.0 proper motions (rad/trop.yr) # P1950 dp parallax (arcsec) # V1950 dp radial velocity (km/s, +ve = moving away) # # Notes: # # 1) The proper motions in RA are dRA/dt rather than # cos(Dec)#dRA/dt, and are per year rather than per century. # # 2) Note that conversion from Julian epoch 2000.0 to Besselian # epoch 1950.0 only is provided for. Conversions involving # other epochs will require use of the appropriate precession, # proper motion, and E-terms routines before and/or after # FK524 is called. # # 3) In the FK4 catalogue the proper motions of stars within # 10 degrees of the poles do not embody the differential # E-term effect and should, strictly speaking, be handled # in a different manner from stars outside these regions. # However, given the general lack of homogeneity of the star # data available for routine astrometry, the difficulties of # handling positions that may have been determined from # astrometric fields spanning the polar and non-polar regions, # the likelihood that the differential E-terms effect was not # taken into account when allowing for proper motion in past # astrometry, and the undesirability of a discontinuity in # the algorithm, the decision has been made in this routine to # include the effect of differential E-terms on the proper # motions for all stars, whether polar or not. At epoch 2000, # and measuring on the sky rather than in terms of dRA, the # errors resulting from this simplification are less than # 1 milliarcsecond in position and 1 milliarcsecond per # century in proper motion. # # References: # # 1 Smith, C.A. et al, 1989. "The transformation of astrometric # catalog systems to the equinox J2000.0". Astron.J. 97, 265. # # 2 Yallop, B.D. et al, 1989. "Transformation of mean star places # from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space". # Astron.J. 97, 274. # # 3 Seidelmann, P.K. (ed), 1992. "Explanatory Supplement to # the Astronomical Almanac", ISBN 0-935702-68-7. # # P.T.Wallace Starlink 19 December 1993 # # Copyright (C) 1995 Rutherford Appleton Laboratory #- my ($rect, @v1, @v2); if (@_==3) { # Rectangular coordinates passed @v1 = @_; $rect = 1; } elsif (@_==2) { # Sperical coordinates @v1 = pol2r($_[0],$_[1]); # Spherical to Cartesian $rect = 0; } elsif (@_>2) { croak "Too many arguments for Astro::fk5fk4 "; } else { croak "Not enough arguments for Astro::fk5fk4 "; } # Miscellaneous my ($w, $x, $y, $z, $wd, $rxyz); my ($ur, $ud, $xd, $yd, $zd); my ($i,$j); # Convert position+velocity vector to BN system for ($i=0; $i<6; $i++) { $w=0.0; ##for ($j=0; $j<6; $j++) { for ($j=0; $j<3; $j++) { $w=$w+$emi[$i][$j]*$v1[$j]; } $v2[$i]=$w; } # Position vector components and magnitude $x=$v2[0]; $y=$v2[1]; $z=$v2[2]; $rxyz=sqrt($x*$x+$y*$y+$z*$z); # Apply E-terms to position $w=$x*$a[0]+$y*$a[1]+$z*$a[2]; $x=$x+$a[0]*$rxyz-$w*$x; $y=$y+$a[1]*$rxyz-$w*$y; $z=$z+$a[2]*$rxyz-$w*$z; # Recompute magnitude $rxyz=sqrt($x*$x+$y*$y+$z*$z); # Apply E-terms to both position and velocity $x=$v2[0]; $y=$v2[1]; $z=$v2[2]; $w=$x*$a[0]+$y*$a[1]+$z*$a[2]; $wd=$x*$a[3]+$y*$a[4]+$z*$a[5]; $x=$x+$a[0]*$rxyz-$w*$x; $y=$y+$a[1]*$rxyz-$w*$y; $z=$z+$a[2]*$rxyz-$w*$z; $xd=$v2[3]+$a[3]*$rxyz-$wd*$x; $yd=$v2[4]+$a[4]*$rxyz-$wd*$y; $zd=$v2[5]+$a[5]*$rxyz-$wd*$z; my @r; if ($rect) { @r = ($x, $y, $z); } else { @r= r2pol($x, $y, $z); } # my $rxysq =$x*$x+$y*$y; # my $rxy = sqrt($rxysq); # if ($rxy>TINY) { # $ur=($x*$yd-$y*$xd)/$rxysq; # $ud=($zd*$rxysq-$z*($x*$xd+$y*$yd))/(($rxysq+$z*$z)*$rxy); # } # ## Return results # my $dr1950=$ur/PMF; # my $dd1950=$ud/PMF; return(@r); } =item B @fk4 = fk5fk4r(@fk5); Converts an FK5 (J2000) position to the equivalent FK4 (B1950) position. Note: Convert equitoral positions to/from 3-vectors using pol2r and r2pol. @fk4 fk4 position (as a 3-vector, turns) @fk5 fk5 position (as a 3-vector, turns) Note: Just a wrapper to fk5fk4 which now handler polar and rectangular arguments =cut sub fk5fk4r (@) { return fk5fk4(@_); } #sub fk5fk4 (@) { ## - - - - - - ## F K 5 4 Z ## - - - - - - ## ## Convert a J2000.0 FK5 star position to B1950.0 FK4 assuming ## zero proper motion and parallax (double precision) ## ## This routine converts star positions from the new, IAU 1976, ## FK5, Fricke system to the old, Bessel-Newcomb, FK4 system. ## ## Given: ## R2000,D2000 dp J2000.0 FK5 RA,Dec (rad) ## BEPOCH dp Besselian epoch (e.g. 1950D0) ## ## Returned: ## R1950,D1950 dp B1950.0 FK4 RA,Dec (rad) at epoch BEPOCH ## DR1950,DD1950 dp B1950.0 FK4 proper motions (rad/trop.yr) ## ## Notes: ## ## 1) The proper motion in RA is dRA/dt rather than cos(Dec)#dRA/dt. ## ## 2) Conversion from Julian epoch 2000.0 to Besselian epoch 1950.0 ## only is provided for. Conversions involving other epochs will ## require use of the appropriate precession routines before and ## after this routine is called. ## ## 3) Unlike in the sla_FK524 routine, the FK5 proper motions, the ## parallax and the radial velocity are presumed zero. ## ## 4) It is the intention that FK5 should be a close approximation ## to an inertial frame, so that distant objects have zero proper ## motion; such objects have (in general) non-zero proper motion ## in FK4, and this routine returns those fictitious proper ## motions. ## ## 5) The position returned by this routine is in the B1950 ## reference frame but at Besselian epoch BEPOCH. For ## comparison with catalogues the BEPOCH argument will ## frequently be 1950D0. ## ## Called: sla_FK524, sla_PM ## ## P.T.Wallace Starlink 10 April 1990 ## ## Copyright (C) 1995 Rutherford Appleton Laboratory # # my $bepoch = 1950.0; # # my $rect; # if (@_>3) { # croak "Too many arguments for Astro::fk5fk4 "; # } elsif (@_<2) { # croak "Not enough arguments for Astro::fk5fk4 "; # } # my @r2000 = @_; # # # fk5 equinox j2000 (any epoch) to fk4 equinox b1950 epoch b1950 # my (@r1950) = fk524(@r2000); # my $dd1950 = pop @r1950; # my $dr1950 = pop @r1950; # # ## fictitious proper motion to epoch bepoch # #my ($r1950, $d1950) = pm($r,$d,$dr1950,$dd1950,0.0,0.0,1950,$bepoch); # return @r1950; #} #=item B # # @fk4 = fk5fk4r(@fk5); # # Converts an FK5 (J2000) position to the equivalent FK4 (B1950) position. # Note: Convert equitoral positions to/from 3-vectors using pol2r and r2pol. # @fk5 fk5 position (as a 3-vector, turns) # @fk4 fk4 position (as a 3-vector, turns) # #=cut # #sub fk5fk4r(@) { # # # First check that we have 3 arguments # if (scalar @_ < 3) { # croak 'Not enough arguments for Astro::Coord::fk5fk4r at '; # } elsif (scalar @_ > 3) { # croak 'Too many arguments for Astro::Coord::fk5fk4r at '; # } # # my ($i, $j, @fk4); # my $w = 0.0; # # # Precess. Note : the same matrix is used as for the FK4 -> FK5 # # transformation, but we have transposed it within the # # for loop # # for ($i=0 ; $i<3 ; $i++) { # $fk4[$i] = 0.0; # for ($j=0 ; $j<3 ; $j++) { # $fk4[$i] += $btoj[$j][$i] * $_[$j]; # } # } # # # Allow for e-terms # for ($i=0 ; $i<3 ; $i++) { # $w += $_[$i] * $eterm[$i]; # } # $w += 1.0; # for ($i=0 ; $i<3 ; $i++) { # $fk4[$i] = ($fk4[$i] + $eterm[$i])/$w; # } # # return(@fk4); #} =item B @gal = fk4galr(@fk4) Converts an FK4 position (B1950.0) to the IAU 1958 Galactic coordinate system Note: convert equitoral positions to/from 3-vectors using pol2r and r2pol. @fk4 fk4 position to convert (as a 3-vector, turns) @gal Galactic position (as a 3-vector, turns) Returns undef if too few or two many arguments are passed. Reference : Blaauw et al., 1960, MNRAS, 121, 123. =cut # Within 1e-7 arcsec of SLALIB slaEg50 sub fk4galr(@) { # First check that we have 3 arguments if (scalar @_ < 3) { croak 'Not enough arguments for Astro::Coord::fk4galr at '; } elsif (scalar @_ > 3) { croak 'Too many arguments for Astro::Coord::fk4galr at '; } my ($i, $j, @temp, @gal); my $w = 0.0; # Allow for e-terms for ($i=0 ; $i<3 ; $i++) { $w += $_[$i] * $eterm[$i]; } for ($i=0 ; $i<3 ; $i++) { $temp[$i] = $_[$i] - $eterm[$i] + $w * $_[$i]; } # Precess for ($i=0 ; $i<3 ; $i++) { $gal[$i] = 0.0; for ($j=0 ; $j<3 ; $j++) { $gal[$i] += $etog[$i][$j] * $temp[$j]; } } return(@gal); } =item B ($bRA, $bDec) = galfk4($l, $b); @fk4 = galfk4(@gal); Converts an IAU 1958 Galactic position to the FK4 coordinate system (B1950) Notes: Converts equitoral positions to/from 3-vectors using pol2r and r2pol. $BRA,$BDec fk4/B1950 position (turns) $l, $b Galactic longitude and latitude @gal Galactic position (as a 3-vector, turns) @fk4 fk4 position (as a 3-vector, turns) Reference : Blaauw et al., 1960, MNRAS, 121, 123. =cut # Within 1e-7 arcsec of SLALIB slaGe50 sub galfk4(@) { my (@r, $rect); if (@_==3) { # Rectangular coordinates passed @r = @_; $rect = 1; } elsif (@_==2) { # Sperical coordinates @r = pol2r($_[0],$_[1]); # Spherical to Cartesian $rect = 0; } elsif (@_>3) { croak "Too many arguments for Astro::galfk4 at"; } else { croak "Not enough arguments for Astro::galfk4 at"; } my ($i, $j, @fk4); my $w = 0.0; # Precess. Note : the same matrix is used as for the FK4 -> Galactic # transformation, but we have transposed it within the # for loop for ($i=0 ; $i<3 ; $i++) { $fk4[$i] = 0.0; for ($j=0 ; $j<3 ; $j++) { $fk4[$i] += $etog[$j][$i] * $r[$j]; } } # Allow for e-terms */ for ($i=0 ; $i<3 ; $i++) { $w += $r[$i] * $eterm[$i]; } $w += 1.0; for ($i=0 ; $i<3 ; $i++) { $fk4[$i] = ($fk4[$i] + $eterm[$i])/$w; } if ($rect) { return @fk4; } else { return r2pol(@fk4); } } sub galfk4r(@) {galfk4(@_)}; #=item B # # ($JRA, $JDec) = fk4fk5($BRA, $BDec); # # Converts an FK4 (B1950) position to the equivalent FK5 (J2000) position. # **LOW PRECISION** # $BRA,$BDec fk4/B1950 position (turns) # $JRA,$Dec fk5/J2000 position (turns) # #=cut # #sub fk4fk5 ($$) { # return r2pol(fk4fk5r(pol2r(shift,shift))); #} #=item B # # ($BRA, $BDec) = fk5fk4($JRA, $JDec); # # Converts an FK5 (J2000) position to the equivalent FK4 (B1950) position. # **LOW PRECISION** # $JRA,$Dec fk5/J2000 position (turns) # $BRA,$BDec fk4/B1950 position (turns) # #=cut # #sub fk5fk4 ($$) { # return r2pol(fk5fk4r(pol2r(shift,shift))); #} =item B ($l, $b) = fk4gal($ra, $dec); Converts an FK4 position (B1950) to the IAU 1958 Galactic coordinate system ($ra, $dec) fk4 position to convert (turns) ($l, $b) Galactic position (turns) Reference : Blaauw et al., 1960, MNRAS, 121, 123. =cut sub fk4gal ($$) { return r2pol(fk4galr(pol2r(shift,shift))); } #=item B # # ($ra, $dec) = galfk4($l, $b); # # Converts an IAU 1958 Galactic coordinate system position # to FK4 (B1950). # ($l, $b) Galactic position (turns) # ($ra, $dec) fk4 position to convert (turns) # Reference : Blaauw et al., 1960, MNRAS, 121, 123. # #=cut # #sub galfk4 ($$) { # return r2pol(galfk4r(pol2r(shift,shift))); #} =item B ($omega, $rma, $mlanom, $F, $D, $eps0) = ephem_vars($jd) Given the Julian day ($jd) this routine calculates the ephemeris values required by the prcmat and nutate routines The returned values are : $omega - Longitude of the ascending node of the Moons mean orbit on the ecliptic, measured from the mean equinox of date. $rma - Mean anomaly of the Sun. $mlanom - Mean anomaly of the Moon. $F - L - omega, where L is the mean longitude of the Moon. $D - Mean elongation of the Moon from the Sun. $eps0 - Mean obilquity of the ecliptic. =cut =item B ($DRA, $DDec) = J2000todate($JRA, $JDec, $mjd); @date = J2000todate(@J2000, $mjd); Converts an J2000 position date coordinate $DRA,$DDec Date coordinate (turns) $JRA,$Dec J2000 position (turns) @date Date coordinate (as a 3-vector) @J2000 J2000 position (as a 3-vector) =cut # Untested sub J2000todate(@) { my ($rect); my (@J2000, @date); # Position vectors my $mjd = pop @_; if (@_==3) { # Rectangular coordinates passed @J2000 = @_; $rect = 1; } elsif (@_==2) { # Sperical coordinates @J2000 = pol2r($_[0],$_[1]); # Spherical to Cartesian $rect = 0; } elsif (@_>3) { croak "Too many arguments for Astro::Coord::J2000todate "; } else { croak "Not enough arguments for Astro::Coord::J2000todate "; } # compute the general precession matrix. my @gp = precsn(JULIAN_DAY_J2000, $mjd+2400000.5); # Determine ephemeris quantities my ($deps, $dpsi); my @nu = (); my ($omega, $rma, $mlanom, $F, $D, $eps0) = ephem_vars($mjd+2400000.5); ($deps, $dpsi, @nu) = nutate($omega, $F, $D, $rma, $mlanom, $eps0); my @prcmat = (); for (my $i=0 ; $i<3 ; $i++) { for (my $j=0 ; $j<3 ; $j++) { my $xx = 0.0; for (my $k=0 ; $k<3 ; $k++) { $xx = $xx + $gp[$i][$k] * $nu[$k][$j]; } $prcmat[$i][$j] = $xx; } } for (my $i=0 ; $i<3 ; $i++) { $date[$i] = 0.0; for (my $j=0 ; $j<3 ; $j++) { $date[$i] += $prcmat[$i][$j] * $J2000[$j]; } } if ($rect) { return @date; } else { # Revert to spherical coordinates return r2pol(@date); } } sub ephem_vars ($) { my $epoch = shift; # Calculates values required internally by prcmat and for nutate from # the passed Julian Day # Calculate the interval to/from J2000 in Julian Centuries my $jcents = ($epoch-(JULIAN_DAY_J2000))/JULIAN_DAYS_IN_CENTURY; # Calculate the longitude of the mean ascending node of the lunar # orbit on the ecliptic [A.A. Suppl. 1984, p S26] my $omega = (((0.000000039 * $jcents + 0.000036143) * $jcents - 33.757045934) * $jcents + 2.182438624)/(2.0*$PI); $omega = fmod($omega,1.0); if ($omega < 0.0) { $omega += 1.0; } # Calculate the mean anomaly. [A.A suppl. 1984, p S26] my $manom = (6.240035939 - ((5.818e-8 * $jcents +2.797e-6) * $jcents - 628.301956024) * $jcents)/(2.0*$PI); $manom = fmod($manom,1.0); if ($manom < 0.0) { $manom += 1.0; } # Calculate the mean anomaly of the Moon. [A.A. Suppl, 1984, p S26] my $mlanom = (((0.000000310 * $jcents + 0.000151795) * $jcents +8328.691422884) * $jcents + 2.355548394)/(2.0*$PI); $mlanom = fmod($mlanom,1.0); if ($mlanom < 0.0) { $mlanom += 1.0; } # Calculate the longitude of the moon from ascending node. # [A.A. Suppl, 1984, p S26] my $F = (((0.000000053 * $jcents - 0.000064272) * $jcents + 8433.466158318) * $jcents + 1.627901934)/(2.0*$PI); $F = fmod($F,1.0); if ($F < 0.0) { $F += 1.0; } # Calculate the mean elongation of the moon from the sun. # [A.A suppl. 1984, p S26] my $D = (((0.000000092 * $jcents + 0.000033409) * $jcents + 7771.377146171) * $jcents + 5.198469514)/(2.0*$PI); $D = fmod($D,1.0); if ($D < 0.0) { $D += 1.0; } # Calculate the mean obliquity of the ecliptic = mean obliquity. # [A.A suppl. 1984, p S26] my $eps0 = (((0.000000009 * $jcents - 0.000000003) * $jcents - 0.000226966) * $jcents + 0.409092804)/(2.0*$PI); return($omega, $manom, $mlanom, $F, $D, $eps0) } =item B ($deps, $dpsi, @nu) = nutate($omega, $F, $D, $rma, $mlanom, $eps0); To calculate the nutation in longitude and obliquity according to the 1980 IAU Theory of Nutation including terms with amplitudes greater than 0.01 arcsecond. The nutation matrix is used to compute true place from mean place: true vector = N x mean place vector where the three components of each vector are the direction cosines wrt the mean equinox and equator. / 1 -dpsi.cos(eps) -dpsi.sin(eps) \ | | N = | dpsi.cos(eps) 1 -deps | | | \ dpsi.sin(eps) deps 1 / The required inputs are : (NOTE: these are the values returned by ephem_vars) $omega - Longitude of the ascending node of the Moons mean orbit on the ecliptic, measured from the mean equinox of date. $rma - Mean anomaly of the Sun. $mlanom - Mean anomaly of the Moon. $F - L - omega, where L is the mean longitude of the Moon. $D - Mean elongation of the Moon from the Sun. $eps0 - Mean obilquity of the ecliptic. The returned values are : $deps - nutation in obliquity $dpsi - nutation in longitude (scalar) @nu - nutation matrix (array [3][3]) =cut sub nutate ($$$$$$) { my ($omega, $F, $D, $manom, $mlanom, $eps0) = @_; my $arg1 = $omega; my $arg2 = 2.0 * $omega; my $arg9 = 2.0 * ($F-$D+$omega); my $arg10 = $manom; my $arg11 = $arg9 + $arg10; my $arg12 = $arg9 - $arg10; my $arg13 = $arg9 - $arg1; my $arg31 = 2.0 * ($F+$omega); my $arg32 = $mlanom; my $arg33 = $arg31 - $arg1; my $arg34 = $arg31 + $arg32; my $arg35 = $mlanom - 2.0 * $D; my $arg36 = $arg31 - $arg32; my $dpsi = (-0.000083386 * sin($arg1*2.0*$PI) +0.000001000 * sin($arg2*2.0*$PI) -0.000006393 * sin($arg9*2.0*$PI) +0.000000691 * sin($arg10*2.0*$PI) -0.000000251 * sin($arg11*2.0*$PI) +0.000000105 * sin($arg12*2.0*$PI) +0.000000063 * sin($arg13*2.0*$PI) -0.000001102 * sin($arg31*2.0*$PI) +0.000000345 * sin($arg32*2.0*$PI) -0.000000187 * sin($arg33*2.0*$PI) -0.000000146 * sin($arg34*2.0*$PI) -0.000000077 * sin($arg35*2.0*$PI) +0.000000060 * sin($arg36*2.0*$PI))/(2.0*$PI); my $deps = ( 0.000044615 * cos($arg1*2.0*$PI) -0.000000434 * cos($arg2*2.0*$PI) +0.000002781 * cos($arg9*2.0*$PI) +0.000000109 * cos($arg11*2.0*$PI) +0.000000474 * cos($arg31*2.0*$PI) +0.000000097 * cos($arg33*2.0*$PI) +0.000000063 * cos($arg34*2.0*$PI))/(2.0*$PI); my $eps = $eps0 + $deps; my @N = ([1.0, -($dpsi)*(2.0*$PI)*cos($eps*2.0*$PI), -($dpsi)*(2.0*$PI)*sin($eps*2.0*$PI)], [0.0, 1.0, -($deps)*(2.0*$PI)], [0.0, ($deps)*(2.0*$PI), 1.0]); $N[1][0] = -1.0*$N[0][1]; $N[2][0] = -1.0*$N[0][2]; return($deps, $dpsi, @N); } =item B @gp = precsn($jd_start, $jd_stop); To calculate the precession matrix P for dates AFTER 1984.0 (JD = 2445700.5) Given the position of an object referred to the equator and equinox of the epoch $jd_start its position referred to the equator and equinox of epoch $jd_stop can be calculated as follows : 1) Express the position as a direction cosine 3-vector (V1) (use pol2r to do this). 2) The corresponding vector V2 for epoch jd_end is V2 = P.V1 The required inputs are : $jd_start - The Julian day of the current epoch of the coordinates. $jd_end - The Julian day at the required epoch for the conversion. The returned values are : @gp - The required precession matrix (array [3][3]) =cut sub precsn ($$) { my ($jd_start, $jd_end) = @_; my @a = (0.011180860865024, 0.000006770713945, -0.000000000673891, 0.000001463555541, -0.000000001667759, 0.000000087256766); my @b = (0.011180860865024, 0.000006770713945, -0.000000000673891, 0.000005307158404, 0.000000000319977, 0.000000088250634); my @d = (0.009717173455170, -0.000004136915141, -0.000000001052046, 0.000002068457570, 0.000000001052046, -0.000000202812107); my $t = ($jd_start - JULIAN_DAY_J2000)/JULIAN_DAYS_IN_CENTURY; my $st = ($jd_end - $jd_start)/JULIAN_DAYS_IN_CENTURY; my $t2 = $t * $t; my $st2 = $st * $st; my $st3 = $st2 * $st; # Calculate the Equatorial precession parameters # (ref. USNO Circular no. 163 1981, # Lieske et al., Astron. & Astrophys., 58, 1 1977) my $zeta = ($a[0] + $a[1]*$t + $a[2]*$t2) * $st + ($a[3] + $a[4]*$t) * $st2 + $a[5] * $st3; my $z = ($b[0] + $b[1]*$t + $b[2]*$t2) * $st + ($b[3] + $b[4]*$t) * $st2 + $b[5] * $st3; my $theta = ($d[0] + $d[1]*$t + $d[2]*$t2) * $st - ($d[3] + $d[4]*$t) * $st2 + $d[5] * $st3; # Calculate the P matrix my @precession = ([0.0, 0.0, 0.0], [0.0, 0.0, 0.0], [0.0, 0.0, 0.0]); $precession[0][0] = cos($zeta)*cos($z)*cos($theta) - sin($zeta)*sin($z); $precession[0][1] = -sin($zeta)*cos($z)*cos($theta) - cos($zeta)*sin($z); $precession[0][2] = -cos($z)*sin($theta); $precession[1][0] = cos($zeta)*sin($z)*cos($theta) + sin($zeta)*cos($z); $precession[1][1] = -sin($zeta)*sin($z)*cos($theta) + cos($zeta)*cos($z); $precession[1][2] = -sin($z)*sin($theta); $precession[2][0] = cos($zeta)*sin($theta); $precession[2][1] = -sin($zeta)*sin($theta); $precession[2][2] = cos($theta); return(@precession); } =item B ($output_left, $output_right) = coord_convert($input_left, $input_right, $input_mode, $output_mode, $mjd, $longitude, $latitude, $ref0); A routine for converting between any of the following coordinate systems : Coordinate system input/output mode ----------------- ----------------- X, Y (East-West mounted) 0 Azimuth, Elevation 1 Hour Angle, Declination 2 Right Ascension, Declination (date, J2000 or B1950) 3,4,5 Galactic (B1950) 6 The last four parameters in the call ($mjd, $longitude, $latitude and $ref0) are not always required for the coordinate conversion. In particular if the conversion is between two coordinate systems which are fixed with respect to the celestial sphere (RA/Dec J2000, B1950 or Galactic), or two coordinate systems which are fixed with respect to the antenna (X/Y and Az/El) then these parameters are not used (NOTE: they must always be passed, even if they only hold 0 or undef as the routine will return undef if it is not passed 8 parameters). The RA/Dec date system is defined with respect to the celestial sphere, but varies with time. The table below shows which of $mjd, $longitude, $latitude and $ref0 are used for a given conversion. If in doubt you should determing the correct values for all input parameters, no checking is done in the routine that the passed values are sensible. Conversion $mjd $longitude $latitude $ref0 ------------------------------------------------------------------------ Galactic, Galactic, RA/Dec J2000,B1950 <->RA/Dec J2000, B1950 N N N N Galactic, RA/Dec J2000,B1950 <->RA/Dec date Y N N N Galactic, RA/Dec J2000,B1950,<->HA/Dec Y Y N N date Galactic, RA/Dec J2000,B1950,<->X/Y, Az/El Y Y Y Y date X/Y, Az/El <->X/Y, Az/El N N N N X/Y, Az/El <->HA/Dec N N Y Y NOTE : The method used for refraction correction is asymptotic at an elevation of 0 degrees. The required inputs are : $input_left - The left/longitude input coordinate (turns) $input_right - The right/latitude input coordinate (turns) $input_mode - The mode of the input coordinates (0-6) $output_mode - The mode to convert the coordinates to. $mjd - The time as modified Julian day (if necessary) at which to perform the conversion $longitude - The longitude of the location/observatory (if necessary) at which to perform the conversion (turns) $latitude - The latitude of the location/observatory (if necessary) at which to perform the conversion (turns) $ref0 - The refraction constant (if in doubt use 0.00005). The returned values are : $output_left - The left/longitude output coordinate (turns) $output_right - The right/latitude output coordinate (turns) =cut sub coord_convert ($$$$;$$$$) { my ($input_left, $input_right, $input_mode, $output_mode, $mjd, $longitude, $latitude, $ref0) = @_; # Some required constants my ($EWXY, $AZEL, $HADEC, $DATE, $J2000, $B1950, $GALACTIC) = 0..6; # First check what the input and output modes are. if (($input_mode < $EWXY) || ($input_mode > $GALACTIC)) { carp "Invalid input coordinate mode : $input_mode\n". "Valid inputs are numbers in the range 0-6, which corrspond to X/Y, ". "Az/El,\n HA/Dec, RA/Dec (date), RA/Dec (J2000), RA/Dec (B1950), ". "Galactic."; return undef; } if (($output_mode < $EWXY) || ($output_mode > $GALACTIC)) { carp "Invalid output coordinate mode : $output_mode\n". "Valid outputs are numbers in the range 0-6, which corrspond to X/Y, ". "Az/El,\n HA/Dec, RA/Dec (date), RA/Dec (J2000), RA/Dec (B1950), ". "Galactic."; return undef; } # Check we have the correct parameters passed # Need mjd if ((($input_mode>=$DATE && $output_mode<=$DATE) || ($input_mode<=$DATE && $output_mode>=$DATE)) && !(defined($mjd))) { carp '$mjd parametr missing'; return undef; } # Need longitude if ((($input_mode>=$HADEC && $output_mode<=$AZEL) || ($input_mode<=$HADEC && $output_mode>=$HADEC)) && !(defined($longitude))) { carp '$longitude parametr missing'; return undef; } # Need latitude if ((($input_mode>=$HADEC && $output_mode<$HADEC) || ($input_mode<=$AZEL && $output_mode>$AZEL)) && !(defined($latitude))) { carp '$latitude parameter missing'; return undef; } # Need ref0 if ((($input_mode>=$HADEC && $output_mode<$HADEC) || ($input_mode<=$AZEL && $output_mode>$AZEL)) && !(defined($ref0))) { carp '$ref0 parameter missing'; return undef; } # If necessary determine ephemeris quantities (if either of the modes are # date, HA/Dec, AzEl or EWXY). my ($omega, $rma, $mlanom, $F, $D, $eps0, $deps, $dpsi); my @nu = (); if (($input_mode<=$DATE && $output_mode>=$DATE) || ($input_mode>=$DATE && $output_mode<=$DATE)) { ($omega, $rma, $mlanom, $F, $D, $eps0) = ephem_vars($mjd+2400000.5); ($deps, $dpsi, @nu) = nutate($omega, $F, $D, $rma, $mlanom, $eps0); } my @vonc = (); if (($input_mode<=$HADEC && $output_mode>=$DATE) || ($input_mode>=$DATE && $output_mode<=$HADEC)) { # Calculate the interval to/from J2000 in Julian Centuries my $jcents = ($mjd+2400000.5-(JULIAN_DAY_J2000))/JULIAN_DAYS_IN_CENTURY; # Compute the eccentricity of the Earth's orbit (in radians) # [Explanatory supplement to the Astronomical Ephemeris 1961, p 98] my $e = (-0.000000126 * $jcents - 0.00004205) * $jcents + 0.016709114; # Compute the eccentric anomaly, by iteratively solving : # ea = e*sin(ea) - rma my $ea = $rma; my $xx; do { $xx = $ea; $ea = $xx + ($rma - $xx + $e*sin($xx)) / (1.0 - $e*cos($xx)); } while (abs($ea -$xx) > 1.0e-9); # Compute the mean longitude of perihelion, in radians # (reference as for `e'). my $perihl = ((0.00000005817764*$jcents + 0.000008077) * $jcents + 0.030010190) * $jcents + 1.796613066; # Calculate the equation of the equinoxes #my $eqenx = $dpsi * cos(($eps0+$deps)*2.0*$PI); # Compute the abberation vector my $eps = $eps0 + $deps; $xx = 0.00009936508 / (1.0 - $e*cos($ea)); my $efac = sqrt(1.0 - $e*$e); $vonc[0] = $xx * (-cos($perihl)*sin($ea) - $efac*sin($perihl)*cos($ea)); $vonc[1] = $xx * (-sin($perihl)*cos($eps)*sin($ea) + $efac*cos($perihl)*cos($eps)*cos($ea)); $vonc[2] = $xx * (-sin($perihl)*sin($eps)*sin($ea) + $efac*cos($perihl)*sin($eps)*cos($ea)); } my @prcmat = (); if (($input_mode<=$DATE && $output_mode>=$J2000) || ($input_mode>=$J2000 && $output_mode<=$DATE)) { # compute the general precession matrix. */ my @gp = precsn(JULIAN_DAY_J2000, $mjd+2400000.5); # The matrices returned from nutate (nu) and precsn (gp) can be used # to convert J2000 coordinates to date by : # (coords at date) = gp * nu * (coords at J2000) # gp and nu can be combined to give the required precession matrix for (my $i=0 ; $i<3 ; $i++) { for (my $j=0 ; $j<3 ; $j++) { my $xx = 0.0; for (my $k=0 ; $k<3 ; $k++) { $xx = $xx + $gp[$i][$k] * $nu[$k][$j]; } $prcmat[$i][$j] = $xx; } } } my $lmst; if (($input_mode<=$HADEC && $output_mode>=$DATE) || ($output_mode<=$HADEC && $input_mode>=$DATE)) { $lmst = mjd2lst($mjd, $longitude); } # Perform the conversion my (@lb, @b1950, @j2000, @date, $ra, $ha, $dec, $az, $el, $x, $y); if ($input_mode == $GALACTIC) { @lb = pol2r($input_left, $input_right); } elsif ($input_mode == $B1950) { @b1950 = pol2r($input_left, $input_right); } elsif ($input_mode == $J2000) { @j2000 = pol2r($input_left, $input_right); } elsif ($input_mode == $DATE) { @date = pol2r($input_left, $input_right); } elsif ($input_mode == $HADEC) { $ha = $input_left; $dec = $input_right; } elsif ($input_mode == $AZEL) { $az = $input_left; $el = $input_right; } else { $x = $input_left; $y = $input_right; } # Conversion is to a "lower" mode if ($output_mode < $input_mode) { # Convert from Galactic to B1950 if ($input_mode == $GALACTIC) { @b1950 = galfk4r(@lb); } # Convert from B1950 to J2000 if (($input_mode >= $B1950) && ($output_mode < $B1950)) { @j2000 = fk4fk5r(@b1950); } # Precess from J2000 to date if (($input_mode >= $J2000) && ($output_mode < $J2000)) { for (my $i=0 ; $i<3 ; $i++) { $date[$i] = 0.0; for (my $j=0 ; $j<3 ; $j++) { $date[$i] += $prcmat[$i][$j] * $j2000[$j]; } } } # Convert from date to HA/Dec if (($input_mode >= $DATE) && ($output_mode < $DATE)) { # Convert to geometrical equitorial coordinates for (my $i=0 ; $i<3 ; $i++) { $date[$i] += $vonc[$i]; } # Convert from retangular back to polar coordinates ($ra, $dec) = r2pol(@date); # Convert to hour angle $ha = $lmst - $ra; if ($ha < 0.0) { $ha += 1.0; } } # Convert from HA/Dec to Az/El if (($input_mode >= $HADEC) && ($output_mode < $HADEC)) { ($az, $el) = eqazel($ha, $dec, $latitude); # Correct for refraction $el += $ref0/tan($el*2.0*$PI); } # Convert from Az/El to X/Y if (($input_mode >= $AZEL) && ($output_mode < $AZEL)) { ($x, $y) = azel2xy($az, $el); } } else { # Convert from X/Y to Az/El if (($input_mode == $EWXY) && ($output_mode > $EWXY)) { ($az, $el) = xy2azel($x, $y); } # Convert from Az/El to HA/Dec if (($input_mode <= $AZEL) && ($output_mode > $AZEL)) { # First numerically invert the refraction correction my $upper = $el - $ref0/tan($el*2.0*$PI); my $lower = $el - 1.5*$ref0/tan($el*2.0*$PI); my $root = ($lower+$upper)/2.0; my $niter = 0; do { if ($root + $ref0/tan($root*2.0*$PI) - $el > 0.0) { $upper = $root; } else { $lower = $root; } $root = ($lower+$upper)/2.0; $niter++; } while (($niter <= 10) && (($upper-$root) > 7.0e-8)); $el = $root; # Now do the conversion ($ha, $dec) = eqazel($az, $el, $latitude); } # Convert from HA/Dec to date if (($input_mode <= $HADEC) && ($output_mode > $HADEC)) { $ra = $lmst - $ha; if ($ra < 0.0) { $ra += 1.0; } @date = pol2r($ra, $dec); # Remove the abberation vector for (my $i=0 ; $i<3 ; $i++) { $date[$i] -= $vonc[$i]; } } # precess from date to J2000 if (($input_mode <= $DATE) && ($output_mode > $DATE)) { for (my $i=0 ; $i<3 ; $i++) { $j2000[$i] = 0.0; for (my $j=0 ; $j<3 ; $j++) { $j2000[$i] += $prcmat[$j][$i] * $date[$j]; } } } # Convert from J2000 to B1950 if (($input_mode <= $J2000) && ($output_mode > $J2000)) { @b1950 = fk5fk4(@j2000); } # Convert from B1950 to Galactic if (($input_mode <= $B1950) && ($output_mode >= $B1950)) { @lb = fk4galr(@b1950); } } if ($output_mode == $EWXY) { return($x, $y); } elsif ($output_mode == $AZEL) { return($az, $el); } elsif ($output_mode == $HADEC) { return($ha, $dec); } elsif ($output_mode == $DATE) { return(r2pol(@date)); } elsif ($output_mode == $J2000) { return(r2pol(@j2000)); } elsif ($output_mode == $B1950) { return(r2pol(@b1950)); } elsif ($output_mode == $GALACTIC) { return(r2pol(@lb)); } } =item B $haset = haset_ewxy($declination, $latitude, %limits); This routine takes the $declination of the source, and the $latitude of the EWXY mounted antenna and calculates the hour angle at which the source will set. It is then trivial to calculate the time until the source sets, simply by subtracting the current hour angle of the source from the hour angle at which it sets. The required inputs are : $declination - The declination of the source (turns) $latitude - The latitude of the observatory (turns) %limits - A reference to a hash holding the EWXY antenna limits The following keys must be defined XLOW, XLOW_KEYHOLE, XHIGH, XHIGH_KEYHOLE, YLOW, YLOW_KEYHOLE, YHIGH, YHIGH_KEYHOLE (all values shoule be in turns) The returned value is : $haset - The hour angle (turns) at which a source at this declination sets for an EWXY mounted antenna with the given limits at the given latitude NOTE: returns undef if %limits hash is missing any of the required keys =cut sub haset_ewxy($$\%) { my ($declination, $latitude, $limitsref) = @_; # Check that all the required keys are present if ((!exists $limitsref->{XLOW}) || (!exists $limitsref->{XLOW_KEYHOLE}) || (!exists $limitsref->{XHIGH}) || (!exists $limitsref->{XHIGH_KEYHOLE}) || (!exists $limitsref->{YLOW}) || (!exists $limitsref->{YLOW_KEYHOLE}) || (!exists $limitsref->{YHIGH}) || (!exists $limitsref->{YHIGH_KEYHOLE})) { carp 'Missing key in %limits'; return undef; } # Local variables my ($pole, $pxlim, $exlim, $hix, $hixk, $lowx, $lowxk); if ($latitude < 0.0) { $pole = -90.0/360.0; $pxlim = $limitsref->{XLOW}; $exlim = $limitsref->{XHIGH}; } else { $pole = 90.0/360.0; $pxlim = $limitsref->{XHIGH}; $exlim = $limitsref->{XLOW}; } my $dec_never = $latitude + $exlim; my $dec_always = $pole - ($latitude + $pxlim - $pole); if ((($latitude < 0.0) && ($declination > $dec_never)) || (($latitude > 0.0) && ($declination < $dec_never))) { # Source is never up return(0.0); } elsif ((($latitude < 0.0) && ($declination < $dec_always)) || (($latitude > 0.0) && ($declination > $dec_always))) { # Source is always up return(1.0); } else { # Up some of the time - calculate the ghastly constants and # do everything in radians from here on. $declination = 2.0 * $PI * $declination; $latitude = 2.0 * $PI * $latitude; my $k0 = -cos($declination); my $k1 = sin($declination)*cos($latitude); my $k2 = sin($declination)*sin($latitude); my $k3 = cos($declination)*sin($latitude); my $k4 = cos($declination)*cos($latitude); my $k5 = $k4 * $k1 + $k2 * $k3; my $x = 2.0 * $PI * $limitsref->{XLOW_KEYHOLE}; my $dec_split = asin(cos(2.0 * $PI * $limitsref->{YLOW}) * (cos($x) * sin($latitude) + sin($x) * cos($latitude))); if ($latitude > 0.0) { # Set up for northern antenna $hix = $limitsref->{XLOW}; $hixk = $limitsref->{XLOW_KEYHOLE}; $lowx = $limitsref->{XHIGH}; $lowxk = $limitsref->{XHIGH_KEYHOLE}; } else { # Set up for southern antenna $hix = $limitsref->{XHIGH}; $hixk = $limitsref->{XHIGH_KEYHOLE}; $lowx = $limitsref->{XLOW}; $lowxk = $limitsref->{XLOW_KEYHOLE}; } if ((($declination > $dec_split) && ($latitude < 0.0)) || (($declination < $dec_split) && ($latitude > 0.0))) { # We are on the equatorial side my $x = 2.0 * $PI * $hix; my $y = -1.0 * abs(acos($k5 / ($k4 * sin($x) + $k3 * cos($x)))); if (abs($y) < abs(2.0 * $PI * $limitsref->{YLOW_KEYHOLE})) { return(acos(($k1 - $k2 + cos($x) * cos($y) - sin($x) * cos($y))/ ($k3 + $k4))/(2.0 * $PI)); } else { my $x = 2.0 * $PI * $hixk; my $y = -1.0 * abs(acos($k5 / ($k4 * sin($x) + $k3 * cos($x)))); if (abs($y) < abs(2.0 * $PI * $limitsref->{YLOW_KEYHOLE})) { return(asin(sin(2.0 * $PI * $limitsref->{YLOW_KEYHOLE}) / $k0)/(2.0 * $PI)); } elsif (abs($y) < abs(2.0 * $PI * $limitsref->{YLOW})) { return(acos(($k1 - $k2 + cos($x) * cos($y) - sin($x) * cos($y)) / ($k3 + $k4))/(2.0 * $PI)); } else { return(asin(sin(2.0 * $PI*$limitsref->{YLOW}) / $k0) / (2.0 * $PI)); } } } else { # We are on the polar side my $x = 2.0 * $PI * $lowx; my $y = abs(acos($k5 / ($k4 * sin($x) + $k3 * cos($x)))); if (abs($y) < abs(2.0 * $PI * $limitsref->{YLOW_KEYHOLE})) { return(acos(($k1 - $k2 + cos($x) * cos($y) - sin($x) * cos($y)) / ($k3 + $k4))/(2.0 * $PI)); } else { my $x = 2.0 * $PI * $lowxk; my $y = -1.0 * abs(acos($k5 /($k4 * sin($x) + $k3 * cos($x)))); if (abs($y) < abs(2.0 * $PI* $limitsref->{YLOW_KEYHOLE})) { return(asin(sin(2.0 * $PI * $limitsref->{YLOW_KEYHOLE}) / $k0)/(2.0 * $PI)); } elsif (abs($y) < abs(2.0 * $PI * $limitsref->{YLOW})) { return(acos(($k1 - $k2 + cos($x) * cos($y) - sin($x) * cos($y)) / ($k3 + $k4))/(2.0 * $PI)); } else { return(asin(sin(2.0 * $PI * $limitsref->{YLOW}) / $k0)/ (2.0 * $PI)); } } } } } =item B $tlos = ewxy_tlos($hour_angle, $declination, $latitude, %limits); This routine calculates the time left on-source (tlos) for a source at $hour_angle, $declination for an EWXY mount antenna at $latitude. The required inputs are : $hour_angle - The current hour angle of the source (turns) $declination - The declination of the source (turns) $latitude - The latitude of the observatory (turns) \%limits - A reference to a hash holding the EWXY antenna limits The following keys must be defined XLOW, XLOW_KEYHOLE, XHIGH, XHIGH_KEYHOLE, YLOW, YLOW_KEYHOLE, YHIGH, YHIGH_KEYHOLE (all values should be in turns) The returned value is : $tlos - The time left on-source (turns) =cut sub ewxy_tlos($$$\%) { my ($hour_angle, $declination, $latitude, $limitsref) = @_; my $haset = haset_ewxy($declination, $latitude, %$limitsref); return(undef) if (!defined $haset); $haset -= $hour_angle if (($haset > 0.0) && ($haset < 1.0)); $haset += 1.0 if ($haset < 0.0); return $haset; } =item B $haset = haset_azel($declination, $latitude, %limits); This routine takes the $declination of the source, and the $latitude of the Az/El mounted antenna and calculates the hour angle at which the source will set. It is then trivial to calculate the time until the source sets, simply by subtracting the current hour angle of the source from the hour angle at which it sets. This routine assumes that the antenna is able to rotate through 360 degrees in azimuth. The required inputs are : $declination - The declination of the source (turns) $latitude - The latitude of the observatory (turns) \%limits - A reference to a hash holding the Az/El antenna limits The following keys must be defined ELLOW (all values should be in turns) The returned value is : $haset - The hour angle (turns) at which a source at this declination sets for an Az/El mounted antenna with the given limits at the given latitude NOTE: returns undef if the %limits hash is missing any of the required keys =cut sub haset_azel($$\%) { my ($declination, $latitude, $limitsref) = @_; # Check that all the required keys are present if (!exists $limitsref->{ELLOW}) { carp 'Missing key in %limits'; return undef ; } my $cos_haset = (cos($PI / 2.0 - $limitsref->{ELLOW} * 2.0 * $PI) - sin($latitude * 2.0 * $PI) * sin($declination * 2.0 * $PI))/ (cos($declination * 2.0 * $PI) *cos($latitude * 2.0 * $PI)); if ($cos_haset > 1.0) { # The source never rises return(0.0); } elsif ($cos_haset < -1.0) { # The source never sets return(1.0); } else { return(acos($cos_haset)/(2.0*$PI)); } } =item B $tlos = azel_tlos($hour_angle, $declination, $latitude, \%limits); This routine calculates the time left on-source (tlos) for a source at $hour_angle, $declination for an Az/El mount antenna at $latitude. The required inputs are : $hour_angle - The current hour angle of the source (turns) $declination - The declination of the source (turns) $latitude - The latitude of the observatory (turns) %limits - A reference to a hash holding the Az/El antenna limits The following keys must be defined ELLOW (all values should be in turns) The returned value is : $tlos - The time left on-source (turns) =cut sub azel_tlos($$$\%) { my ($hour_angle, $declination, $latitude, $limitsref) = @_; # Calculate the time left onsource my $haset = haset_azel($declination, $latitude, %$limitsref); if (!defined $haset) {return(undef)}; if (($haset > 0.0) && ($haset < 1.0)) { $haset -= $hour_angle; } if ($haset < 0.0) { $haset += 1.0; } return($haset); } =item B $ha_set = antenna_rise($declination, $latitude, $mount, \%limits); Given the $declination of the source, the $latitude of the antenna, the type of the antenna $mount and a reference to a hash holding information on the antenna limits, this routine calculates the hour angle at which the source sets for the antenna. The hour angle at which it rises is simply the negative of that at which it sets. These values in turn can be used to calculate the LMST at which the source rises/sets and from that the UT at which the source rises/sets on a given day, or to calculate the native coordinates at which the source rises/sets. If you want to calculate source rise times above arbitrary elevation, use the routine rise. The required inputs are : $declination - The declination of the source (turns) $latitude - The latitude of the observatory (turns) $mount - The type of antenna mount, 0 => EWXY mount, 1 => Az/El, any other number will cause the routine to return undef %limits - A reference to a hash holding the antenna limits For an EWXY antenna there must be keys for all the limits (i.e. XLOW, XLOW_KEYHOLE, XHIGH, XHIGH_KEYHOLE, YLOW, YLOW_KEYHOLE, YHIGH, YHIGH_KEYHOLE). For an Az/El antenna there must be a key for ELLOW (all values should be in turns). The returned values are : $ha_set - The hour angle at which the source sets (turns). The hour angle at which the source rises is simply the negative of this value. =cut sub antenna_rise($$$$) { my ($declination, $latitude, $mount, $limitsref) = @_; # Check that the mount type is either EWXY (0) or AZEL (1) if (($mount != 0) && ($mount != 1)) { carp 'mount must equal 0 or 1'; return undef; } if ($mount == 0) { return(haset_ewxy($declination, $latitude, %$limitsref)); } elsif ($mount == 1) { return(haset_azel($declination, $latitude, %$limitsref)); } } my @b2g = ([-0.054875539726, 0.494109453312, -0.867666135858], [-0.873437108010, -0.444829589425, -0.198076386122], [-0.483834985808, 0.746982251810, 0.455983795705]); #my @b2g = ([ -0.0548777621, +0.4941083214, -0.8676666398], # [ -0.8734369591, -0.4448308610, -0.1980741871], # [ -0.4838350026, +0.7469822433, +0.4559837919]); sub j2gal($$) { my ($ra,$dec) = @_; my @r = pol2r($ra,$dec); my @g = (0,0,0); for (my $i=0; $i<3; $i++) { for (my $j=0; $j<3; $j++) { $g[$i]+= $b2g[$j][$i] * $r[$j]; } } return r2pol(@g); } # SLALIB support routines sub epb2d ($) { # - - - - - - # E P B 2 D # - - - - - - # # Conversion of Besselian Epoch to Modified Julian Date # (double precision) # # Given: # EPB dp Besselian Epoch # # The result is the Modified Julian Date (JD - 2400000.5). # # Reference: # Lieske,J.H., 1979. Astron.Astrophys.,73,282. # # P.T.Wallace Starlink February 1984 # # Copyright (C) 1995 Rutherford Appleton Laboratory my $epb = shift; return 15019.81352 + ($epb-1900)*365.242198781; } sub epj ($) { # - - - - # E P J # - - - - # # Conversion of Modified Julian Date to Julian Epoch (double precision) # # Given: # DATE dp Modified Julian Date (JD - 2400000.5) # # The result is the Julian Epoch. # # Reference: # Lieske,J.H., 1979. Astron.Astrophys.,73,282. # # P.T.Wallace Starlink February 1984 # # Copyright (C) 1995 Rutherford Appleton Laboratory my $date = shift; return 2000 + ($date-51544.5)/365.25; } sub pm ($$$$$$$$$$) { # - - - # P M # - - - # # Apply corrections for proper motion to a star RA,Dec # (double precision) # # References: # 1984 Astronomical Almanac, pp B39-B41. # (also Lederle & Schwan, Astron. Astrophys. 134, # 1-6, 1984) # # Given: # R0,D0 dp RA,Dec at epoch EP0 (rad) # PR,PD dp proper motions: RA,Dec changes per year of epoch # EP0 dp start epoch in years (e.g. Julian epoch) # EP1 dp end epoch in years (same system as EP0) # # Returned: # R1,D1 dp RA,Dec at epoch EP1 (rad) # # Called: # sla_DCS2C spherical to Cartesian # sla_DCC2S Cartesian to spherical # sla_DRANRM normalize angle 0-2Pi # # Note: # The proper motions in RA are dRA/dt rather than # cos(Dec)*dRA/dt, and are in the same coordinate # system as R0,D0. # # P.T.Wallace Starlink 23 August 1996 # # Copyright (C) 1996 Rutherford Appleton Laboratory my ($r0, $d0, $pr, $pd, $ep0, $ep1) = @_; # Km/s to AU/year multiplied by arc seconds to radians use constant VFR => 0.21094502*0.484813681109535994e-5; my (@em, $t); # Spherical to Cartesian my @p = pol2r($r0,$d0); # Space motion (radians per year) $em[0]=-$pr*$p[1]-$pd*cos($r0)*sin($d0); $em[1]= $pr*$p[0]-$pd*sin($r0)*sin($d0); $em[2]= $pd*cos($d0); # Apply the motion $t=$ep1-$ep0; for (my $i = 0; $i<3; $i++) { $p[$i]=$p[$i]+$t*$em[$i]; } # Cartesian to spherical return r2pol(@p); } 1; __END__ Astro-0.78/Astro/PaxHeader/Misc.pm000644 374311 777777 00000000165 10102434755 017714 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178020 23 SCHILY.dev=16777217 22 SCHILY.ino=9318479 18 SCHILY.nlink=2 Astro-0.78/Astro/Misc.pm000644 374311 110351500000051132 10102434755 015731 0ustar00phi196at-astro000000 000000 package Astro::Misc; use strict; =head1 NAME Astro::Misc - Miscellaneous astronomical routines =head1 SYNOPSIS use Astro::Misc; $U = calc_U($flux, $dist, $freq); ($dist1, $dist2)= kindist($ra, $dec, $vel, $epoch, $model); =head1 DESCRIPTION Astro::Misc contains an assorted set Perl routines for doing various astronomical calculations. =head1 AUTHOR Chris Phillips Chris.Phillips@csiro.au =head1 FUNCTIONS =cut BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL $Temp $parsecAU $au2km $G $c @ThompsonData); $VERSION = '1.01'; @ISA = qw(Exporter); @EXPORT = qw( read_possm calc_U calc_Nl lum2spectral Nl2spectral kindist); @EXPORT_OK = qw ( $Temp read_lovas a model_1 model_2 @ThompsonData $c); @EXPORT_FAIL = qw ( ); use Carp; use POSIX qw( asin log10); use Astro::Time qw( $PI ); use Astro::Coord qw( fk5fk4 fk4gal ); } $parsecAU = 206265; # The length of one parsec in AU $au2km = 149.59787066e6; # Number of km in one AU $G = 6.67e-11; # Gravitational constant $c = 2.99792458e5; # speed of light in km/s $Temp = 1e4; # Electron temperature # Load up the data from Thompson 1984 ApJ 283 165 Table 1 use constant SPEC => 0; use constant LUM => 2; use constant NL => 5; @ThompsonData = (); while () { push @ThompsonData, [split]; } =item B Read_possm interprets the output file from the AIPS POSSM task. the task may be called repeatably if there is more than one POSSM output in the file. The file must be open before calling read_possm, using the FileHandle module. The data from the possm plot is returned in a hash. Some of the header values are returned as scalar values while the actual plot values are returned as references to arrays. The scalar values returned are: SOURCE, DATE, TIME, BANDWIDTH, TYPE (='A&P'||'R&I') The array references are: CHANNEL, VELOCITY, FREQUENCY, AMPLITUDE, PHASE, ANTENNA The global variable $Astro::Misc:oldpossm (default=0) controls whether old or new style possm plots are read. For oldpossm=1, one of VELOCITY or FREQUENCY will be a reference to an empty list (but the hash value IS defined). Usage: use FileHandle my $fh = FileHandle->new(); my %ahash = (); open($fh, 'possmfile'); read_possm($fh, %ahash); Returns: 0 on success (but not hit eof) 1 on success (and hit eof) 2 on premature eof Examples of hash usage: $hash{SOURCE} # Source name @{$hash{VELOCITY}} # Array of velocity values ${$hash{PHASE}}[4] # The fifth phase value =cut sub read_possm ($\%) { my($fh, $hashref) = @_; # Initialise the hash ref $$hashref{CHANNEL} = [()]; $$hashref{VELOCITY} = [()]; $$hashref{FREQUENCY} = [()]; $$hashref{AMPLITUDE} = [()]; $$hashref{PHASE} = [()]; $$hashref{ANTENNA} = [()]; my $eof = 1; # Read the header section while (<$fh>) { if (/^Source:\s*(\S*)/) { $$hashref{SOURCE} = $1; } elsif (/^OBS\.\sDATE:\s(\S+)\s+Time\sof\srecord:\s+ (\d+\/\s+\d+\s+\d+\s+\d+\.\d+)/x) { $$hashref{DATE} = $1; $$hashref{TIME} = $2; } elsif (/^Bw \(\S+\):\s+(\S+)/) { $$hashref{BANDWIDTH} = $1; } elsif (/^Antenna\s#\s+\d+\s+name:\s+(\S+)/) { push @{$$hashref{ANTENNA}}, $1; } elsif (/^DATA/) { $eof = 0; last; } } return 2 if $eof; #Skip until find data $eof = 1; my $velocity = 0; while (<$fh>) { if ($astro::oldpossm) { if (/Channel.*IF.*(Velocity|Frequency).*(Ampl|Real).*(Phase|Imag)/) { $velocity = 1 if ($1 eq 'Velocity'); if ($2 eq 'Ampl') { $$hashref{TYPE} = 'A&P'; } else { $$hashref{TYPE} = 'R&I'; } $eof = 0; last; } } else { # 5/6/03 Minor change. No time to fix properly bugger # if (/Channel.*IF.*Frequency.*Velocity.*(Ampl|Real).*(Phase|Imag)/) { if (/Channel.*IF.*Polar.*Frequency.*Velocity.*(Ampl|Real).*(Phase|Imag)/) { $eof = 0; if ($1 eq 'Ampl') { $$hashref{TYPE} = 'A&P'; } else { $$hashref{TYPE} = 'R&I'; } last; } } } croak "$0: premature EOF" if $eof; # Read the data in $eof = 1; my $n = 0; while (<$fh>) { if ($astro::oldpossm && /\s*(\d+)\s+ # Channel \d+\s+ # IF ([-+]?\d+\.\d*(?:[Ee][\-+]\d+)?)\s+ # Velocity Frequency ([-+]?\d+\.\d*(?:[Ee][\-+]\d+)?)\s+ # Amplitude ([-+]?\d+\.\d*) # Phase /x) { $n++; push(@{$$hashref{CHANNEL}},$1); if ($velocity) { push(@{$$hashref{VELOCITY}},$2); } else { push(@{$$hashref{FREQUENCY}},$2); } push(@{$$hashref{AMPLITUDE}},$3); push(@{$$hashref{PHASE}},$4); } elsif (/\s*(\d+)\s+ # Channel \d+\s+ # IF \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 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 () { 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; if (defined $2) { $calc = $2; } else { $calc = ' '; } if (defined $3) { $uncert = $3; } else { $uncert = ''; } #warn "Used $oldfreq-> $freq:$calc:$uncert\n"; } else { warn "***Failed to parse $freq\n"; } next if (defined $min && $freq<$min); next if (defined $max && $freq>$max); push @lovas, [$freq, $calc, $uncert, $molecule, $form, $tsys, $source, $telescope, $ref]; } close(LOVAS); return @lovas; } # Used internally for calc_U # Ref: Mezger & Henderson 1967, ApJ 147 p 471 Eq A.2 sub a ($) { my $freq = shift; my $a = 0.336 * $freq**0.1 * $Temp**-0.15 * (log(4.995e-2/$freq) + 1.5*log($Temp)); return($a); } =item B $U = calc_U($flux, $dist, $freq); Calculate U (Excitation Parameter) for an UCHII region Based on Eqn 8 in Schraml and Mezger, 1969 $flux Integrated Source Flux Density (Jy) $dist Distance to source (kpc) $freq Frequency of observation (GHz) Note: Uses the global variable $Astro::Misc::Temp for electron temperature Default is 10000K =cut sub calc_U ($$$) { my ($flux, $dist, $freq) = @_; my $U = 4.5526 * ($freq**0.1 / a($freq) * $Temp**0.35 * $flux * $dist**2)**(1/3); return ($U); } =item B $Nl = calc_Nl($U); Calculate the Lyman continuum photon flux given U, the Excitation Parameter for an UCHII region $U is the Excitation Parameter (from calc_U) Ref: Kurtz 1994 ApJS 91 p659 Eq (1) (Original Origin unknown) =cut sub calc_Nl ($) { my ($U) = @_; # This came from Panagia 1973 AJ 78 p929 Eq 5. #my $Nl = ($U / 1.0976 / 2.01e-19)**3 * (3.43e-13); # This is the same from Kurtz but includes the Electron Temperature my $Nl = 8.04e46 * $Temp**-0.85 * $U**3; return $Nl; } ## Replaced by values from Thompson 1984 # my @speclist = ('O4', 'O5', 'O5.5', 'O6', 'O6.5', 'O7', 'O7.5', 'O8', # 'O8.5', 'O9', 'O9.5', 'B0', 'B0.5', 'B1', 'B2', 'B3'); # my @lumlist = (6.11, 5.83, 5.60, 5.40, 5.17, 5.00, 4.92, 4.81, # 4.73, 4.66, 4.58, 4.40, 4.04, 3.72, 3.46, 3.02); # my @Nllist = (49.93, 49.62, 49.36, 49.08, 49.82, 48.62, 48.51, 48.35, 48.21, # 48.08, 47.84, 47.36, 46.23, 45.29, 44.65, 43.69); # die '@lumlist, @speclist and @Nlist must be the same size' # if (scalar(@lumlist) != scalar(@speclist) # || scalar(@lumlist) != scalar(@Nllist)); # =item B # $spectral_type = lum2spectral($luminosity); # Calculate the spectral type of a ZAMS star from its luminosity # Based on Panagia, 1973, ApJ, 78, 929. # $luminosity Star luminosity (normalised to Lsun) # Returns undef if luminosity is out of range (O4 - B3) # =cut # sub lum2spectral ($) { # my ($lum) = @_; # $lum = log10($lum); # my $n = scalar (@speclist); # if ($lum > $lumlist[0]) { # return ">$speclist[0]"; # } elsif ($lum < $lumlist[$n-1]) { # return "<$speclist[$n-1]"; # }; # my $i = 1; # # Find the closest pair # while ($lum < $lumlist[$i]) { # $i++; # } # # Return the closest one # if ($lumlist[$i-1]-$lum > $lum - $lumlist[$i]) { # return $speclist[$i]; # } else { # return $speclist[$i-1]; # } # } # =item B # $spectral = Nl2spectral($Nl); # Calculate the spectral type of a ZAMS star from its flux of # Lyman Continuum Photons (Nl) # Based on Panagia, 1973, ApJ, 78, 929 # $Nl Flux of Lyman Continuum Photons # Returns undef if luminosity is out of range (O4 - B3) # =cut # sub Nl2spectral ($) { # my ($Nl) = @_; # $Nl = log10($Nl); # my $n = scalar (@speclist); # if ($Nl > $Nllist[0]) { # return ">$speclist[0]"; # } elsif ($Nl < $Nllist[$n-1]) { # return "<$speclist[$n-1]"; # }; # my $i = 1; # # Find the closest pair # while ($Nl < $Nllist[$i]) { # $i++; # } # # Return the closest one # if ($Nllist[$i-1]-$Nl > $Nl - $Nllist[$i]) { # return $speclist[$i]; # } else { # return $speclist[$i-1]; # } # } =item B $spectral_type = lum2spectral($luminosity); Calculate the spectral type of a ZAMS star from its luminosity Based on Thompson 1984 ApJ 283 165 Table 1 $luminosity Star luminosity (normalised to Lsun) =cut sub lum2spectral($) { my $lum = log10(shift); my $n = scalar (@ThompsonData); if ($lum < $ThompsonData[0][LUM]) { return "<$ThompsonData[0][SPEC]"; } elsif ($lum > $ThompsonData[$n-1][LUM]) { return ">$ThompsonData[$n-1][SPEC]"; }; $n = 1; # Find the closest pair while ($lum > $ThompsonData[$n][LUM]) { $n++; } # Return the closest one if ($ThompsonData[$n][LUM]-$lum < $lum - $ThompsonData[$n-1][LUM]) { return $ThompsonData[$n][SPEC]; } else { return $ThompsonData[$n-1][SPEC]; } } =item B $spectral = Nl2spectral($Nl); Calculate the spectral type of a ZAMS star from its flux of Lyman Continuum Photons (Nl) Based on Panagia, 1973, ApJ, 78, 929 $Nl Flux of Lyman Continuum Photons =cut sub Nl2spectral ($) { my $Nl = log10(shift); my $n = scalar (@ThompsonData); if ($Nl < $ThompsonData[0][NL]) { return "<$ThompsonData[0][SPEC]"; } elsif ($Nl > $ThompsonData[$n-1][NL]) { return ">$ThompsonData[$n-1][SPEC]"; }; $n = 1; # Find the closest pair while ($Nl > $ThompsonData[$n][NL]) { $n++; } # Return the closest one if ($ThompsonData[$n][NL]-$Nl < $Nl - $ThompsonData[$n-1][NL]) { return $ThompsonData[$n][SPEC]; } else { return $ThompsonData[$n-1][SPEC]; } } =item B ($dist1, $dist2)= kindist($ra, $dec, $vel, $epoch, $model); Calculate the kinematic distance to an object $dist1, $dist2 Near/Far distance (kpc) $ra RA of object (turns) $dec Dec of object (turns) $vel LSR Velocity (km/s) $epoch Epoch of coords (J2000/J/B1950/B) $model Model to use (1 or 2) Note: Model 1 is based on Brand and Blitz, 1993, A&A, 275, 67-90. Model 2 has unknown origin. =cut sub kindist ($$$$$) { my ($ra, $dec, $vel, $epoch, $model) = @_; my ($l, $b, $dist1, $dist2, $psi, $phi, $phid, $psid); $l = 0.0; $b = 0.0; if (($epoch eq 'J2000') || ($epoch eq 'J')) { ($ra, $dec) = fk5fk4($ra, $dec); } ($l, $b) = fk4gal($ra, $dec); $l *= 2.0*$PI; $b *= 2.0*$PI; croak "\$model must equal 1 or 2\n" if ($model != 1 && $model != 2) ; my $Ro = 8.5; my $THETAo = 220; my $R = 0.0004; my $Wo = $THETAo/$Ro; my $W = $vel/($Ro * sin($l)) + $Wo; my ($sampW); my $eps = 9999999.0; while ($eps > 0.1) { $R += 0.1; if ($model == 1) { $sampW = model_1($R); } else { $sampW = model_2($R); } $eps = abs($W - $sampW)/$W; if ($R > 5.0*$Ro) { warn "Could not find within limits.\n"; $eps = 0.0; } } $R = $R - 0.5; $R = 0.0 if ($R < 0.0); $eps = 9999999.0; while ($eps > 0.0001) { $R += 0.0001; if ($model == 1) { $sampW = model_1($R); } else { $sampW = model_2($R); } $eps = abs($W - $sampW)/$W; if ($R > 5.0*$Ro) { warn "Could not find within limits.\n"; $eps = 0.0; } } if ( sin($l) * $Ro/$R > 1.0) { $psi = $PI/2; } elsif ( sin($l)*$Ro/$R < -1.0) { $psi = -$PI/2; } else { $psi = asin(sin($l)*$Ro/$R); } $phi = $PI - $psi - $l; if (sin($l) == 0.0) { $dist1 = 0.0; $dist2 = 0.0; } else { $dist1 = abs($R*sin($phi)/sin($l)); $psid = $PI - $psi; $phid = $PI - $psid - $l; $dist2 = abs($R*sin($phid)/sin($l)); } if ($dist1 <= $dist2) { return($dist1, $dist2); } else { return($dist2, $dist1); } } sub model_1 ($) { # Model from Brand and Blitz, 1993, A&A, 275, 67-90 my ($R) = @_; my $Ro = 8.5; my $THETAo = 220; my $q = 1.00767; my $rr = 0.0394; my $s = 0.00712; # my $s = 0.00698; # my $q = 1.0074; # my $rr = 0.0382; return (($q*($R/$Ro)**$rr + $s)*$THETAo/$R); } sub model_2 ($) { my ($R) = @_; my $Ro = 8.5; my $THETAo = 220; my @A = (0.0, +3069.81, -15809.8, +43980.1, -68287.3, +54904.0, -17731.0); my @B = (+325.0912, -248.1467, +231.87099, -110.73531, +25.073006, -2.110625); my @C = (-2342.6564, +2507.60391, -1024.068760, +224.562732, -28.4080026, +2.0697271, -0.08050808, +0.00129348); my $D0 = 234.88; my $term1 = 0.0; my ($i); if ($R <= 0.09*$Ro) { for ($i = 0; $i < 7; $i++) { $term1 = $term1 + $A[$i]*$R**$i; } } elsif ((0.09*$Ro < $R) && ($R <= 0.45*$Ro)) { for ($i = 0; $i < 6; $i++) { $term1 = $term1 + $B[$i]*$R**$i; } } elsif (((0.45*$Ro) < $R) && ($R <= (1.6*$Ro))) { for ($i = 0; $i < 8; $i++) { $term1 = $term1 + $C[$i]*$R**$i; } } elsif ((1.6*$Ro) < $R) { $term1 = $D0; } else { die "model_2 inconsistent\n"; } return ($term1/$R); } 1; __DATA__ G2 5500 -0.17 10.80 41.00 28.42 55.92 56.07 43.33 G2 5800 0.00 10.84 41.90 29.32 56.19 56.34 43.60 GO 5980 0.10 10.86 42.44 29.85 56.35 56.50 43.76 G0 6000 0.11 10.86 42.49 29.90 56.37 56.52 43.78 F8 6210 0.22 10.88 43.14 30.55 56.53 56.68 43.94 F7 6370 0.28 10.89 43.50 30.91 56.62 56.77 44.03 F7 6500 0.34 10.91 43.85 31.26 56.71 56.86 44.13 F6 6580 0.38 10.92 44.06 31.47 56.76 56.91 44.18 F5 6810 0.48 10.94 44.59 32.00 56.90 57.05 44.32 F3 7000 0.56 10.95 45.01 32.43 57.01 57.16 44.43 F2 7240 0.66 10.97 45.39 32.80 57.14 57.29 44.56 F2 7500 0.77 11.00 45.80 33.21 57.29 57.44 44.70 F0 7520 0.78 11.00 45.86 33.27 57.30 57.45 44.71 F0 8000 0.94 11.03 46.78 34.19 57.52 57.67 44.93 A5 8500 1.11 11.06 47.81 35.22 57.74 57.89 45.16 A4 8630 1.16 11.07 48.22 36.63 57.81 57.96 45.23 A3 8840 1.23 11.08 48.79 36.20 57.91 58.06 45.33 A3 9000 1.27 11.09 49.11 36.53 57.97 58.12 45.39 A2 9070 1.29 11.09 49.27 36.69 58.00 58.15 45.42 A1 9320 1.35 11.10 49.77 37.19 58.09 58.24 45.51 A1 9400 1.37 11.10 49.93 37.34 58.12 58.27 45.54 A0 9600 1.43 11.12 50.24 37.65 58.20 58.35 45.62 B9.5 10000 1.55 11.14 50.85 38.26 58.37 58.52 45.78 B9.5 10500 1.69 11.17 51.39 38.81 58.55 58.70 45.96 B9 10700 1.74 11.17 51.62 39.04 58.62 58.77 46.03 B9 11000 1.79 11.18 51.85 39.26 58.69 58.84 46.10 B9 11500 1.88 11.18 52.26 39.67 58.80 58.95 46.22 B8 12000 1.97 11.19 52.62 40.03 58.92 59.07 46.33 B8 12500 2.06 11.20 52.98 40.39 59.03 59.18 46.44 B8 13000 2.13 11.20 53.29 40.71 59.11 59.26 46.53 B7 13600 2.22 11.21 53.60 41.02 59.22 59.37 46.63 B7 14000 2.30 11.22 53.88 41.30 59.30 59.45 46.71 B6 14600 2.42 11.24 54.23 41.65 59.43 59.58 46.84 B6 15000 2.50 11.26 54.47 41.89 59.52 59.67 46.93 B5 15600 2.61 11.28 54.80 42.22 59.64 59.79 47.05 B5 16000 2.68 11.30 55.01 42.42 59.71 59.86 47.12 B5 17000 2.85 11.33 55.52 42.93 59.88 60.03 47.30 B3 17900 3.01 11.36 55.95 43.36 60.05 60.20 47.47 B3 18000 3.03 11.37 56.00 43.41 60.07 60.22 47.48 B3 20000 3.37 11.45 56.83 44.24 60.41 60.56 47.83 B2 20500 3.45 11.46 57.04 44.45 60.49 60.64 47.91 B2 22500 3.69 11.51 57.66 45.08 60.73 60.88 48.14 B1 22600 3.70 11.51 57.69 45.11 60.74 60.89 48.15 B1 25000 3.92 11.53 58.36 45.78 60.96 61.11 48.37 B0.5 26200 4.03 11.54 58.70 46.12 61.07 61.22 48.48 B0.5 30000 4.33 11.58 59.62 47.03 61.36 61.51 48.77 B0 30900 4.40 11.59 59.82 47.23 61.42 61.57 48.83 O9.5 33000 4.58 11.61 60.34 47.75 61.58 61.73 48.99 O9 34500 4.66 11.62 60.57 47.98 61.65 61.80 49.06 O9 35000 4.70 11.63 60.68 48.09 61.69 61.84 49.10 O8.5 35500 4.73 11.63 60.73 48.14 61.72 61.87 49.13 O8 36500 4.81 11.65 60.85 48.26 61.79 61.94 49.20 O7.5 37500 4.92 11.68 61.02 48.43 61.88 62.03 49.29 O7 38500 5.00 11.70 61.15 48.56 61.95 62.10 49.36 O6.5 40000 5.17 11.75 61.41 48.83 62.10 62.25 49.51 O6 42000 5.40 11.82 61.67 49.08 O5.5 44500 5.60 11.87 61.95 49.36 O5 47000 5.83 11.94 62.21 49.62 O4 50000 6.11 12.02 62.52 49.93 Astro-0.78/Astro/PaxHeader/Time.pm000644 374311 777777 00000000233 12373304204 017710 xustar00phi196at-astro000000 000000 14 gid=296781 20 ctime=1430178023 20 atime=1430178020 38 LIBARCHIVE.creationtime=1361227153 23 SCHILY.dev=16777217 22 SCHILY.ino=9318480 18 SCHILY.nlink=2 Astro-0.78/Astro/Time.pm000644 374311 110351500000074431 12373304204 015740 0ustar00phi196at-astro000000 000000 package Astro::Time; use strict; =head1 NAME Astro::Time - Time based astronomical routines =head1 SYNOPSIS use Astro::Time; $dayno = cal2dayno($day, $month, $year); print "It's a leap year!\n" if (leap($year)); $lmst = mjd2lst($mjd, $longitude, $dUT1); $turns = str2turn($string, 'H'); $str = turn2str($turn, 'D', $sig); =head1 DESCRIPTION Astro::Time contains an assorted set Perl routines for time based conversions, such as conversion between calendar dates and Modified Julian day and conversion of UT to local sidereal time. Include are routines for conversion between numerical and string representation of angles. =head1 AUTHOR Chris Phillips Chris.Phillips@csiro.au =head1 FUNCTIONS =cut BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL $PI $StrSep $StrZero $Quiet ); $VERSION = '1.22'; @ISA = qw(Exporter); @EXPORT = qw( cal2dayno dayno2cal leap yesterday tomorrow mjd2cal cal2mjd mjd2dayno dayno2mjd now2mjd mjd2epoch jd2mjd mjd2jd mjd2time mjd2vextime mjd2weekday mjd2weekdaystr gst mjd2lst cal2lst dayno2lst rise lst2mjd turn2str deg2str rad2str str2turn str2deg str2rad hms2time time2hms month2str str2month deg2rad rad2deg turn2rad rad2turn turn2deg deg2turn $PI ); @EXPORT_OK = qw ( daynoOK monthOK dayOK utOK nint $StrSep $StrZero $Quiet); @EXPORT_FAIL = qw ( @days @MonthShortStr @MonthStr @WeekShortStr @WeekStr); use Carp; use POSIX qw( fmod floor ceil acos ); } $PI = 3.1415926535897932384626433832795028841971693993751; $StrZero = 0; $StrSep = ':'; my $debug = 0; # Used for debugging str2turn $Quiet = 0; my @days = (31,28,31,30,31,30,31,31,30,31,30,31); my @MonthShortStr = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); my @MonthStr = ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September','October', 'November', 'December'); my @WeekShortStr = ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun'); my @WeekStr = ('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday'); # Is the dayno valid? sub daynoOK ($$) { my ($dayno, $year) = @_; if ($dayno<1 || $dayno>366 || ($dayno>365 && !leap($year))) { carp '$dayno out of range' if (!$Quiet); return 0; } else { return 1; } } # Is the month valid? sub monthOK ($) { my $month = shift; if ($month > 12 || $month < 1) { carp '$month out of range' if (!$Quiet); return 0; } else { return 1 } } # IS the day of month OK? (assumes month IS ok - should be checked first) sub dayOK ($$$) { my ($day, $month, $year) = @_; $month--; # For array indexing if (leap($year)) { $days[1] = 29; } else { $days[1] = 28; } if ($day < 1 || $day > $days[$month]) { carp '$day out of range' if (!$Quiet); return 0; } else { return 1; } } # Is the day fraction OK? sub utOK ($) { my $ut = shift; if ($ut < 0.0 || $ut >= 1.0) { carp '$ut out of range' if (!$Quiet); return 0; } else { return 1; } } # Return the nearest integer (ie round) sub nint ($) { my ($x) = @_; ($x<0.0) ? return(ceil($x-0.5)) : return(floor($x+0.5)) } =over 4 =item B $str = turn2str($turn, $mode, $sig); $str = turn2str($turn, $mode, $sig, $strsep); Convert fraction of a turn into string representation $turn Angle in turns $mode Mode of string to convert to: 'H' for hours 'D' for degrees $sig number of significant figures $strsep String separator (override for default $Astro::Time::StrSep) Note: The behavior can be modified by the following two variables: $Astro::Time::StrZero Minimum number of leading digits (zero padded if needed) $Astro::Time::StrSep (Overridden by optional fourth argument) Deliminator used in string (Default ':') This may also equal one of a number of special values: 'HMS' 12H45M12.3S or 170D34M56.2S 'hms' 12h45m12.3s or 170d34m56.2s 'deg' 170d34'56.2" =cut sub turn2str ($$$;$) { my($turn, $mode, $sig, $strsep) = @_; $mode = uc $mode; if (($mode ne 'H') && ($mode ne 'D')) { carp 'turn2str: $mode must equal \'H\' or \'D\''; return undef; } $strsep = $StrSep if (!defined $strsep); my ($angle, $str, $sign, $wholesec, $secfract, $min); if ($mode eq 'H') { $angle = $turn * 24; } else { $angle = $turn * 360; } if ($angle < 0.0) { $sign = -1; $angle = -$angle; } else { $sign = 1; } my $wholeangle = (int $angle); $angle -= $wholeangle; $angle *= 3600; # Get second fraction $wholesec = int $angle; $secfract = $angle - $wholesec; $wholesec %= 60; $min = ($angle-$wholesec - $secfract)/60.0; $secfract = int ($secfract * 10**$sig + 0.5); # Add 0.5 to ensure rounding # Check we have not rounded too far if ($secfract >= 10**$sig) { $secfract -= 10**$sig; $wholesec++; if ($wholesec >= 60.0) { $wholesec -= 60; $min++; if ($min >= 60.0) { $min -= 60; $wholeangle++; } } } my $angleform; if ($StrZero > 0) { $angleform = "%0$StrZero"; } else { $angleform = '%'; } my ($sep1, $sep2, $sep3); if ($strsep eq 'HMS') { if ($mode eq 'H') { $sep1 = 'H'; } else { $sep1 = 'D'; } $sep2 = 'M'; $sep3 = 'S'; } elsif ($strsep eq 'hms') { if ($mode eq 'H') { $sep1 = 'h'; } else { $sep1 = 'd'; } $sep2 = 'm'; $sep3 = 's'; } elsif ($strsep eq 'deg') { # What if $mode eq 'H'?? $sep1 = 'd'; $sep2 = "'"; $sep3 = '"'; } else { $sep1 = $sep2 = $strsep; $sep3 = ''; } if ($sig > 0) { $str = sprintf("${angleform}d$sep1%02d". "$sep2%02d.%0${sig}d$sep3", $wholeangle, $min, $wholesec, $secfract); } else { $str = sprintf("${angleform}d$sep1%02d". "$sep2%02d$sep3", $wholeangle, $min, $wholesec); } if ($sign == -1) { $str = '-'.$str; } return $str; } =item B $str=deg2str($deg, $mode, $sig); Convert degrees into string representation $deg angle in degrees $mode mode of string to convert to: 'H' for hours 'D' for degrees $sig number of significant figures See note for turn2str =cut sub deg2str ($$$;$) { my($deg, $mode, $sig, $strsep) = @_; return turn2str($deg/(360), $mode, $sig, $strsep); } =item B $str=rad2str($rad, $mode, $sig); Convert radians into string representation $rad angle in radians $mode mode of string to convert to: 'H' for hours 'D' for degrees $sig is number of significant figures See note for turn2str =cut sub rad2str ($$$;$) { my($rad, $mode, $sig, $strsep) = @_; return turn2str($rad/(2*$PI), $mode, $sig, $strsep); } =item B $turns = str2turn($string,$mode); Convert angle from string representation into fraction of a turn $string a : or space delimited angle $mode type of angle 'H' if $string is in hours,min,sec 'D' if $string is in deg,arcmin,arcsec The format of $string can be fairly flexible e.g.: 12.2 12:34 12:34:45.1 -23 34 12.3 -34 34.3 Note: You cannot mix spaces and : =cut sub str2turn ($$) { my($str,$mode) = @_; if (! defined $str) { carp 'Use of uninitialized value at'; return undef; } $mode = uc $mode; if (($mode ne "H") && ($mode ne "D")) { carp 'str2turn: $mode must equal "H" or "D"'; return undef; } my $sign = 1.0; my $angle = 0.0; my $min = 0.0; my $sec = 0.0; # Does it match dd:dd:dd.d form if ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional) (\d*): # Hours degrees (\d{0,2})(?:: # Minutes (\d{0,2}(?:\.\d*)?))? # Seconds and fractions (both optional) /x) { print STDERR "Matches dd:dd:dd.d\n" if $debug; $sign = -1 if (defined($1) && $1 eq "-"); $angle = $2 if ($2); $min = $3 if ($3); $sec = $4 if ($4); # Does it match hms form 12h33m34.6s } elsif ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional) (\d+)\s*(h)\s* # Hours (?:(\d{0,2})\s*m\s* # Minutes optional (?:(\d{0,2} # Seconds and fractions (optional) (?:\.\d*)?)\s*s)?)? /x) { print STDERR "Matches hms\n" if $debug; $sign = -1 if (defined($1) && $1 eq "-"); $angle = $2 if ($2); $mode = 'H'; $min = $4 if ($4); $sec = $5 if ($5); # Does it match dms form 12d33m34.6s or 12d33'34.6" } elsif ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional) (\d+)\s*([d])\s* # Degrees (?:(\d{0,2})\s*[m']\s* # Minutes optional (?:(\d{0,2} # Seconds and fractions (optional) (?:\.\d*)?)\s*[s"])?)? /x) { print STDERR "Matches dms\n" if $debug; $sign = -1 if (defined($1) && $1 eq "-"); $angle = $2 if ($2); #$mode = uc($3); $mode = 'D'; $min = $4 if ($4); $sec = $5 if ($5); # Does is match dd dd dd.d form } elsif ($str =~ /^\s*(?:([+-])\s*)? # Sign (optional) (\d+)\s+ # Hours degrees (\d{0,2})(?:\s+ # Minutes (\d{0,2}(?:\.\d*)?))? # Seconds and fractions /x) { print STDERR "Matches dd dd dd.d\n" if $debug; $sign = -1 if (defined($1) && $1 eq "-"); $angle = $2 if ($2); $min = $3 if ($3); $sec = $4 if ($4); # Does it match dd.d form } elsif ($str =~ /^\s*(?:([+-])\s*)?(\d+(?:\.\d*)?)/) { print STDERR "Matches dd.d\n" if $debug; $sign = -1 if (defined($1) && $1 eq "-"); $angle = $2 if ($2); } else { return undef; } my $factor; if ($mode eq "H") { $factor = 24.0; } else { $factor = 360.0; } print "Got ($sign) $angle/$min/$sec [$mode]\n" if $debug; return $sign * (($angle + ($min + $sec/60.0)/60.0)/ $factor); } =item B $degrees=str2deg($string,$mode); Convert angle from string representation into degrees $string a : or space delimited angle $mode 'H' if $string is in hours,min,sec 'D' if $string is in deg,arcmin,arcsec See note for str2turn =cut sub str2deg ($$) { my($str, $mode) = @_; return str2turn($str, $mode) * 360; } =item B $radians=str2rad($string,$mode); Convert angle from string representation into radians $string a : or space delimited angle $mode 'H' if $string is in hours,min,sec 'D' if $string is in deg,arcmin,arcsec See note for str2turn =cut sub str2rad ($$) { my($str, $mode) = @_; return str2turn($str, $mode) * 2*$PI; } =item B ($time) = hms2time($hour, $minute, $second); ($time) = hms2time($hour, $minute, $second, $mode); Returns the day fraction given hours minutes and seconds (or degrees) $time Day fraction $hour Hours $minutes Minutes $second Seconds $mode 'H' or 'D' to interpret as hours or degrees (default hours) =cut sub hms2time ($$$;$) { my($hour, $minute, $second, $mode) = @_; $mode = 'H' if (!defined $mode); my $factor; if ($mode eq 'H' || $mode eq 'h') { $factor = 24.0; } elsif ($mode eq 'D' || $mode eq 'd') { $factor = 360.0; } else { carp 'Illegal $mode value'; return undef; } return (($second/60 + $minute)/60 + $hour)/$factor; } =item B ($sign, $hour, $minute, $second) = time2hms($time, $mode, $sig); Returns hours (or degrees), minutes and seconds given the day fraction $sign Sign of angle ('+' or '-') $hour Hours $minutes Minutes $second Seconds $time Day fraction $mode Return degrees or Hours? 'H' for hours 'D' for degrees $sig Number of significant digits for $second =cut sub time2hms ($$$) { my($turn, $mode, $sig) = @_; $mode = uc $mode; if (($mode ne 'H') && ($mode ne 'D')) { carp 'time2hms: $mode must equal \'H\' or \'D\''; return undef; } my ($angle, $str, $sign, $wholesec, $secfract, $min); if ($mode eq 'H') { $angle = $turn * 24; } else { $angle = $turn * 360; } if ($angle < 0.0) { $sign = '-'; $angle = -$angle; } else { $sign = '+'; } my $wholeangle = (int $angle); $angle -= $wholeangle; $angle *= 3600; # Get second fraction $wholesec = int $angle; $secfract = $angle - $wholesec; $wholesec %= 60; $min = ($angle-$wholesec - $secfract)/60.0; $secfract = int ($secfract * 10**$sig + 0.5); # Add 0.5 to ensure rounding # Check we have not rounded too far if ($secfract >= 10**$sig) { $secfract -= 10**$sig; $wholesec++; if ($wholesec >= 60.0) { $wholesec -= 60; $min++; if ($min >= 60.0) { $min -= 60; $wholeangle++; } } } my $format = sprintf '%%0%dd', $sig; $secfract = sprintf($format, $secfract); if ($sig > 0) { return($sign, $wholeangle, $min, "$wholesec.$secfract"); } else { return($sign, $wholeangle, $min, $wholesec); } } =item B $rad=deg2rad($deg); Convert degrees to radians =cut sub deg2rad ($) { return $_[0] / 180*$PI; } =item B $deg=rad2deg($rad); Convert radians to degrees =cut sub rad2deg ($) { return $_[0] * 180/$PI; } =item B $rad=turn2rad($turn); Convert turns to radians =cut #sub turn2rad ($) { # return $_[0] * 2*$PI; #} sub turn2rad { my @ret; foreach (@_) { push @ret, $_ * 2*$PI; } if (@ret==1) { return $ret[0]; } elsif (@ret==0) { return undef; } else { return @ret; } } =item B $turn=rad2turn($rad); Convert radians to turns =cut #sub rad2turn ($) { # return $_[0] / (2*$PI); #} sub rad2turn { my @ret; foreach (@_) { push @ret, $_/(2*$PI); } if (@ret==1) { return $ret[0]; } elsif (@ret==0) { return undef; } else { return @ret; } } =item B $deg=turn2deg($turn); Convert turns to radians =cut #sub turn2deg ($) { # return $_[0] * 360.0; #} sub turn2deg { my @ret; foreach (@_) { push @ret, $_*360.0; } if (@ret==1) { return $ret[0]; } elsif (@ret==0) { return undef; } else { return @ret; } } =item B $turn=deg2turn($deg); Convert degrees to turns =cut #sub deg2turn ($) { # return $_[0] / 360.0; #} sub deg2turn { my @ret; foreach (@_) { push @ret, $_/360.0; } if (@ret==1) { return $ret[0]; } elsif (@ret==0) { return undef; } else { return @ret; } } =item B $dayno = cal2dayno($day, $month, $year); Returns the day number corresponding to $day of $month in $year. =cut # VERIFYED sub cal2dayno ($$$) { my ($day, $month, $year) = @_; return undef if (!monthOK($month)); return undef if (!dayOK($day, $month, $year)); $month--; # For array indexing if (leap($year)) { $days[1] = 29; } else { $days[1] = 28; } my $mon; my $dayno = $day; for ($mon=0; $mon<$month; $mon++) { $dayno += $days[$mon]; } return($dayno); } =item B ($day, $month) = dayno2cal($dayno, $year); Return the $day and $month corresponding to $dayno of $year. =cut # Verified sub dayno2cal ($$) { my($dayno, $year) = @_; return undef if (!daynoOK($dayno, $year)); if (leap($year)) { $days[1] = 29; } else { $days[1] = 28; } my $month = 0; my $end = $days[$month]; while ($dayno>$end) { $month++; $end+= $days[$month]; } $end -= $days[$month]; my $day = $dayno - $end; $month++; return($day, $month); } =item B $isleapyear = leap($year); Returns true if $year is a leap year. $year year in full =cut # NOT Verified sub leap ($) { my $year = shift; return (((!($year%4))&&($year%100))||(!($year%400))); } =item B ($dayno, $year) = yesterday($dayno, $year); ($day, $month, $year) = yesterday($day, $month, $year); Winds back the day number by one, taking account of year wraps. $dayno Day number of year $year Year $month Month $day Day of month =cut # Verified sub yesterday($$;$) { my ($day, $month, $dayno, $year); if (scalar(@_)==2) { ($dayno, $year) = @_; return undef if (!daynoOK($dayno, $year)); } else { ($day, $month, $year) = @_; return undef if (!monthOK($month)); return undef if (!dayOK($day, $month, $year)); $dayno = cal2dayno($day, $month, $year); } $dayno--; if ($dayno==0) { $year--; if (leap($year)) { $dayno = 366; } else { $dayno = 365; } } if (scalar(@_)==2) { return ($dayno, $year); } else { ($day, $month) = dayno2cal($dayno, $year); return($day, $month, $year); } } =item B ($dayno, $year) = tomorrow($dayno, $year); ($day, $month, $year) = tomorrow($day, $month, $year); Advances the day number by one, taking account of year wraps. $dayno Day number of year $year Year $month Month $day Day of month =cut # Verified sub tomorrow($$;$) { my ($day, $month, $dayno, $year); if (scalar(@_)==2) { ($dayno, $year) = @_; return undef if (!daynoOK($dayno, $year)); } else { ($day, $month, $year) = @_; return undef if (!monthOK($month)); return undef if (!dayOK($day, $month, $year)); $dayno = cal2dayno($day, $month, $year); } $dayno++; if (($dayno==366 && !leap($year)) || $dayno==367) { $year++; $dayno = 1; } if (scalar(@_)==2) { return ($dayno, $year); } else { ($day, $month) = dayno2cal($dayno, $year); return($day, $month, $year); } } =item B ($day, $month, $year, $ut) = mjd2cal($mjd); Converts a modified Julian day number into calendar date (universal time). (based on the slalib routine sla_djcl). $mjd Modified Julian day (JD-2400000.5) $day Day of the month. $month Month of the year. $year Year $ut UT day fraction =cut # VERIFIED sub mjd2cal($) { my $mjd = shift; my $ut = fmod($mjd,1.0); if ($ut<0.0) { $ut += 1.0; $mjd -= 1; } use integer; # Calculations require integer division and modulation # Get the integral Julian Day number my $jd = nint($mjd + 2400001); # Do some rather cryptic calculations my $temp1 = 4*($jd+((6*(((4*$jd-17918)/146097)))/4+1)/2-37); my $temp2 = 10*((($temp1-237)%1461)/4)+5; my $year = $temp1/1461-4712; my $month =(($temp2/306+2)%12)+1; my $day = ($temp2%306)/10+1; return($day, $month, $year, $ut); } =item B $mjd = cal2mjd($day, $month, $year, $ut); Converts a calendar date (universal time) into modified Julian day number. $day Day of the month. $month Month of the year. $year Year $ut UT dayfraction $mjd Modified Julian day (JD-2400000.5) =cut # Verified sub cal2mjd($$$;$) { my($day, $month, $year, $ut) = @_; $ut = 0.0 if (!defined $ut); return undef if (!monthOK($month)); return undef if (!dayOK($day, $month, $year)); return undef if (!utOK($ut)); my ($m, $y); if ($month <= 2) { $m = int($month+9); $y = int($year-1); } else { $m = int($month-3); $y = int($year); } my $c = int($y/100); $y = $y-$c*100; my $x1 = int(146097.0*$c/4.0); my $x2 = int(1461.0*$y/4.0); my $x3 = int((153.0*$m+2.0)/5.0); return($x1+$x2+$x3+$day-678882+$ut); } =item B ($dayno, $year, $ut) = mjd2dayno($mjd); Converts a modified Julian day number into year and dayno (universal time). $mjd Modified Julian day (JD-2400000.5) $year Year $dayno Dayno of year =cut # NOT Verified sub mjd2dayno($) { my $mjd = shift; my ($day, $month, $year, $ut) = mjd2cal($mjd); return (cal2dayno($day,$month,$year), $year, $ut); } =item B $mjd = dayno2mjd($dayno, $year, $ut); Converts a dayno and year to modified Julian day $mjd Modified Julian day (JD-2400000.5) $year Year $dayno Dayno of year =cut # Not verified - wrapper to cal2mjd sub dayno2mjd($$;$) { my ($dayno, $year, $ut) = @_; $ut = 0.0 if (!defined $ut); return undef if (!daynoOK($dayno,$year)); return undef if (!utOK($ut)); my ($day, $month) = dayno2cal($dayno, $year); return cal2mjd($day, $month, $year, $ut); } =item B $mjd = now2mjd() =cut # Not verified - just wrapper sub now2mjd() { my ($s, $m, $h, $day, $month, $year) = gmtime(); $month++; $year += 1900; return(cal2mjd($day, $month, $year, ((($s/60+$m)/60+$h)/24))); } =item B $mjd = jd2mjd($jd); Converts a Julian day to Modified Julian day $jd Julian day $mjd Modified Julian day =cut sub jd2mjd($) { return (shift)-2400000.5; } =item B $jd = mjd2jd($mjd); Converts a Modified Julian day to Julian day $mjd Modified Julian day $jd Julian day =cut sub mjd2jd($) { return (shift)+2400000.5; } =item B $str = mjd2time($mjd); $str = mjd2time($mjd, $np); Converts a Modified Julian day to a formatted string $mjd Modified Julian day $str Formatted time $np Number of significant digits for fraction of a sec. Default 0 =cut sub mjd2time($;$) { my ($dayno, $year, $ut) = mjd2dayno(shift); my $np = shift; $np = 0 if (! defined $np); return sprintf("$year %03d/%s", $dayno, turn2str($ut, 'H', $np)); } =item B $str = mjd2vextime($mjd); $str = mjd2vextime($mjd, $np); Converts a Modified Julian day to a vex formatted string $mjd Modified Julian day $str Formatted time $np Number of significant digits for fraction of a sec. Default 0 =cut sub mjd2vextime($;$) { my ($dayno, $year, $ut) = mjd2dayno(shift); my $np = shift; $np = 0 if (! defined $np); return sprintf("%dy%03dd%s", $year, $dayno, turn2str($ut, 'H', $np, 'hms')); } =item B $time = mjd2epoch($mjd); Converts a Modified Julian day to unix Epoch (seconds sinve 1 Jan 1970) Rounded to the nearest second $mjd Modified Julian day $tie Seconds since 1 Jan 1970 =cut sub mjd2epoch($) { my $mjd = shift; my $epoch = ($mjd - 40587)*24*60*60; return int($epoch + $epoch/abs($epoch*2)); # Work even if epoch is negative } =item B $gst = gst($mjd); $gmst = gst($mjd, $dUT1); $gtst = gst($mjd, $dUT1, $eqenx); Converts a modified Julian day number to Greenwich sidereal time $mjd modified Julian day (JD-2400000.5) $dUT1 difference between UTC and UT1 (UT1 = UTC + dUT1) (seconds) $eqenx Equation of the equinoxes (not yet supported) $gst Greenwich sidereal time (turns) $gmst Greenwich mean sidereal time (turns) $gtst Greenwich true sidereal time (turns) =cut # Verified sub gst($;$$) { my ($mjd, $dUT1, $eqenx) = @_; $dUT1 = 0.0 if (! defined $dUT1); if ($dUT1 > 0.5 || $dUT1 < -0.5) { carp '$dUT1 out of range'; return undef; } if (defined $eqenx) { croak '$eqenx is not supported yet'; } my $JULIAN_DAY_J2000 = 2451545.0; my $JULIAN_DAYS_IN_CENTURY = 36525.0; my $SOLAR_TO_SIDEREAL = 1.002737909350795; my $a=101.0 + 24110.54841/86400.0; my $b=8640184.812866/86400.0; my $e=0.093104/86400.0; my $d=0.0000062/86400.0; my $tu = (int($mjd)-($JULIAN_DAY_J2000-2400000.5))/$JULIAN_DAYS_IN_CENTURY; my $sidtim = $a + $tu*($b + $tu*($e - $tu*$d)); $sidtim -= int($sidtim); if ($sidtim < 0.0) {$sidtim += 1.0}; my $gmst = $sidtim + ($mjd - int($mjd) + $dUT1/86400.0)*$SOLAR_TO_SIDEREAL; while ($gmst<0.0) { $gmst += 1.0; } while ($gmst>1.0) { $gmst -= 1.0; } return $gmst; } # Not verified - wrapper to gmst =item B $lst = mjd2lst($mjd, $longitude); $lmst = mjd2lst($mjd, $longitude, $dUT1); $ltst = mjd2lst($mjd, $longitude, $dUT1, $eqenx); Converts a modified Julian day number into local sidereal time (lst), local mean sidereal time (lmst) or local true sidereal time (ltst). Unless high precisions is required dUT1 can be omitted (it will always be in the range -0.5 to 0.5 seconds). $mjd Modified Julian day (JD-2400000.5) $longitude Longitude for which the LST is required (turns) $dUT1 Difference between UTC and UT1 (UT1 = UTC + dUT1)(seconds) $eqenx Equation of the equinoxes (not yet supported) $lst Local sidereal time (turns) $lmst Local mean sidereal time (turns) $ltst Local true sidereal time (turns) =cut sub mjd2lst($$;$$) { my ($mjd, $longitude, $dUT1, $eqenx) = @_; my $lst = gst($mjd, $dUT1, $eqenx); return undef if (!defined $lst); $lst += $longitude; while ($lst>1.0) { $lst-= 1; } while ($lst < 0.0) { $lst += 1; } return $lst; } =item B $lst = cal2lst($day, $month, $year, $ut, $longitude); $lmst = cal2lst($day, $month, $year, $ut, $longitude, $dUT1); $ltst = cal2lst($day, $month, $year, $ut, $longitude, $dUT1, $eqenx); Wrapper to mjd2lst using calendar date rather than mjd =cut sub cal2lst($$$$$;$$) { my ($day, $month, $year, $ut, $longitude, $dUT1, $eqenx) = @_; my $mjd = cal2mjd($day, $month, $year, $ut); return undef if (!defined $mjd); return mjd2lst($mjd, $longitude, $dUT1, $eqenx); } =item B $lst = dayno2lst($dayno, $year, $ut, $longitude); $lmst = dayno2lst($dayno, $year, $ut, $longitude, $dUT1); $ltst = dayno2lst($dayno, $year, $ut, $longitude, $dUT1, $eqenx); Wrapper to mjd2lst using calendar date rather than mjd =cut sub dayno2lst($$$$;$$) { my ($dayno, $year, $ut, $longitude, $dUT1, $eqenx) = @_; my $mjd = dayno2mjd($dayno, $year, $ut); return undef if (!defined $mjd); return mjd2lst($mjd, $longitude, $dUT1, $eqenx); } # Not verified =item B ($lst_rise, $lst_set) = rise($ra, $dec, $obslat, $el_limit); Return the lst rise and set time of the given source $lst_rise, $lst_set Rise and set time (turns) $ra, $dec RA and Dec of source (turns) $obslat Latitude of observatory (turns) $el_limit Elevation limit of observatory (turns, 0 horizontal) Returns 'Circumpolar' if source circumpolar Returns undef if source never rises Uses the formula: cos $z_limit = sin $obslat * sin $dec + cos $obslat * cos $dec * cos $HA where: $z_limit is the zenith angle limit corresponding to $el_limit $HA is the Hour Angle of the source NOTE: For maximum accuracy source coordinated should be precessed to the current date. =cut sub rise ($$$$) { #print "rise: Got @_\n"; my ($ra, $dec, $obslat, $el_limit) = @_; $ra = turn2rad($ra); $dec = turn2rad($dec); $obslat = turn2rad($obslat); $el_limit = turn2rad($el_limit); my $z_limit = $PI/2-$el_limit; #print "Check it\n"; # Check whether the source ever rises or is circumpolar my $z = acos(sin($obslat)*sin($dec) + cos($obslat)*cos($dec)); # Highest point return (undef) if ($z>$z_limit); #print "Got here\n"; $z = acos(sin($obslat)*sin($dec) - cos($obslat)*cos($dec)); # Lowest point return ('Circumpolar') if ($z<$z_limit); my $cos_ha = (cos($z_limit) - sin($obslat)*sin($dec)) /(cos($obslat)*cos($dec)); my $ha = acos($cos_ha); my $lst_rise = $ra - $ha; my $lst_set = $ra + $ha; $lst_rise += 2*$PI if ($lst_rise < 0.0); $lst_set -= 2*$PI if ($lst_set >= 2*$PI); return rad2turn($lst_rise), rad2turn($lst_set); } =item B $mjd = lst2mjd($lmst, $dayno, $year, $longitude); $mjd = lst2mjd($lmst, $dayno, $year, $longitude, $dUT1); This routine calculates the modified Julian day number corresponding to the local mean sidereal time $lmst at $longitude, on a given UT day number ($dayno). Unless high precision is required dUT1 can be omitted. The required inputs are : $lmst - The local mean sidereal time (turns) $dayno - The UT day of year for which to do the conversion $year - The year for which to do the conversion $longitude - The longitude of the observatory (turns) $dUT1 - Difference between UTC and UT1 (UT1 = UTC + dUT1) (seconds) $mjd The modified Julian day corresponding to $lmst on $dayno =cut sub lst2mjd($$$$;$) { my ($lmst, $dayno, $year, $longitude, $dUT1) = @_; $dUT1 = 0.0 if (!defined $dUT1); my $SOLAR_TO_SIDEREAL = 1.002737909350795; my $mjd = dayno2mjd($dayno, $year, $dUT1); # Time in turns from passed lmst to lmst at the start of $dayno my $delay = $lmst-mjd2lst($mjd, $longitude); if ($delay < 0.0) { $delay += 1.0; } return($mjd + $delay/$SOLAR_TO_SIDEREAL); } =item B $monthstr = month2str($month); $longmonthstr = month2str($month,1); This routine returns the name of the given month (as a number 1..12), where 1 is January. The default is a 3 character version of the month ('Jan', 'Feb', etc) in the second form the full month is returned The required inputs are : $month - The month in question with 1 == January. =cut sub month2str($;$) { my ($mon, $long) = @_; return undef if (!monthOK($mon)); if ($long) { return $MonthStr[$mon-1]; } else { return $MonthShortStr[$mon-1]; } } =item B $weekday = mjd2weekday($mjd); Returns the weekday correspondig to the given MJD. 0 ==> Monday. May not work for historical dates. $mjd Modified Julian day (JD-2400000.5) =cut sub mjd2weekday ($) { my $mjd = int floor ((shift)+0.00001); # MJD as an int... return ($mjd-5) % 7; } =item B $weekdaystr = mjd2weekdaystr($mjd); Returns the name of the weekday correspondig to the given MJD. May not work for historical dates. $mjd Modified Julian day (JD-2400000.5) =cut sub mjd2weekdaystr($;$) { my ($mjd, $long) = @_; my $dow = mjd2weekday($mjd); if ($long) { return $WeekStr[$dow]; } else { return $WeekShortStr[$dow]; } } =item B $month = month2str($monthstr); Given the name of a month (in English), this routine returns the an integer between 1 and 12, where 1 is January. Full month names of 3 character abbreviations are acceptable. Minumum matching (e.g. "Marc") is not supported. The required inputs are : $month - Name of the month ('Jan', 'January', 'Feb', 'February' etc) =cut sub str2month($) { my $month = uc(shift); for (my $i=0; $i<12; $i++) { if ($month eq uc($MonthStr[$i]) || $month eq uc($MonthShortStr[$i])) { return $i+1; } } return undef; } 1; __END__