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; |