File Coverage

blib/lib/Astro/Coord/Precession.pm
Criterion Covered Total %
statement 68 68 100.0
branch 13 14 92.8
condition 6 6 100.0
subroutine 9 9 100.0
pod 3 3 100.0
total 99 100 99.0


line stmt bran cond sub pod time code
1             package Astro::Coord::Precession;
2              
3 2     2   330028 use 5.006;
  2         13  
4 2     2   12 use strict;
  2         4  
  2         39  
5 2     2   10 use warnings;
  2         4  
  2         44  
6 2     2   657 use utf8;
  2         18  
  2         21  
7              
8 2     2   1139 use Math::Trig;
  2         29390  
  2         338  
9              
10             =encoding UTF-8
11              
12             =head1 NAME
13              
14             Astro::Coord::Precession - Precess coordinates between 2 epochs
15              
16             =head1 VERSION
17              
18             Version 0.02
19              
20             =cut
21              
22             our $VERSION = '0.02';
23              
24 2     2   17 use Exporter qw(import);
  2         4  
  2         1747  
25              
26             our @EXPORT_OK = qw(
27             precess_rad
28             precess
29             read_coordinates
30             );
31              
32             our %EXPORT_TAGS;
33             $EXPORT_TAGS{all} = [@EXPORT_OK];
34              
35             =head1 SYNOPSIS
36              
37             use Astro::Coord::Precession qw/precess precess_rad read_coordinates/;
38              
39             # If you have coordinates in float RA hours and Dec degrees:
40             my $precessed = precess([$RA, $dec], $epoch_from, $epoch_to);
41            
42             # If you have coordinates in rad:
43             my $precessed_rad = precess([$RA_rad, $dec_rad], $epoch_from, $epoch_to);
44              
45             # If you have coordinates in strings with RA h,m,s and Dec deg etc:
46             my $coord = read_coordinates(['01 33 50.904', '+30 39 35.79']);
47             my $precessed = precess($coord, 2000, 2021.15);
48              
49             =head1 DESCRIPTION
50              
51             A very simple, pure Perl module to precess equatorial coordinates from one epoch
52             to another, based on the algorithm P. Herget used in the Publications of the
53             Cincinnati Observatory.
54              
55             =head1 METHODS
56              
57             =head2 precess
58              
59             my $precessed = precess($coord, $epoch_from, $epoch_to);
60              
61             Returns an arrayref C<[$RA, $dec]> with equatorial coordinates (0 <= RA < 24 in
62             hours, -90 <= Dec <= 90 in degrees), precessed from C<$epoch_from> (e.g. 2000)
63             to C<$epoch_to>.
64              
65             C<$coord> input is similarly arrayref with RA in hours, Dec in degrees.
66              
67             =cut
68              
69             sub precess {
70 3     3 1 21 my ($coord, $epoch1, $epoch2) = @_;
71              
72 3         8 $coord->[0] *= pi() / 12;
73 3         23 $coord->[1] *= pi() / 180;
74              
75 3         10 $coord = precess_rad($coord, $epoch1, $epoch2);
76              
77 3         7 $coord->[0] *= 12 / pi();
78 3         4 $coord->[1] *= 180 / pi();
79              
80 3         9 return $coord;
81             }
82              
83             =head2 precess_rad
84              
85             my $precessed_rad = precess($coord, $epoch_from, $epoch_to);
86              
87             Returns an arrayref C<[$RA, $dec]> with equatorial coordinates in rad, precessed
88             from C<$epoch_from> (e.g. 2000) to C<$epoch_to>.
89              
90             The L function converts from/to rad anyway, so use this if you can work
91             with rad directly.
92              
93             =cut
94              
95             sub precess_rad {
96 6     6 1 70 my ($coord, $epoch1, $epoch2) = @_;
97              
98 6         13 my $ra1 = $coord->[0];
99 6         9 my $dec1 = $coord->[1];
100 6         11 my $csr = 0.17453292519943e-01 / 3600;
101 6         12 my $t = 0.001 * ( $epoch2 - $epoch1 );
102 6         10 my $st = 0.001 * ( $epoch1 - 1900 );
103 6         16 my $a =
104             $csr * $t *
105             (23042.53 + $st * (139.75 + 0.06 * $st) +
106             $t * (30.23 - 0.27 * $st + 18 * $t));
107 6         14 my $b = $csr * $t * $t * (79.27 + 0.66 * $st + 0.32 * $t) + $a;
108 6         14 my $c =
109             $csr * $t *
110             (20046.85 - $st * (85.33 + 0.37 * $st) +
111             $t * (-42.67 - 0.37 * $st - 41.8 * $t));
112 6         14 my $sina = sin($a);
113 6         7 my $sinb = sin($b);
114 6         10 my $sinc = sin($c);
115 6         28 my $cosa = cos($a);
116 6         11 my $cosb = cos($b);
117 6         9 my $cosc = cos($c);
118 6         18 my @r = ([0, 0, 0], [0, 0, 0], [0, 0, 0]);
119 6         13 $r[0][0] = $cosa * $cosb * $cosc - $sina * $sinb;
120 6         11 $r[0][1] = -$cosa * $sinb - $sina * $cosb * $cosc;
121 6         11 $r[0][2] = -$cosb * $sinc;
122 6         14 $r[1][0] = $sina * $cosb + $cosa * $sinb * $cosc;
123 6         11 $r[1][1] = $cosa * $cosb - $sina * $sinb * $cosc;
124 6         11 $r[1][2] = -$sinb * $sinc;
125 6         11 $r[2][0] = $cosa * $sinc;
126 6         9 $r[2][1] = -$sina * $sinc;
127 6         10 $r[2][2] = $cosc;
128              
129 6         9 $a = cos($dec1);
130 6         27 my @x1 = ($a * cos($ra1), $a * sin($ra1), sin($dec1));
131 6         9 my @x2 = (0, 0, 0);
132             $x2[$_] = $r[$_][0] * $x1[0] + $r[$_][1] * $x1[1] + $r[$_][2] * $x1[2]
133 6         33 for (0 .. 2);
134              
135 6         21 my $ra2 = atan2($x2[1], $x2[0]);
136 6 50       15 $ra2 += 2 * pi() if ($ra2 < 0);
137 6         19 my $dec2 = asin($x2[2]);
138 6         60 return [$ra2, $dec2];
139             }
140              
141             =head1 UTILITY FUNCTIONS
142              
143             =head2 read_coordinates
144              
145             my $coord = read_coordinates([$ra_string, $dec_string]);
146              
147             Returns coordinates in an arrayref of RA, dec in decimal values to use with L.
148             It accepts commonly used strings for RA, dec in hours and degrees respectivelly:
149              
150             =over 4
151            
152             =item * C<$ra_string>
153              
154             It will read a string with hours, minutes, secs like C<'2 30 00'> or C<'2h30m30s'>
155             or C<'02:30:30'> etc. Single/double quotes and single/double prime symbols are
156             accepted for denoting minute, second in place of a single space/tab which also works.
157             Will accept negative too with preceding -, even though this is unusual and also
158             no seconds part.
159              
160             =item * C<$dec_string>
161              
162             It will read a string with degrees, minutes, secs like C<'+54 30 00'> or C<'54°30m30s'>
163             etc. Single/double quotes and single/double prime symbols are accepted for denoting
164             minute, second in place of a single space/tab which also works. Will also accept
165             no arc seconds part.
166              
167             =back
168              
169             =cut
170              
171             sub read_coordinates {
172 19     19 1 16713 my ($ra, $dec) = @{$_[0]};
  19         48  
173 19 100 100     152 if (defined $ra && $ra =~ /([-]?)\s?([0-9.]+)[\sh:]+([0-9.]+)[\sm′':]+([0-9.]+)?/) {
174 17         77 $ra = $2+$3/60;
175 17 100       56 $ra += $4/3600 if $4;
176 17 100       45 $ra *= -1 if length($1);
177             }
178 19 100 100     92 if (defined $dec && $dec =~ /([-]?)\s?([0-9.]+)[\sd°]+([0-9.]+)[\sm′']+([0-9.]+)?/) {
179 17         50 $dec = $2+$3/60;
180 17 100       46 $dec += $4/3600 if $4;
181 17 100       38 $dec *= -1 if length($1)
182             }
183 19         69 return [$ra, $dec];
184             }
185              
186             =head1 AUTHOR
187              
188             Dimitrios Kechagias, C<< >>
189              
190             =head1 BUGS
191              
192             Please report any bugs or feature requests to C, or through
193             the web interface at L.
194             You could also raise issues or submit PRs to the github repo below.
195              
196             =head1 GIT
197              
198             L
199              
200              
201             =head1 ACKNOWLEDGEMENTS
202              
203             Based on the precession function from the fortran program CONFND, made by FO @ CDS
204             (francois@simbad.u-strasbg.fr).
205              
206             =head1 LICENSE AND COPYRIGHT
207              
208             This software is copyright (c) 2021 by Dimitrios Kechagias.
209              
210             This is free software; you can redistribute it and/or modify it under
211             the same terms as the Perl 5 programming language system itself.
212              
213             =cut
214              
215             1;