File Coverage

blib/lib/Astro/Coord/ECI.pm
Criterion Covered Total %
statement 775 914 84.7
branch 286 442 64.7
condition 70 137 51.0
subroutine 87 98 88.7
pod 43 43 100.0
total 1261 1634 77.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Astro::Coord::ECI - Manipulate geocentric coordinates
4              
5             =head1 SYNOPSIS
6              
7             use Astro::Coord::ECI;
8             use Astro::Coord::ECI::Sun;
9             use Astro::Coord::ECI::TLE;
10             use Astro::Coord::ECI::Utils qw{rad2deg};
11            
12             # 1600 Pennsylvania Avenue, in radians, radians, and KM
13             my ($lat, $lon, $elev) = (0.678911227503559,
14             -1.34456123391096, 0.01668);
15            
16             # Record the time
17             my $time = time ();
18            
19             # Set up observer's location
20             my $loc = Astro::Coord::ECI->geodetic ($lat, $lon, $elev);
21            
22             # Uncomment to turn off atmospheric refraction if desired.
23             # $loc->set( refraction => 0 );
24            
25             # Instantiate the Sun.
26             my $sun = Astro::Coord::ECI::Sun->universal ($time);
27            
28             # Figure out if the Sun is up at the observer's location.
29             my ($azimuth, $elevation, $range) = $loc->azel ($sun);
30             print "The Sun is ", rad2deg ($elevation),
31             " degrees above the horizon.\n";
32              
33             See the L documentation
34             for an example involving satellite pass prediction.
35              
36             =head1 DESCRIPTION
37              
38             This module was written to provide a base class for a system to predict
39             satellite visibility. Its main task is to convert the
40             Earth-Centered Inertial (ECI) coordinates generated by the NORAD models
41             into other coordinate systems (e.g. latitude, longitude, and altitude
42             above mean sea level), but a other functions have accreted to it.
43             In addition, a few support routines have been exposed for testing, or
44             whatever.
45              
46             All distances are in kilometers, and all angles are in radians
47             (including right ascension, which is usually measured in hours).
48              
49             Times are normal Perl times, whether used as universal or dynamical
50             time. Universal time is what is usually meant, unless otherwise stated.
51              
52             Known subclasses include B to predict the
53             position of the Moon, B to predict the
54             position of a star, or anything else that can be considered fixed on
55             the celestial sphere, B to predict the position
56             of the Sun, B to predict the position of a
57             satellite given the NORAD orbital parameters, and
58             B (a subclass of
59             Astro::Coord::ECI::TLE, and as of 0.099_01 moved to its own package) to
60             predict Iridium flares.
61              
62             B that in version 0.022_01 the velocity code got a substantial
63             rework, which is still in progress. I am attempting give useful
64             velocities where they are available, and no velocities at all where they
65             are not. Unfortunately I have yet to locate any worked problems, so the
66             velocity code is, in the most literal sense, untested.
67              
68             In general, locations specified in Earth-fixed coordinates are
69             considered to share the rotational velocity of the Earth, and locations
70             specified in inertial coordinates are considered to have undefined
71             velocities unless a velocity was specified explicitly or produced by the
72             object's model. This involved a change in the behavior of the eci()
73             method when velocity was not specified but location was. See the next
74             paragraph for my excuse.
75              
76             B This class and its subclasses should probably be
77             considered alpha code, meaning that the public interface may not be
78             completely stable. I will try not to change it, but given sufficient
79             reason I will do so. If I do so, I will draw attention to the change
80             in the documentation.
81              
82             =head2 Methods
83              
84             The following methods should be considered public.
85              
86             =over 4
87              
88             =cut
89              
90             package Astro::Coord::ECI;
91              
92 17     17   120739 use strict;
  17         45  
  17         755  
93 17     17   126 use warnings;
  17         48  
  17         1288  
94              
95             our $VERSION = '0.134';
96              
97 17     17   11821 use Astro::Coord::ECI::Utils qw{ @CARP_NOT :mainstream };
  17         76  
  17         8864  
98 17     17   173 use Carp;
  17         34  
  17         1135  
99 17     17   10237 use Clone ();
  17         9297  
  17         680  
100 17     17   149 use POSIX qw{ floor };
  17         31  
  17         197  
101              
102 17         1441 use constant NO_CASCADING_STATIONS =>
103 17     17   1659 q{Cascading 'station' attributes are not supported};
  17         33  
104 17     17   180 use constant TWO_DEGREES => deg2rad( 2 );
  17         73  
  17         190  
105 17     17   90 use constant CIVIL_TWILIGHT => deg2rad( -6 );
  17         28  
  17         65  
106              
107             my %mutator; # Attribute mutators. We define these just after the
108             # set() method, for convenience.
109             my %known_ellipsoid; # Known reference ellipsoids. We define these
110             # just before the reference_ellipsoid() method for
111             # convenience.
112             my %static = ( # The geoid, etc. Geoid gets set later.
113             # almanac_horizon => set when instantiated, so that the following
114             # _almanac_horizon => gets set automatically by the mutator.
115             angularvelocity => 7.292114992e-5, # Of surface of Earth, 1998. Meeus, p.83
116             debug => 0,
117             diameter => 0,
118             edge_of_earths_shadow => 1,
119             horizon => deg2rad (20),
120             refraction => 1,
121             twilight => CIVIL_TWILIGHT,
122             );
123             my %savatr; # Attribs saved across "normal" operations. Set at end.
124             my @kilatr = # Attributes to purge when setting coordinates.
125             qw{_need_purge _ECI_cache inertial local_mean_time specified}; #?
126              
127             =item $coord = Astro::Coord::ECI->new ();
128              
129             This method instantiates a coordinate object. Any arguments are passed
130             to the set() method once the object has been instantiated.
131              
132             =cut
133              
134             sub new {
135 182     182 1 675539 my ( $class, @args ) = @_;
136 182   33     2230 my $self = bless { %static }, ref $class || $class;
137 182         805 $self->{inertial} = $self->__initial_inertial();
138             ref $static{sun}
139 182 50       491 and $self->set( sun => $static{sun}->clone() );
140 182 100       906 @args and $self->set( @args );
141             exists $self->{almanac_horizon}
142 182 50       711 or $self->set( almanac_horizon => 0 );
143 182 50       502 $self->{debug} and do {
144 0         0 require Data::Dumper;
145 0         0 local $Data::Dumper::Terse = 1;
146 0         0 print "Debug - Instantiated ", Data::Dumper::Dumper ($self);
147             };
148 182         918 return $self;
149             }
150              
151             =item $angle = $coord->angle ($coord2, $coord3);
152              
153             This method calculates the angle between the $coord2 and $coord3
154             objects, as seen from $coord. The calculation uses the law of
155             haversines, and does not take atmospheric refraction into account. The
156             return is a number of radians between 0 and pi.
157              
158             The algorithm comes from "Ask Dr. Math" on the Math Forum,
159             C, which
160             attributes it to the Geographic Information Systems FAQ,
161             L, which in turn
162             attributes it to R. W. Sinnott, "Virtues of the Haversine," Sky and
163             Telescope, volume 68, number 2, 1984, page 159.
164              
165             Unfortunately, as of early 2021 the National Council of Teachers of
166             Mathematics restricted the Dr. Math content to their members, but an
167             annotated and expanded version of the article on haversines is available
168             at
169             L.
170             If you want the original article, you can feed the URL
171             C to the Wayback
172             Machine.
173              
174             Prior to version 0.011_03 the law of cosines was used, but this produced
175             errors on extremely small angles. The haversine law was selected based
176             on Jean Meeus, "Astronomical Algorithms", 2nd edition, chapter 17
177             "Angular Separation".
178              
179             This method ignores the C attribute.
180              
181             =cut
182              
183             sub angle {
184 1205     1205 1 2835 my $self = shift;
185 1205         2142 my $B = shift;
186 1205         1768 my $C = shift;
187 1205 50 33     4787 (ref $B && $B->represents (__PACKAGE__)
      33        
      33        
188             && ref $C && $C->represents (__PACKAGE__))
189             or croak <
190 0         0 Error - Both arguments must represent @{[__PACKAGE__]} objects.
191             eod
192             my ($ra1, $dec1) = $self->{inertial} ?
193 1205 100       5166 $B->equatorial ($self) : $self->_angle_non_inertial ($B);
194             my ($ra2, $dec2) = $self->{inertial} ?
195 1205 100       4449 $C->equatorial ($self) : $self->_angle_non_inertial ($C);
196 1205         2723 my $sindec = sin (($dec2 - $dec1)/2);
197 1205         2269 my $sinra = sin (($ra2 - $ra1)/2);
198 1205         2939 my $a = $sindec * $sindec +
199             cos ($dec1) * cos ($dec2) * $sinra * $sinra;
200 1205         8203 return 2 * atan2 (sqrt ($a), sqrt (1 - $a));
201              
202             }
203              
204             sub _angle_non_inertial {
205 2408     2408   3871 my $self = shift;
206 2408         3512 my $other = shift;
207 2408         5762 my ($x1, $y1, $z1) = $self->ecef ();
208 2408         6018 my ($x2, $y2, $z2) = $other->ecef ();
209 2408         4855 my $X = $x2 - $x1;
210 2408         3750 my $Y = $y2 - $y1;
211 2408         3804 my $Z = $z2 - $z1;
212 2408         5297 my $lon = atan2 ($Y, $X);
213 2408         8560 my $lat = mod2pi (atan2 ($Z, sqrt ($X * $X + $Y * $Y)));
214 2408         18635 return ($lon, $lat);
215             }
216              
217             =item $angle = $coord->angular_radius();
218              
219             This method computes the angular radius of the C<$coord> body in
220             radians, as of the currently-set time. If the C attribute is
221             set, the range will be computed from it via C<< $self->azel() >>. If
222             not, the range from the center of the earth will be computed via
223             C<< $self->ecliptic() >>. If the C attribute is not set,
224             C is returned.
225              
226             This method is not supported for terrestrial objects.
227              
228             =cut
229              
230             sub angular_radius {
231 1     1 1 17 my ( $self ) = @_;
232 1 50       6 defined( my $diameter = $self->get( 'diameter' ) )
233             or return undef; ## no critic (ProhibitExplicitReturnUndef)
234 1         2 my $range;
235 1 50       3 if ( $self->get( 'station' ) ) {
236 0         0 ( undef, undef, $range ) = $self->azel();
237             } else {
238 1         3 ( undef, undef, $range ) = $self->ecliptic();
239             }
240 1         7 return atan2 $diameter / 2, $range;
241             }
242              
243              
244             =item $which = $coord->attribute ($name);
245              
246             This method returns the name of the class that implements the named
247             attribute, or undef if the attribute name is not valid.
248              
249             =cut
250              
251 0 0   0 1 0 sub attribute {return exists $mutator{$_[1]} ? __PACKAGE__ : undef}
252              
253             =item ($azimuth, $elevation, $range) = $coord->azel( $coord2 );
254              
255             This method takes another coordinate object, and computes its azimuth,
256             elevation, and range in reference to the object doing the computing.
257             The return is azimuth in radians measured clockwise from North (always
258             positive), elevation above the horizon in radians (negative if
259             below), and range in kilometers.
260              
261             As a side effect, the time of the $coord object may be set from the
262             $coord2 object.
263              
264             Atmospheric refraction is taken into account using the
265             C method if the C<$coord> object's
266             C attribute is true. The invocant's
267             C method is the one used; that is, if
268             C<$coord> and C<$coord2> have different C
269             methods, the C<$coord> object's method is used.
270              
271             B that the C attribute defaults to true.
272             For cases where both invocant and argument are ground-based objects, you
273             should probably set the invocant's C false
274             before invoking this method.
275              
276             This method is implemented in terms of azel_offset(). See that method's
277             documentation for further details.
278              
279             =item ( $azimuth, $elevation, $range ) = $coord->azel();
280              
281             This method computes the azimuth, elevation, and range if the C<$coord>
282             object as seen from the position stored in the C<$coord> object's
283             C attribute. An exception will be thrown if the C
284             attribute is not set.
285              
286             =cut
287              
288             sub azel { ## no critic (RequireArgUnpacking)
289 16905 50   16905 1 40380 @_ > 2
290             and croak q{Too many arguments};
291 16905         43479 @_ = _expand_args_default_station( @_ );
292 16905 50       39088 $_[2] = $_[2] ? 1 : 0;
293 16905         63414 goto &azel_offset;
294             }
295              
296             =item ($azimuth, $elevation, $range) = $coord->azel_offset($coord2, $offset);
297              
298             This method takes another coordinate object, and computes its azimuth,
299             elevation, and range in reference to the object doing the computing.
300             The return is azimuth in radians measured clockwise from North (always
301             positive), elevation above the horizon in radians (negative if
302             below), and range in kilometers.
303              
304             If the optional C<$offset> argument is provided, the elevation is offset
305             upward by the given fraction of the radius of the C<$coord2> object.
306             Thus, an C<$offset> of C<1> specifies the upper limb of the object, C<0>
307             specifies the center of the object, and C<-1> specifies the lower limb.
308             This offset is applied before atmospheric refraction.
309              
310             As a side effect, the time of the $coord object may be set from the
311             $coord2 object.
312              
313             By default, atmospheric refraction is taken into account in the
314             calculation of elevation, using the C method.
315             This better represents the observed position in the sky when the object
316             is above the horizon, but produces a gap in the data when the object
317             passes below the horizon, since I have no refraction equations for rock.
318             See the C documentation for details.
319              
320             The invocant's C method is the one used; that
321             is, if C<$coord> and C<$coord2> have different
322             C methods, the C<$coord> object's method is
323             used.
324              
325             If you want to ignore atmospheric refraction (and not have a gap in your
326             data), set the C attribute of the $coord object
327             to any value Perl considers false (e.g. 0).
328              
329             The algorithm for position is the author's, but he confesses to having
330             to refer to T. S. Kelso's "Computers and Satellites"
331             column in "Satellite Times", November/December 1995, titled "Orbital
332             Coordinate Systems, Part II" and available at
333             F to get the signs right.
334              
335             If velocities are available for both bodies involved in the calculation,
336             they will be returned after the position (i.e. you get a six-element
337             array back instead of a three-element array). The velocity of a point
338             specified in Earth-fixed coordinates (e.g. geodetic latitude, longitude,
339             and altitude) is assumed to be the rotational velocity of the Earth at
340             that point. The returned velocities are azimuthal velocity in radians
341             per second (B radians of azimuth, which get smaller as you go
342             farther away from the Equator), elevational velocity in radians per
343             second, and velocity in recession in kilometers per second, in that
344             order.
345              
346             If velocities are available for both bodies B the C<$coord2> object
347             has its C attribute set, the returned array will contain
348             seven elements, with the seventh being the Doppler shift.
349              
350             The algorithm for recessional velocity comes from John A. Magliacane's
351             C program, available at
352             L. The transverse velocity
353             computations are the author's, but use the same basic approach: vector
354             dot product of the velocity vector with a unit vector in the appropriate
355             direction, the latter generated by the appropriate (I hope!) vector
356             cross products.
357              
358             Velocity conversions to C appear to me to be mostly sane. See
359             L, below, for details.
360              
361             If velocities are available I you have provided a non-zero value
362             for the C attribute, you will get the Doppler shift as the
363             seventh element of the returned array. The I about velocity in
364             recession apply to the Doppler shift as well. The frequency is from the
365             C<$coord2> object. Getting the frequency from the C<$coord> object used
366             to be supported as a fallback, but now results in an exception.
367              
368             =item ( $azimuth, $elevation, $range ) = $coord->azel_offset( $offset );
369              
370             This method computes the azimuth, elevation, and range if the C<$coord>
371             object as seen from the location stored in the C<$coord> object's
372             C attribute. The functionality is as above, except for the fact
373             that in the above version the station is the invocant, whereas in this
374             version the orbiting body is the invocant.
375              
376             This version also returns velocities if they are available for both
377             bodies, and Doppler shift if in addition the C attribute of
378             the invocant is set.
379              
380             =cut
381              
382             sub azel_offset {
383 47021     47021 1 119173 my ( $self, $trn2, $offset ) = _expand_args_default_station( @_ );
384 47021 50       137357 $self->{debug} and do {
385 0         0 require Data::Dumper;
386 0         0 local $Data::Dumper::Terse = 1;
387 0         0 print "Debug azel_offset - ", Data::Dumper::Dumper ($self, $trn2, $offset);
388             };
389              
390             # _local_cartesian() returns NEU coordinates. Converting these to
391             # spherical gets Azimuth (clockwise from North), Elevation, and
392             # Range.
393              
394 47021         140605 my ( $azimuth, $elevation, $range, @velocity ) =
395             _convert_cartesian_to_spherical(
396             $self->_local_cartesian( $trn2 )
397             );
398              
399             # If the velocity and frequency are defined, we provide the Doppler
400             # shift as well.
401              
402 47021 100       124260 if ( defined $velocity[2] ) {
403 16896         69650 my $freq = $trn2->get( 'frequency' );
404 16896 100       43056 if ( not defined $freq ) {
405 16895         40897 $freq = $self->get( 'frequency' );
406 16895 50       41838 defined $freq
407             and croak 'Calculation of Doppler shift based ',
408             'on the frequency attribute of the observing ',
409             'station is not allowed';
410             }
411 16896 100       37531 if ( defined $freq ) {
412 1         3 $velocity[3] = - $freq * $velocity[2] / SPEED_OF_LIGHT;
413             }
414             }
415              
416             # Adjust for upper limb and refraction if needed.
417              
418             $offset
419 47021 100       155273 and $elevation += atan2(
420             $trn2->get( 'diameter' ) * $offset / 2,
421             $range,
422             );
423              
424             $self->{refraction} and
425 47021 50       199504 $elevation = $self->correct_for_refraction( $elevation );
426              
427 47021         191796 return ( $azimuth, $elevation, $range, @velocity );
428             }
429              
430             =item $coord2 = $coord->clone ();
431              
432             This method does a deep clone of an object, producing a different
433             but identical object.
434              
435             At the moment, it's really just a wrapper for Clone::clone.
436              
437             =cut
438              
439             sub clone {
440 3     3 1 21 my ( $self ) = @_;
441 3         93 return Clone::clone( $self );
442             }
443              
444             =item $elevation = $coord->correct_for_refraction ($elevation);
445              
446             This method corrects the given angular elevation for atmospheric
447             refraction. This is done only if the elevation has a reasonable chance
448             of being visible; that is, if the elevation before correction is not
449             more than two degrees below either the 'horizon' attribute or zero,
450             whichever is lesser. Sorry for the discontinuity thus introduced, but I
451             did not wish to carry the refraction calculation too low because I am
452             uncertain about the behavior of the algorithm, and I do not have a
453             corresponding algorithm for refraction through magma.
454              
455             This method can also be called as a class method, in which case the
456             correction is applied only if the uncorrected elevation is greater than
457             minus two degrees. It is really only exposed for testing purposes (hence
458             the cumbersome name). The azel() method calls it for you if the
459             C attribute is true.
460              
461             The algorithm for atmospheric refraction comes from Thorfinn
462             Saemundsson's article in "Sky and Telescope", volume 72, page 70
463             (July 1986) as reported Jean Meeus' "Astronomical Algorithms",
464             2nd Edition, chapter 16, page 106, and includes the adjustment
465             suggested by Meeus.
466              
467             =cut
468              
469             sub correct_for_refraction {
470 46105     46105 1 77983 my $self = shift;
471 46105         68124 my $elevation = shift;
472              
473             # If called as a static method, our effective horizon is zero. If
474             # called as a normal method, our effective horizon is the lesser of
475             # the 'horizon' setting or zero.
476              
477 46105 100       128887 my $horizon = ref $self ? min( 0, $self->get( 'horizon' ) ) : 0;
478              
479             # We exclude anything with an elevation <= 2 degrees below our
480             # effective horizon; this is presumed to be not visible, since the
481             # maximum deflection is about 35 minutes of arc. This is not
482             # portable to (e.g.) Venus.
483              
484 46105 100       130602 if ( $elevation > $horizon - TWO_DEGREES ) {
485              
486             # Thorsteinn Saemundsson's algorithm for refraction, as reported
487             # in Meeus, page 106, equation 16.4, and adjusted per the
488             # suggestion in Meeus' following paragraph. Thorsteinn's
489             # formula is in terms of angles in degrees and produces
490             # a correction in minutes of arc. Meeus reports the original
491             # publication as Sky and Telescope, volume 72 page 70, July 1986.
492              
493             # In deference to Thorsteinn I will point out:
494             # * The Icelanders do not use family names. The "Saemundsson"
495             # simply means his father's name was Saemund.
496             # * I have transcribed the names into 7-bit characters.
497             # "Thorsteinn" actually does not begin with "Th" but with
498             # the letter "Thorn." Similarly, the "ae" in "Saemund" is
499             # supposed to be a ligature (i.e. squished into one letter).
500              
501 26610         74932 my $deg = rad2deg ($elevation);
502 26610         87963 my $correction = 1.02 / tan (deg2rad ($deg + 10.3/($deg + 5.11))) +
503             .0019279;
504 26610 50       61003 $self->get ('debug') and print <
505             Debug correct_for_refraction
506             input: $deg degrees of arc
507             correction: $correction minutes of arc
508             eod
509              
510             # End of Thorsteinn's algorithm.
511              
512 26610         67434 $correction = deg2rad ($correction / 60);
513 26610         47804 $elevation += $correction;
514             }
515 46105         86952 return $elevation;
516             }
517              
518             =item $angle = $coord->dip ();
519              
520             This method calculates the dip angle of the horizon due to the
521             altitude of the body, in radians. It will be negative for a location
522             above the surface of the reference ellipsoid, and positive for a
523             location below the surface.
524              
525             The algorithm is simple enough to be the author's.
526              
527             =cut
528              
529             sub dip {
530 917     917 1 1701 my $self = shift;
531 917         2766 my (undef, undef, $h) = $self->geodetic ();
532 917         2646 my (undef, undef, $rho) = $self->geocentric ();
533 917 50       4279 return $h >= 0 ?
534             - acos (($rho - $h) / $rho) :
535             acos ($rho / ($rho - $h));
536             }
537              
538             =item $coord = $coord->dynamical ($time);
539              
540             This method sets the dynamical time represented by the object.
541              
542             This method can also be called as a class method, in which case it
543             instantiates the desired object.
544              
545             The algorithm for converting this to universal time comes from Jean
546             Meeus' "Astronomical Algorithms", 2nd Edition, Chapter 10, pages 78ff.
547              
548             =item $time = $coord->dynamical ();
549              
550             This method returns the dynamical time previously set, or the
551             universal time previously set, converted to dynamical.
552              
553             The algorithm comes from Jean Meeus' "Astronomical Algorithms", 2nd
554             Edition, Chapter 10, pages 78ff.
555              
556             =cut
557              
558             sub dynamical {
559 234737     234737 1 944128 my ($self, @args) = @_;
560 234737 100       518138 unless (@args) {
561 234606 50       470073 ref $self or croak <
562             Error - The dynamical() method may not be called as a class method
563             unless you specify arguments.
564             eod
565             return ($self->{dynamical} ||= $self->{universal} +
566 234606   33     907018 dynamical_delta ($self->{universal} || croak <
      66        
567             Error - Universal time of object has not been set.
568             eod
569             }
570              
571 131 50       285 if (@args == 1) {
572 131         219 my $time = shift @args;
573 131 100       311 $self = $self->new () unless ref $self;
574 131         332 $self->{_no_set}++; # Supress running the model if any
575 131         330 $self->universal ($time - dynamical_delta ($time));
576 131         305 $self->{dynamical} = $time;
577 131         184 --$self->{_no_set}; # Undo supression of model
578 131         269 $self->_call_time_set (); # Run the model if any
579             } else {
580 0         0 croak <
581             Error - The dynamical() method must be called with either zero
582             arguments (to retrieve the time) or one argument (to set the
583             time).
584             eod
585             }
586              
587 131         465 return $self;
588             }
589              
590             =item $coord = $coord->ecef($x, $y, $z, $xdot, $ydot, $zdot)
591              
592             This method sets the coordinates represented by the object in terms of
593             L in kilometers, with
594             the x axis being latitude 0 longitude 0, the y axis being latitude 0
595             longitude 90 degrees east, and the z axis being latitude 90 degrees
596             north. The velocities in kilometers per second are optional, and will
597             default to zero. ECEF velocities are considered to be relative to the
598             surface of the Earth; when converting to ECI, the rotational velocity of
599             the Earth will be added in.
600              
601             B that prior to version 0.022_01, the documentation said that the
602             default velocity was the rotational velocity of the Earth. This was not
603             correct B The functionality of the code itself in
604             this respect did not change.
605              
606             The object itself is returned.
607              
608             This method can also be called as a class method, in which case it
609             instantiates the desired object.
610              
611             =item ($x, $y, $z, $xdot, $ydot, $zdot) = $coord->ecef();
612              
613             This method returns the object's L
614             coordinates>.
615              
616             If the original coordinate setting was in an inertial system (e.g. eci,
617             equatorial, or ecliptic) B the absolute difference between the
618             current value of 'equinox_dynamical' and the current dynamical() setting
619             is greater than the value of $Astro::Coord::ECI::EQUINOX_TOLERANCE, the
620             coordinates will be precessed to the current dynamical time before
621             conversion. Yes, this should be done any time the equinox is not the
622             current time, but for satellite prediction precession by a year or
623             so does not seem to make much difference in practice. The default value
624             of $Astro::Coord:ECI::EQUINOX_TOLERANCE is 365 days. B that if
625             this behavior or the default value of $EQUINOX_TOLERANCE begins to look
626             like a bug, it will be changed, and noted in the documentation.
627              
628             Some velocity conversions involving C appear to me to be mostly
629             sane. See L, below, for
630             details.
631              
632             =cut
633              
634             sub ecef {
635 143990     143990 1 268667 my ($self, @args) = @_;
636              
637 143990         322994 $self = $self->_check_coord (ecef => \@args);
638              
639 143990 100       323487 unless (@args) {
640 141872   50     338688 my $cache = ($self->{_ECI_cache} ||= {});
641 141872 100       355218 return @{$cache->{fixed}{ecef}} if $cache->{fixed}{ecef};
  53640         163877  
642 88232 50       287523 return $self->_convert_eci_to_ecef () if $self->{inertial};
643 0         0 croak <
644             Error - Object has not been initialized.
645             eod
646             }
647              
648 2118 50       7851 @args == 3 and push @args, 0, 0, 0;
649              
650 2118 50       4281 if (@args == 6) {
651 2118         4168 foreach my $key (@kilatr) {delete $self->{$key}}
  10590         29302  
652             ## $self->{_ECI_cache}{fixed}{ecef} = \@args;
653 2118         8857 $self->{_ECI_cache} = {fixed => {ecef => \@args}};
654 2118         4487 $self->{specified} = 'ecef';
655 2118         3922 $self->{inertial} = 0;
656             } else {
657 0         0 croak <
658             Error - The ecef() method must be called with either zero arguments (to
659             retrieve coordinates), three arguments (to set coordinates,
660             with velocity defaulting to zero) or six arguments.
661             eod
662             }
663              
664 2118         3851 return $self;
665             }
666              
667             =item $coord = $coord->eci ($x, $y, $z, $xdot, $ydot, $zdot, $time)
668              
669             This method sets the coordinates represented by the object in terms of
670             L in kilometers, time being
671             universal time, the x axis being 0 hours L 0 degrees
672             L, y being 6 hours L 0 degrees
673             L, and z being 90 degrees north L. The
674             velocities in kilometers per second are optional. If omitted, the object
675             will be considered not to have a velocity. B
676             with version 0.022_01.> Before that, the velocity defaulted to 0.
677              
678             The time argument is optional if the time represented by the object
679             has already been set (e.g. by the universal() or dynamical() methods).
680              
681             The object itself is returned.
682              
683             This method can also be called as a class method, in which case it
684             instantiates the desired object. In this case the time is not optional.
685              
686             The algorithm for converting from ECI to geocentric coordinates and
687             back is based on the description of ECI coordinates in T. S. Kelso's
688             "Computers and Satellites" column in "Satellite Times",
689             September/October 1995, titled "Orbital Coordinate Systems, Part I"
690             and available at F.
691              
692             =item ($x, $y, $z, $xdot, $ydot, $zdot) = $coord->eci($time);
693              
694             This method returns the L
695             of the object at the given time. The time argument is actually
696             optional if the time represented by the object has already been set.
697              
698             If you specify a time, the time represented by the object will be set
699             to that time. The net effect of specifying a time is equivalent to
700              
701             ($x, $y, $z, $xdot, $ydot, $zdot) = $coord->universal($time)->eci()
702              
703             If the original coordinate setting was in a non-inertial system (e.g.
704             ECEF or geodetic), the equinox_dynamical attribute will be set to the
705             object's dynamical time.
706              
707             Velocities will be returned if they were originally provided. B
708             a change introduced in version 0.022_01.> Prior to that version,
709             velocities were always returned.
710              
711             Some velocity conversions involving C appear to me to be mostly
712             sane. See L, below, for
713             details.
714              
715             =cut
716              
717             sub eci {
718 185202     185202 1 426436 my ($self, @args) = @_;
719              
720 185202         444475 $self = $self->_check_coord (eci => \@args);
721              
722 185202 100       428397 unless (@args) {
723 91717   50     213880 my $cache = ($self->{_ECI_cache} ||= {});
724 91717 100       236961 return @{$cache->{inertial}{eci}} if $cache->{inertial}{eci};
  91710         374842  
725 7 50       28 return $self->_convert_ecef_to_eci () if $self->{specified};
726 0         0 croak <
727             Error - Object has not been initialized.
728             eod
729              
730             }
731              
732             ## @args == 3 and push @args, 0, 0, 0;
733              
734 93485 50 66     251027 if (@args == 3 || @args == 6) {
735 93485         196865 foreach my $key (@kilatr) {delete $self->{$key}}
  467425         1095773  
736 93485         371505 $self->{_ECI_cache} = {inertial => {eci => \@args}};
737 93485         242840 $self->{specified} = 'eci';
738 93485         174497 $self->{inertial} = 1;
739             } else {
740 0         0 croak <
741             Error - The eci() method must be called with either zero or one
742             arguments (to retrieve coordinates), three or four arguments
743             (to set coordinates, with velocity defaulting to zero), or
744             six or seven arguments.
745             eod
746             }
747 93485         177839 return $self;
748             }
749              
750             =item $coord = $coord->ecliptic_cartesian( $X, $Y, $Z, $time );
751              
752             This method sets the Cartesian L coordinates represented by
753             the object in terms of C (kilometers toward the vernal equinox), C
754             (90 degrees along the ecliptic from C), and C (toward ecliptic
755             North). The time is universal time. The object itself is returned.
756              
757             The time argument is optional if the time represented by the object has
758             already been set (e.g. by the universal() or dynamical() methods).
759              
760             This method can also be called as a class method, in which case it
761             instantiates the desired object. In this case the time is not optional.
762              
763             B you can pass in velocities (before the C<$time>) but they are
764             unsupported, meaning that I can not at this point say whether they will
765             be transformed sanely, much less correctly. B.
766              
767             =item ( $X, $Y, $Z) = $coord->ecliptic_cartesian( $time );
768              
769             This method returns the Cartesian ecliptic coordinates of the object at
770             the given time. The time is optional if the time represented by the
771             object has already been set (e.g. by the universal() or dynamical()
772             methods).
773              
774             B velocities are unsupported by this method. That means you may
775             (or may not, depending on the coordinates originally set) get them back,
776             but I have not looked into whether they are actually correct.
777              
778             =cut
779              
780             sub ecliptic_cartesian {
781 73411     73411 1 196821 my ( $self, @args ) = @_;
782              
783 73411         175761 $self = $self->_check_coord( ecliptic_cartesian => \@args );
784              
785 73411 100       151049 if ( @args ) {
786 71714 50       148671 @args % 3
787             and croak <<'EOD';
788             Error - The ecliptic_cartesian() method must be called with either zero
789             or one arguments (to retrieve coordinates), or three or four
790             arguments (to set coordinates). There is currently no six or
791             seven argument version.
792             EOD
793 71714         176421 my $epsilon = $self->obliquity();
794 71714         129567 my $sin_epsilon = sin $epsilon;
795 71714         112431 my $cos_epsilon = cos $epsilon;
796 71714         106448 my @eci;
797 71714         179404 for ( my $inx = 0; $inx < @args; $inx += 3 ) {
798 71714         148584 push @eci, $args[ $inx ];
799 71714         160573 push @eci, - $args[ $inx + 2 ] * $sin_epsilon +
800             $args[ $inx + 1 ] * $cos_epsilon;
801 71714         198194 push @eci, $args[ $inx + 2 ] * $cos_epsilon +
802             $args[ $inx + 1 ] * $sin_epsilon;
803             }
804 71714         212543 $self->eci( @eci );
805 71714         151559 $self->{_ECI_cache}{inertial}{ecliptic_cartesian} = \@args;
806 71714         120381 $self->{inertial} = 1;
807 71714         124953 $self->{specified} = 'ecliptic_cartesian';
808 71714         173630 return $self;
809             } else {
810             $self->{_ECI_cache}{inertial}{ecliptic_cartesian}
811             and return @{
812 1697 100       3822 $self->{_ECI_cache}{inertial}{ecliptic_cartesian}
813 238         846 };
814 1459         3372 my @eci = $self->eci();
815 1459         3316 my $epsilon = $self->obliquity();
816 1459         2370 my $sin_epsilon = sin $epsilon;
817 1459         2202 my $cos_epsilon = cos $epsilon;
818 1459         2098 my @ecliptic_cartesian;
819 1459         4753 for ( my $inx = 0; $inx < @eci; $inx += 3 ) {
820 1459         3869 push @ecliptic_cartesian, $eci[ $inx ];
821 1459         3279 push @ecliptic_cartesian, $eci[ $inx + 2 ] * $sin_epsilon +
822             $eci[ $inx + 1 ] * $cos_epsilon;
823 1459         4368 push @ecliptic_cartesian, $eci[ $inx + 2 ] * $cos_epsilon -
824             $eci[ $inx + 1 ] * $sin_epsilon;
825             }
826             return @{
827 1459         2046 $self->{_ECI_cache}{inertial}{ecliptic_cartesian} =
828             \@ecliptic_cartesian
829 1459         7585 };
830             }
831              
832             }
833              
834             =item $coord = $coord->ecliptic ($latitude, $longitude, $range, $time);
835              
836             This method sets the L coordinates represented by the object
837             in terms of L and L in radians,
838             and the range to the object in kilometers, time being universal time.
839             The object itself is returned.
840              
841             The time argument is optional if the time represented by the object has
842             already been set (e.g. by the universal() or dynamical() methods).
843              
844             The latitude should be a number between -PI/2 and PI/2 radians
845             inclusive. The longitude should be a number between -2*PI and 2*PI
846             radians inclusive. The increased range (one would expect -PI to PI) is
847             because in some astronomical usages latitudes outside the range + or -
848             180 degrees are employed. A warning will be generated if either of these
849             range checks fails.
850              
851             This method can also be called as a class method, in which case it
852             instantiates the desired object. In this case the time is not optional.
853              
854             The algorithm for converting from ecliptic latitude and longitude to
855             right ascension and declination comes from Jean Meeus'
856             "Astronomical Algorithms", 2nd Edition, Chapter 13, page 93.
857              
858             =item ($latitude, $longitude, $range) = $coord->ecliptic ($time);
859              
860             This method returns the ecliptic latitude and longitude of the
861             object at the given time. The time is optional if the time represented
862             by the object has already been set (e.g. by the universal() or
863             dynamical() methods).
864              
865             B velocities are not returned by this method.
866              
867             =cut
868              
869             sub ecliptic {
870 73428     73428 1 170372 my ($self, @args) = @_;
871              
872 73428         190458 $self = $self->_check_coord( ecliptic => \@args );
873              
874 73428 100       148240 if ( @args ) {
875              
876 71714 50       168475 @args % 3
877             and croak 'Arguments are in threes, plus an optional time';
878 71714         208130 $self->{_ECI_cache}{inertial}{ecliptic} = \@args;
879 71714         181132 $self->ecliptic_cartesian(
880             _convert_spherical_x_to_cartesian( @args ) );
881 71714         142656 $self->{specified} = 'ecliptic';
882 71714         117735 $self->{inertial} = 1;
883 71714         178743 return $self;
884              
885             } else {
886              
887 1714         2553 return @{ $self->{_ECI_cache}{inertial}{ecliptic} ||= [
888 1714   100     6473 _convert_cartesian_to_spherical_x(
889             $self->ecliptic_cartesian() )
890             ]
891             };
892              
893             }
894             }
895              
896             =item $longitude = $coord->ecliptic_longitude();
897              
898             This method returns the ecliptic longitude of the body at its current
899             time setting, in radians. It is really just a convenience method, since
900             it is equivalent to C<< ( $coord->ecliptic() )[1] >>, and in fact that
901             is how it is implemented.
902              
903             =cut
904              
905             sub ecliptic_longitude {
906 0     0 1 0 my ( $self ) = @_;
907 0         0 return ( $self->ecliptic() )[1];
908             }
909              
910             =item $seconds = $self->equation_of_time( $time );
911              
912             This method returns the equation of time at the given B
913             time. If the time is C, the invocant's dynamical time is used.
914              
915             The algorithm is from W. S. Smart's "Text-Book on Spherical Astronomy",
916             as reported in Jean Meeus' "Astronomical Algorithms", 2nd Edition,
917             Chapter 28, page 185.
918              
919             =cut
920              
921             sub equation_of_time {
922 1     1 1 343 my ( $self, $time ) = @_;
923              
924 1 50       6 if ( looks_like_number( $self ) ) {
925 0         0 ( $self, $time ) = ( __PACKAGE__, $self );
926             }
927 1 50       2 defined $time
928             or $time = $self->dynamical();
929              
930 1         4 my $epsilon = $self->obliquity( $time );
931 1         4 my $y = tan($epsilon / 2);
932 1         2 $y *= $y;
933              
934             # The following algorithm is from Meeus, chapter 25, page, 163 ff.
935              
936 1         19 my $T = jcent2000( $time ); # Meeus (25.1)
937 1         5 my $L0 = mod2pi( deg2rad( (.0003032 * $T + 36000.76983 ) * $T
938             + 280.46646 ) ); # Meeus (25.2)
939 1         15 my $M = mod2pi( deg2rad( ( ( -.0001537 ) * $T + 35999.05029 )
940             * $T + 357.52911 ) ); # Meeus (25.3)
941 1         3 my $e = ( -0.0000001267 * $T - 0.000042037 ) * $T
942             + 0.016708634; # Meeus (25.4)
943              
944 1         6 my $E = $y * sin( 2 * $L0 ) - 2 * $e * sin( $M ) +
945             4 * $e * $y * sin( $M ) * cos( 2 * $L0 ) -
946             $y * $y * .5 * sin( 4 * $L0 ) -
947             1.25 * $e * $e * sin( 2 * $M ); # Meeus (28.3)
948              
949 1         3 return $E * SECSPERDAY / TWOPI; # The formula gives radians.
950             }
951              
952             =item $coord->equatorial ($rightasc, $declin, $range, $time);
953              
954             This method sets the L coordinates represented by the
955             object (relative to the center of the Earth) in terms of
956             L and L in radians, and the range to the
957             object in kilometers, time being universal time. The object itself is
958             returned.
959              
960             If C is called in this way, the C attribute will
961             be ignored, for historical reasons.
962              
963             The right ascension should be a number between 0 and 2*PI radians
964             inclusive. The declination should be a number between -PI/2 and PI/2
965             radians inclusive. A warning will be generated if either of these range
966             checks fails.
967              
968             The time argument is optional if the time represented by the object
969             has already been set (e.g. by the universal() or dynamical() methods).
970              
971             This method can also be called as a class method, in which case it
972             instantiates the desired object. In this case the time is not optional.
973              
974             You may optionally pass velocity information in addition to position
975             information. If you do this, the velocity in right ascension (in radians
976             per second), declination (ditto), and range (in kilometers per second in
977             recession) are passed after the position arguments, and before the $time
978             argument if any.
979              
980             =item ( $rightasc, $declin, $range ) = $coord->equatorial( $time );
981              
982             This method returns the L coordinates of the object at the
983             relative to the center of the Earth. The C attribute is
984             ignored. The time argument is optional if the time represented by the
985             object has already been set (e.g. by the universal() or dynamical()
986             methods).
987              
988             If velocities are available from the object (i.e. if it is an instance
989             of Astro::Coord::ECI::TLE) the return will contain velocity in right
990             ascension, declination, and range, the first two being in radians per
991             second and the third in kilometers per second in recession.
992              
993             B these velocities are believed by me to be sane B they are
994             derived from ECI coordinates. This method does not support setting
995             velocities. See L, below,
996             for details.
997              
998             =item ($rightasc, $declin, $range) = $coord->equatorial( $coord2 );
999              
1000             This method is retained (for the moment) for historical reasons, but
1001             C is preferred.
1002              
1003             This method returns the apparent equatorial coordinates of the object
1004             represented by $coord2, as seen from the location represented by
1005             $coord.
1006              
1007             As a side effect, the time of the $coord object may be set from the
1008             $coord2 object.
1009              
1010             If the C attribute of the $coord object is
1011             true, the coordinates will be corrected for atmospheric refraction using
1012             the correct_for_refraction() method.
1013              
1014             If velocities are available from both objects (i.e. if both objects are
1015             Astro::Coord::ECI::TLE objects) the return will contain velocity in
1016             right ascension, declination, and range, the first two being in radians
1017             per second and the third in kilometers per second in recession.
1018              
1019             B these velocities are believed by me B to be correct.
1020              
1021             =cut
1022              
1023             sub equatorial {
1024 4386     4386 1 9025 my ( $self, @args ) = @_;
1025              
1026 4386         5992 my $body;
1027             @args
1028 4386 100 100     12709 and embodies( $args[0], __PACKAGE__ )
1029             and $body = shift @args;
1030              
1031 4386         10356 $self = $self->_check_coord( equatorial => \@args );
1032 4386         6528 my $time;
1033 4386 100       12422 $body or $time = $self->universal;
1034              
1035 4386 100       10323 if ( @args ) {
    100          
1036 2919 50       6127 @args % 3
1037             and croak 'Arguments must be in threes, with an optional time';
1038 2919 50       5555 $body
1039             and croak 'You may not set the equatorial coordinates ',
1040             'relative to an observer';
1041              
1042             ## my ($ra, $dec, $range, @eqvel) = @args;
1043 2919         6325 $args[0] = _check_right_ascension( 'right ascension' => $args[0] );
1044 2919         6304 $args[1] = _check_latitude( declination => $args[1] );
1045 2919         5653 foreach my $key (@kilatr) {delete $self->{$key}}
  14595         32802  
1046 2919         8432 $self->{_ECI_cache}{inertial}{equatorial} = \@args;
1047 2919         6353 $self->eci(
1048             _convert_spherical_to_cartesian( @args ) );
1049 2919         5786 $self->{specified} = 'equatorial';
1050 2919         4583 $self->{inertial} = 1;
1051 2919         7146 return $self;
1052              
1053             } elsif ( $body ) {
1054              
1055 3         40 return $self->_equatorial_reduced( $body );
1056              
1057             } else {
1058              
1059 1464         2101 return @{ $self->{_ECI_cache}{inertial}{equatorial} ||= [
1060 1464   50     7551 _convert_cartesian_to_spherical( $self->eci() )
1061             ] };
1062              
1063             }
1064             }
1065              
1066             =item ($ra, $decl, $rng) = $coord->equatorial_apparent( $sta );
1067              
1068             This method returns the apparent equatorial coordinates of the C<$coord>
1069             object as seen from the object specified by the C<$sta> argument, or by
1070             the object in the C attribute of the C<$coord> object if no
1071             argument is specified.
1072              
1073             This method will return velocities if available, but I have no idea
1074             whether they are correct.
1075              
1076             =cut
1077              
1078             sub equatorial_apparent {
1079 1     1 1 11 my ( $self, $station ) = @_;
1080 1 50 33     9 ( $station ||= $self->get( 'station' ) )
1081             or croak 'Station attribute is required';
1082 1         4 return $station->_equatorial_reduced( $self );
1083             }
1084              
1085             =item my ($rasc, $decl, $range, $v_rasc, $v_decl, $v_r) = $coord->equatorial_unreduced($body);
1086              
1087             This method computes the unreduced equatorial position of the second ECI
1088             object as seen from the first. If the second argument is undefined,
1089             computes the equatorial position of the first object as seen from the
1090             center of the Earth. Unlike the equatorial() method itself, this method
1091             is an accessor only. This method would probably not be exposed except
1092             for the anticipation of the usefulness of $range and $v_r in satellite
1093             conjunction computations, and the desirability of not taking the time to
1094             make the two atan2() calls that are unneeded in this application.
1095              
1096             The 'unreduced' in the name of the method is intended to refer to the
1097             fact that the $rasc and $decl are not the right ascension and
1098             declination themselves, but the arguments to atan2() needed to compute
1099             them, and $v_rasc and $v_decl are in km/sec, rather than being divided
1100             by the range to get radians per second.
1101              
1102             This method ignores the C<'station'> attribute.
1103              
1104             The returned data are:
1105              
1106             $rasc is an array reference, which can be converted to the right
1107             ascension in radians by mod2pi(atan2($rasc->[0], $rasc->[1])).
1108              
1109             $decl is an array reference, which can be converted to the declination
1110             in radians by atan2($decl->[0], $decl->[1]).
1111              
1112             $range is the range in kilometers.
1113              
1114             $v_rasc is the velocity in the right ascensional direction in kilometers
1115             per second. It can be converted to radians per second by dividing by
1116             $range.
1117              
1118             $v_decl is the velocity in the declinational direction in kilometers per
1119             second. It can be converted to radians per second by dividing by $range.
1120              
1121             $v_r is the velocity in recession in kilometers per second. Negative
1122             values indicate that the objects are approaching.
1123              
1124             The velocities are only returned if they are available from the input
1125             objects.
1126              
1127             B these velocities are believed by me B to be correct.
1128              
1129             =cut
1130              
1131             sub equatorial_unreduced {
1132              
1133             # Unpack the two objects.
1134              
1135 4     4 1 11 my ($self, $body) = @_;
1136              
1137             # Compute the relative positions if there are in fact two objects;
1138             # otherwise just get the absolute position.
1139              
1140 4         8 my @pos;
1141 4 50       11 if ($body) {
1142 4         14 @pos = $body->eci();
1143 4         14 my @base = $self->eci($body->universal());
1144 4 50       37 my $limit = @pos < @base ? @pos : @base;
1145 4         14 foreach my $inx (0 .. $limit - 1) {
1146 21         36 $pos[$inx] -= $base[$inx];
1147             }
1148 4         19 splice @pos, $limit;
1149             } else {
1150             $self->{_ECI_cache}{inertial}{equatorial_unreduced} and return
1151 0 0       0 @{$self->{_ECI_cache}{inertial}{equatorial_unreduced}};
  0         0  
1152 0         0 @pos = $self->eci();
1153             }
1154              
1155             # Rotate the coordinate system so that the second body lies in the
1156             # X-Z plane. The matrix is
1157             # +- -+
1158             # | cos rasc -sin rasc 0 |
1159             # | sin rasc cos rasc 0 |
1160             # | 0 0 1 |
1161             # +- -+
1162             # where rasc is -atan2(y,x). This means sin rasc = -y/h and
1163             # cos rasc = x/h where h = sqrt(x*x + y*y). You postmultiply
1164             # the matrix by the vector to get the new vector.
1165              
1166 4         12 my $hypot_rasc = sqrt($pos[0] * $pos[0] + $pos[1] * $pos[1]);
1167              
1168             # Now we need to rotate the coordinates in the new X-Z plane until
1169             # the second body lies along the X axis. The matrix is
1170             # +- -+
1171             # | cos decl 0 -sin decl |
1172             # | 0 1 0 |
1173             # | sin decl 0 cos decl |
1174             # +- -+
1175             # where decl is -atan2(z,x') (in the new coordinate system), or
1176             # -atan2(z,h) in the old coordinate system. This means that sin decl
1177             # = z/h' and cos decl = x/h' where h' = sqrt(h*h + z*z). Again you
1178             # postmultiply the matrix by the vector to get the result.
1179              
1180 4         8 my $hypot_decl = sqrt($hypot_rasc * $hypot_rasc + $pos[2] * $pos[2]);
1181              
1182             # But at this point we have the equatorial coordinates themselves in
1183             # terms of the original coordinates and the various intermediate
1184             # quantities needed to compute the matrix. So we only need the
1185             # matrix if we need to deal with the velocities. For this, the
1186             # velocity rotation matrix is
1187             # +- -+ +- -+
1188             # | cos decl 0 -sin decl | | cos rasc -sin rasc 0 |
1189             # | 0 1 0 | x | sin rasc cos rasc 0 | =
1190             # | sin decl 0 cos decl | | 0 0 1 |
1191             # +- -+ +- -+
1192             #
1193             # +- -+
1194             # | cos decl cos rasc -cos decl sin rasc -sin decl |
1195             # | sin rasc cos rasc 0 |
1196             # | sin decl cos rasc -sin decl sin rasc cos decl |
1197             # +- +
1198              
1199 4         16 my @rslt = ([$pos[1], $pos[0]], [$pos[2], $hypot_rasc], $hypot_decl);
1200 4 100       10 if (@pos >= 6) {
1201 3         8 my $cos_rasc = $pos[0]/$hypot_rasc;
1202 3         5 my $sin_rasc = -$pos[1]/$hypot_rasc;
1203 3         7 my $cos_decl = $hypot_rasc/$hypot_decl;
1204 3         8 my $sin_decl = -$pos[2]/$hypot_decl;
1205 3         14 push @rslt,
1206             $sin_rasc * $pos[3] + $cos_rasc * $pos[4],
1207             $sin_decl * $cos_rasc * $pos[3]
1208             - $sin_decl * $sin_rasc * $pos[4] + $cos_decl * $pos[5],
1209             # Computationally the following is the top row of the
1210             # matrix, but it is swapped to the bottom in the output for
1211             # consistency of returned data sequence.
1212             $cos_decl * $cos_rasc * $pos[3]
1213             - $cos_decl * $sin_rasc * $pos[4] - $sin_decl * $pos[5];
1214             }
1215             $body
1216 4 50       11 or $self->{_ECI_cache}{inertial}{equatorial_unreduced} = \@rslt;
1217 4         13 return @rslt;
1218              
1219             }
1220              
1221             sub _equatorial_reduced {
1222 4     4   13 my ( $self, $body ) = @_;
1223 4         19 my @rslt = $self->equatorial_unreduced( $body );
1224 4         148 $rslt[0] = mod2pi( atan2( $rslt[0][0], $rslt[0][1] ) );
1225 4         10 $rslt[1] = atan2( $rslt[1][0], $rslt[1][1] );
1226 4 100       14 if (@rslt >= 6) {
1227 3         5 $rslt[3] /= $rslt[2];
1228 3         6 $rslt[4] /= $rslt[2];
1229             }
1230 4         15 return @rslt;
1231             }
1232              
1233             =item $coord = $coord->equinox_dynamical ($value);
1234              
1235             This method sets the value of the equinox_dynamical attribute, and
1236             returns the modified object. If called without an argument, it returns
1237             the current value of the equinox_dynamical attribute.
1238              
1239             Yes, it is equivalent to $coord->set (equinox_dynamical => $value) and
1240             $coord->get ('equinox_dynamical'). But there seems to be a significant
1241             performance penalty in the $self->SUPER::set () needed to get this
1242             attribute set from a subclass. It is possible that more methods like
1243             this will be added, but I do not plan to eliminate the set() interface.
1244              
1245             =cut
1246              
1247             sub equinox_dynamical {
1248 90553 50   90553 1 201228 if (@_ > 1) {
1249 90553         178297 $_[0]{equinox_dynamical} = $_[1];
1250 90553         168020 return $_[0];
1251             } else {
1252 0         0 return $_[0]{equinox_dynamical};
1253             }
1254             }
1255              
1256             =item $coord = $coord->geocentric($psiprime, $lambda, $rho);
1257              
1258             This method sets the L coordinates represented by the
1259             object in terms of L psiprime and L
1260             lambda in radians, and distance from the center of the Earth rho in
1261             kilometers.
1262              
1263             The latitude should be a number between -PI/2 and PI/2 radians
1264             inclusive. The longitude should be a number between -2*PI and 2*PI
1265             radians inclusive. The increased range (one would expect -PI to PI) is
1266             because in some astronomical usages latitudes outside the range + or -
1267             180 degrees are employed. A warning will be generated if either of these
1268             range checks fails.
1269              
1270             This method can also be called as a class method, in which case it
1271             instantiates the desired object.
1272              
1273             B because map
1274             latitude is L, measured in terms of the tangent of
1275             the reference ellipsoid, whereas geocentric coordinates are,
1276             essentially, spherical coordinates.
1277              
1278             The algorithm for conversion between geocentric and ECEF is the
1279             author's.
1280              
1281             =item ($psiprime, $lambda, $rho) = $coord->geocentric();
1282              
1283             This method returns the L, L, and
1284             distance to the center of the Earth.
1285              
1286             =cut
1287              
1288             sub geocentric {
1289 92038     92038 1 189583 my ($self, @args) = @_;
1290              
1291 92038         238632 $self = $self->_check_coord (geocentric => \@args);
1292              
1293 92038 100       202951 unless (@args) {
1294              
1295 89927 100       253012 if ( ! $self->{_ECI_cache}{fixed}{geocentric} ) {
1296              
1297             ## my ($x, $y, $z, $xdot, $ydot, $zdot) = $self->ecef;
1298 42990         102500 my ($x, $y, $z) = $self->ecef;
1299 42990         90711 my $rsq = $x * $x + $y * $y;
1300 42990         74678 my $rho = sqrt ($z * $z + $rsq);
1301 42990         97994 my $lambda = atan2 ($y, $x);
1302 42990         74947 my $psiprime = atan2 ($z, sqrt ($rsq));
1303 42990 50       156092 $self->get ('debug') and print <
1304             Debug geocentric () - ecef -> geocentric
1305             inputs:
1306             x = $x
1307             y = $y
1308             z = $z
1309             outputs:
1310             psiprime = $psiprime
1311             lambda = $lambda
1312             rho = $rho
1313             eod
1314             $self->{_ECI_cache}{fixed}{geocentric} =
1315 42990         155643 [ $psiprime, $lambda, $rho ];
1316             }
1317              
1318 89927         140233 return @{ $self->{_ECI_cache}{fixed}{geocentric} };
  89927         343587  
1319             }
1320              
1321 2111 50       4208 if (@args == 3) {
1322 2111         4289 my ($psiprime, $lambda, $rho) = @args;
1323 2111         4046 $psiprime = _check_latitude(latitude => $psiprime);
1324 2111         4141 $lambda = _check_longitude(longitude => $lambda);
1325 2111         3982 my $z = $rho * sin ($psiprime);
1326 2111         3377 my $r = $rho * cos ($psiprime);
1327 2111         3266 my $x = $r * cos ($lambda);
1328 2111         3846 my $y = $r * sin ($lambda);
1329 2111 50       5581 $self->get ('debug') and print <
1330             Debug geocentric () - geocentric -> ecef
1331             inputs:
1332             psiprime = $psiprime
1333             lambda = $lambda
1334             rho = $rho
1335             outputs:
1336             x = $x
1337             y = $y
1338             z = $z
1339             eod
1340 2111         7030 $self->ecef ($x, $y, $z);
1341 2111         4345 $self->{_ECI_cache}{fixed}{geocentric} = \@args;
1342 2111         4026 $self->{specified} = 'geocentric';
1343 2111         4587 $self->{inertial} = 0;
1344             } else {
1345 0         0 croak <
1346             Error - Method geocentric() must be called with either zero arguments
1347             (to retrieve coordinates) or three arguments (to set
1348             coordinates). There is currently no six argument version.
1349             eod
1350             }
1351 2111         3230 return $self;
1352             }
1353              
1354             =item $coord = $coord->geodetic($psi, $lambda, $h, $ellipsoid);
1355              
1356             This method sets the L coordinates represented by the object
1357             in terms of its L psi and L lambda in
1358             radians, and its height h above mean sea level in kilometers.
1359              
1360             The latitude should be a number between -PI/2 and PI/2 radians
1361             inclusive. The longitude should be a number between -2*PI and 2*PI
1362             radians inclusive. The increased range (one would expect -PI to PI) is
1363             because in some astronomical usages latitudes outside the range + or -
1364             180 degrees are employed. A warning will be generated if either of these
1365             range checks fails.
1366              
1367             The ellipsoid argument is the name of a L known
1368             to the class, and is optional. If passed, it will set the ellipsoid
1369             to be used for calculations with this object. If not passed, the
1370             default ellipsoid is used.
1371              
1372             This method can also be called as a class method, in which case it
1373             instantiates the desired object.
1374              
1375             The conversion from geodetic to geocentric comes from Jean Meeus'
1376             "Astronomical Algorithms", 2nd Edition, Chapter 11, page 82.
1377              
1378             B
1379              
1380             =item ($psi, $lambda, $h) = $coord->geodetic($ellipsoid);
1381              
1382             This method returns the geodetic latitude, longitude, and height
1383             above mean sea level.
1384              
1385             The ellipsoid argument is the name of a L known
1386             to the class, and is optional. If not specified, the most-recently-set
1387             ellipsoid will be used.
1388              
1389             The conversion from geocentric to geodetic comes from Kazimierz
1390             Borkowski's "Accurate Algorithms to Transform Geocentric to Geodetic
1391             Coordinates", at F.
1392             This is best viewed with Internet Explorer because of its use of Microsoft's
1393             Symbol font.
1394              
1395             =cut
1396              
1397             sub geodetic {
1398 52148     52148 1 1723969 my ($self, @args) = @_;
1399              
1400             # Detect and acquire the optional ellipsoid name argument. We do
1401             # this before the check, since the check expects the extra
1402             # argument to be a time.
1403              
1404 52148 50 33     233273 my $elps = (@args == 1 || @args == 4) ? pop @args : undef;
1405              
1406 52148 50       155061 $self = $self->_check_coord (geodetic => \@args, $elps ? $elps : ());
1407              
1408             # The following is just a sleazy way to get a consistent
1409             # error message if the ellipsoid name is unknown.
1410              
1411 52148 50       120583 $elps && $self->reference_ellipsoid ($elps);
1412              
1413             # If we're fetching the geodetic coordinates
1414            
1415 52148 100       112789 unless (@args) {
1416              
1417             # Return cached coordinates if they exist and we did not
1418             # override the default ellipsoid.
1419              
1420 48199         194946 return @{$self->{_ECI_cache}{fixed}{geodetic}}
1421 50039 100 66     207429 if $self->{_ECI_cache}{fixed}{geodetic} && !$elps;
1422 1840 50       4084 $self->{debug} and do {
1423 0         0 require Data::Dumper;
1424 0         0 local $Data::Dumper::Terse = 1;
1425 0         0 print "Debug geodetic - explicit ellipsoid ",
1426             Data::Dumper::Dumper( $elps );
1427             };
1428              
1429             # Get a reference to the ellipsoid data to use.
1430              
1431 1840 50       4042 $elps = $elps ? $known_ellipsoid{$elps} : $self;
1432 1840 50       4712 $self->{debug} and do {
1433 0         0 require Data::Dumper;
1434 0         0 local $Data::Dumper::Terse = 1;
1435 0         0 print "Debug geodetic - ellipsoid ", Data::Dumper::Dumper( $elps );
1436             };
1437              
1438             # Calculate geodetic coordinates.
1439              
1440 1840         4451 my ($phiprime, $lambda, $rho) = $self->geocentric;
1441 1840         4278 my $r = $rho * cos ($phiprime);
1442 1840         4521 my $b = $elps->{semimajor} * (1- $elps->{flattening});
1443 1840         3370 my $a = $elps->{semimajor};
1444 1840         3315 my $z = $rho * sin ($phiprime);
1445             # The $b is _not_ a magic variable, since we are not inside
1446             # any of the specialized blocks that make $b magic. Perl::Critic
1447             # is simply confused.
1448 1840 100       4104 $b = - $b ## no critic (RequireLocalizedPunctuationVars)
1449             if $z < 0; # Per Borkowski, for southern hemisphere.
1450              
1451             # The following algorithm is due to Kazimierz Borkowski's
1452             # paper "Accurate Algorithms to Transform Geocentric to Geodetic
1453             # Coordinates", from
1454             # http://www.astro.uni.torun.pl/~kb/Papers/geod/Geod-BG.htm
1455              
1456 1840         2934 my $bz = $b * $z;
1457 1840         3138 my $asq_bsq = $a * $a - $b * $b;
1458 1840         2851 my $ar = $a * $r;
1459 1840         3498 my $E = ($bz - $asq_bsq) / $ar; # Borkowski (10)
1460 1840         3219 my $F = ($bz + $asq_bsq) / $ar; # Borkowski (11)
1461 1840         3578 my $Q = ($E * $E - $F * $F) * 2; # Borkowski (17)
1462 1840         3640 my $P = ($E * $F + 1) * 4 / 3; # Borkowski (16)
1463 1840         4037 my $D = $P * $P * $P + $Q * $Q; # Borkowski (15)
1464             my $v = $D >= 0 ? do {
1465 1840         2941 my $d = sqrt $D;
1466 1840         2642 my $onethird = 1 / 3;
1467 1840         4992 my $vp = ($d - $Q) ** $onethird - # Borkowski (14a)
1468             ($d + $Q) ** $onethird;
1469 1840 50       5841 $vp * $vp >= abs ($P) ? $vp :
1470             - ($vp * $vp * $vp + 2 * $Q) / # Borkowski (20)
1471             (3 * $P);
1472 1840 50       3952 } : do {
1473 0         0 my $p = - $P;
1474 0         0 sqrt (cos (acos ($Q / # Borkowski (14b)
1475             sqrt ($p * $p * $p)) / 3) * $p) * 2;
1476             };
1477 1840         4274 my $G = (sqrt ($E * $E + $v) # Borkowski (13)
1478             + $E) / 2;
1479 1840         4113 my $t = sqrt ($G * $G + ($F - $v * $G) # Borkowski (12)
1480             / (2 * $G - $E)) - $G;
1481              
1482             # Borkowski (18)
1483             # equivalent to atan (arg1)
1484 1840         3432 my $phi = do {
1485 1840         3541 my $Y = $a * ( 1 - $t * $t );
1486 1840         3426 my $X = 2 * $b * $t;
1487 1840 100       4228 ( $Y, $X ) = ( -$Y, -$X ) if $X < 0;
1488 1840         3794 atan2 $Y, $X;
1489             };
1490              
1491 1840         4217 my $h = ($r - $a * $t) * cos ($phi) + # Borkowski (19)
1492             ($z - $b) * sin ($phi);
1493              
1494             # End of Borkowski's algorthm.
1495              
1496             # Cache the results of the calculation if they were done using
1497             # the default ellipsoid.
1498              
1499 1840 50       4024 $self->{_ECI_cache}{fixed}{geodetic} = [$phi, $lambda, $h] unless $elps;
1500              
1501             # Return the results in any event.
1502              
1503 1840 50       5805 $self->get ('debug') and print <
1504             Debug geodetic: geocentric to geodetic
1505             inputs:
1506             phiprime = $phiprime
1507             lambda = $lambda
1508             rho = $rho
1509             intermediates:
1510             z = $z
1511             r = $r
1512             E = $E
1513             F = $F
1514             P = $P
1515             Q = $Q
1516             D = $D
1517             v = $v
1518             G = $G
1519             t = $t
1520             outputs:
1521             phi = atan2 (a * (1 - t * t), 2 * b * t)
1522 0         0 = atan2 (@{[$a * (1 - $t * $t)]}, @{[2 * $b * $t]})
  0         0  
1523             = $phi (radians)
1524             h = (r - a * t) * cos (phi) + (z - b) * sin (phi)
1525 0         0 = @{[$r - $a * $t]} * cos (phi) + @{[$z - $b]} * sin (phi)
  0         0  
1526             = $h (kilometers)
1527             eod
1528 1840         6733 return ($phi, $lambda, $h);
1529             }
1530              
1531             # If we're setting the geodetic coordinates.
1532              
1533 2109 50       4066 if (@args == 3) {
1534              
1535             # Set the ellipsoid for the object if one was specified.
1536              
1537 2109 50       3963 $self->set (ellipsoid => $elps) if $elps;
1538              
1539             # Calculate the geocentric data.
1540              
1541 2109         4576 my ($phi, $lambda, $h) = @args;
1542 2109         5500 $phi = _check_latitude(latitude => $phi);
1543 2109         4668 $lambda = _check_longitude(longitude => $lambda);
1544 2109         4770 my $bovera = 1 - $self->{flattening};
1545              
1546             # The following algorithm appears on page 82 of the second
1547             # edition of Jean Meeus' "Astronomical Algorithms."
1548              
1549 2109         5249 my $u = atan2 ($bovera * tan ($phi), 1);
1550             my $rhosinlatprime = $bovera * sin ($u) +
1551 2109         5865 $h / $self->{semimajor} * sin ($phi);
1552             my $rhocoslatprime = cos ($u) +
1553 2109         4662 $h / $self->{semimajor} * cos ($phi);
1554 2109         3289 my $phiprime = atan2 ($rhosinlatprime, $rhocoslatprime);
1555 2109 50       5358 my $rho = $self->{semimajor} * ($rhocoslatprime ?
1556             $rhocoslatprime / cos ($phiprime) :
1557             $rhosinlatprime / sin ($phiprime));
1558              
1559             # End of Meeus' algorithm.
1560              
1561             # Set the geocentric data as the coordinates.
1562              
1563 2109         8597 $self->geocentric ($phiprime, $lambda, $rho);
1564            
1565            
1566             # Cache the geodetic coordinates.
1567            
1568 2109         7866 $self->{_ECI_cache}{fixed}{geodetic} = [$phi, $lambda, $h];
1569 2109         3742 $self->{specified} = 'geodetic';
1570 2109         3870 $self->{inertial} = 0;
1571              
1572             # Else if the number of coordinates is bogus, croak.
1573              
1574             } else {
1575 0         0 croak <
1576             Error - Method geodetic() must be called with either zero arguments
1577             (to retrieve coordinates) or three arguments (to set
1578             coordinates). There is currently no six argument version.
1579             eod
1580             }
1581              
1582             # Return the object, wherever it came from.
1583              
1584 2109         7925 return $self;
1585              
1586             }
1587              
1588             =item $value = $coord->get ($attrib);
1589              
1590             This method returns the named attributes of the object. If called in
1591             list context, you can give more than one attribute name, and it will
1592             return all their values.
1593              
1594             If called as a class method, it returns the current default values.
1595              
1596             See L for a list of the attributes you can get.
1597              
1598             =cut
1599              
1600             { # Begin local symbol block.
1601              
1602             my %accessor = (
1603             sun => sub {
1604             ## my ( $self, $name ) = @_;
1605             my ( $self ) = @_; # Name unused
1606             $self->{sun}
1607             and return $self->{sun};
1608             my $sun_class = $self->SUN_CLASS();
1609             ( my $path = "$sun_class.pm" ) =~ s< :: >smxg;
1610             require $path;
1611             return( $self->{sun} ||= $sun_class->new() );
1612             },
1613             );
1614              
1615             sub get {
1616 207868     207868 1 438420 my ($self, @args) = @_;
1617 207868 100       438371 ref $self or $self = \%static;
1618 207868         303947 my @rslt;
1619 207868         353801 foreach my $name (@args) {
1620 207868 50       496059 exists $mutator{$name}
1621             or croak " Error - Attribute '$name' does not exist";
1622 207868 100       409763 if ($accessor{$name}) {
1623 1597         3807 push @rslt, $accessor{$name}->($self, $name);
1624             } else {
1625 206271         457000 push @rslt, $self->{$name};
1626             }
1627             }
1628 207868 100       741416 return wantarray ? @rslt : $rslt[0];
1629             }
1630              
1631             } # End local symbol block
1632              
1633             =item @coords = $coord->enu();
1634              
1635             This method reports the coordinates of C<$coord> in the East-North-Up
1636             coordinate system, as seen from the position stored in the C
1637             attribute of C<$coord>.
1638              
1639             Velocity conversions to C appear to me to be mostly sane. See
1640             L, below, for details.
1641              
1642             =cut
1643              
1644             sub enu { # East, North, Up
1645 3     3 1 7 my ( $self ) = @_;
1646 3         8 my @vector = $self->neu();
1647 3         9 @vector[ 0, 1 ] = @vector[ 1, 0 ]; # Swap North and East
1648 3 50       10 @vector > 3 # If we have velocity,
1649             and @vector[ 3, 4 ] = @vector[ 4, 3 ]; # Ditto
1650 3         11 return @vector;
1651             }
1652              
1653             =item @coords = $coord->neu();
1654              
1655             This method reports the coordinates of C<$coord2> in the North-East-Up
1656             coordinate system, as seen from the position stored in the C
1657             attribute of C<$coord>. This is a B coordinate system.
1658              
1659             Velocity conversions to C appear to me to be mostly sane. See
1660             L, below, for details.
1661              
1662             =cut
1663              
1664             sub neu { # North, East, Up
1665 6     6 1 9 my ( $self ) = @_;
1666 6 50       14 my $station = $self->get( 'station' )
1667             or croak 'Station attribute required';
1668 6         14 return $station->_local_cartesian( $self );
1669             }
1670              
1671             =item @coords = $coord->heliocentric_ecliptic_cartesian()
1672              
1673             This method returns the Heliocentric ecliptic Cartesian position of the
1674             object. You can optionally pass time as an argument; this is equivalent
1675             to
1676              
1677             @coords = $coord->universal( $time )
1678             ->heliocentric_ecliptic_cartesian();
1679              
1680             At this time this object is not able to derive Heliocentric ecliptic
1681             Cartesian coordinates from other coordinates (say, ECI).
1682              
1683             =item $coord->heliocentric_ecliptic_cartesian( $X, $Y, $Z )
1684              
1685             This method sets the object's position in Heliocentric ecliptic
1686             Cartesian coordinates. Velocities may not be set at the moment, though
1687             this is planned. You may also pass an optional time as the last
1688             argument.
1689              
1690             The invocant is returned.
1691              
1692             =cut
1693              
1694             sub heliocentric_ecliptic_cartesian {
1695 0     0 1 0 my ( $self, @args ) = @_;
1696              
1697 0         0 $self = $self->_check_coord( heliocentric_ecliptic_cartesian => \@args );
1698              
1699 0 0       0 if ( @args == 3 ) {
    0          
1700             $self->{_ECI_cache} = {
1701 0         0 inertial => {
1702             heliocentric_ecliptic_cartesian => \@args,
1703             },
1704             };
1705 0 0       0 my $sun = $self->get( 'sun' )
1706             or croak q{Attribute 'sun' not set};
1707 0         0 my ( $X_sun, $Y_sun, $Z_sun ) = $sun->universal(
1708             $self->universal() )->ecliptic_cartesian();
1709 0         0 my ( $X, $Y, $Z ) = ( $args[0] + $X_sun, $args[1] + $Y_sun,
1710             $args[2] + $Z_sun );
1711 0         0 $self->ecliptic_cartesian( $X, $Y, $Z );
1712 0         0 $self->{specified} = 'heliocentric_ecliptic_cartesian';
1713 0         0 $self->{inertial} = 1;
1714             } elsif ( @args ) {
1715 0         0 croak 'heliocentric_ecliptic_cartesian() wants 0, 1, 3 or 4 arguments';
1716             } else {
1717             $self->{_ECI_cache}{inertial}{heliocentric_ecliptic_cartesian}
1718             and return @{
1719 0 0       0 $self->{_ECI_cache}{inertial}{heliocentric_ecliptic_cartesian}
1720 0         0 };
1721 0 0       0 my $sun = $self->get( 'sun' )
1722             or croak q{Attribute 'sun' not set};
1723 0         0 my ( $X_self, $Y_self, $Z_self ) = $self->ecliptic_cartesian();
1724 0         0 my ( $X_sun, $Y_sun, $Z_sun ) = $sun->universal(
1725             $self->universal() )->ecliptic_cartesian();
1726              
1727 0         0 my @hec = ( $X_self - $X_sun, $Y_self - $Y_sun, $Z_self - $Z_sun );
1728              
1729 0         0 $self->set( equinox_dynamical => $self->dynamical() );
1730 0         0 $self->{_ECI_cache}{inertial}{heliocentric_ecliptic_cartesian} = \@hec;
1731 0         0 return @hec;
1732             }
1733 0         0 return $self;
1734             }
1735              
1736             =item @coords = $coord->heliocentric_ecliptic();
1737              
1738             This method returns the Heliocentric ecliptic coordinates of the object.
1739              
1740             =cut
1741              
1742             sub heliocentric_ecliptic {
1743 0     0 1 0 my ( $self, @args ) = @_;
1744              
1745 0         0 $self = $self->_check_coord( heliocentric_ecliptic => \@args );
1746              
1747 0 0       0 if ( @args ) {
1748 0 0       0 @args % 3
1749             and croak 'Arguments must be in threes, plus an optional time';
1750 0         0 $self->{_ECI_cache}{inertial}{heliocentric_ecliptic} = \@args;
1751 0         0 $self->heliocentric_ecliptic_cartesian(
1752             _convert_spherical_x_to_cartesian( @args ) );
1753 0         0 $self->{specified} = 'heliocentric_ecliptic';
1754 0         0 return $self;
1755             } else {
1756             return @{
1757 0         0 $self->{_ECI_cache}{inertial}{heliocentric_ecliptic} ||= [
1758 0   0     0 _convert_cartesian_to_spherical_x(
1759             $self->heliocentric_ecliptic_cartesian() ) ] }
1760             }
1761 0         0 return $self;
1762             }
1763              
1764             # ( $temp, $X, $Y, $Z, $Xprime, $Yprime, $Zprime ) =
1765             # $self->_local_cartesian( $trn2 );
1766             # This method computes local Cartesian coordinates of $trn2 as seen from
1767             # $self. The first return is intermediate results useful for the azimuth
1768             # and elevation. The subsequent results are X, Y, and Z coordinates (and
1769             # velocities if available), in the North, East, Up coordinate system.
1770             # This is a left-handed coordinate system, but so is the azel() system,
1771             # which it serves.
1772              
1773             sub _local_cartesian {
1774 47027     47027   105790 my ( $self, $trn2 ) = @_;
1775 47027 50       98301 $self->{debug} and do {
1776 0         0 require Data::Dumper;
1777 0         0 local $Data::Dumper::Terse = 1;
1778 0         0 print "Debug local_cartesian - ", Data::Dumper::Dumper( $self, $trn2 );
1779             };
1780              
1781 47027         113058 my $time = $trn2->universal();
1782 47027         130562 $self->universal( $time );
1783              
1784             # Pick up the ECEF of the body and the station
1785              
1786 47027         113705 my @tgt = $trn2->ecef();
1787 47027         114559 my @obs = $self->ecef();
1788              
1789             # Translate the ECEF coordinates to the station.
1790              
1791 47027         256659 my $limit = int( min( scalar @tgt, scalar @obs ) / 3 ) * 3 - 1;
1792 47027         125876 foreach my $inx ( 0 .. $limit ) {
1793 191787         360607 $tgt[$inx] -= $obs[$inx];
1794             }
1795 47027         101360 splice @tgt, $limit + 1;
1796              
1797             # Pick up the latitude and longitude.
1798              
1799 47027         131691 my ( $lat, $lon ) = $self->geodetic();
1800 47027         103883 my $sinlat = sin $lat;
1801 47027         85539 my $coslat = cos $lat;
1802 47027         75116 my $sinlon = sin $lon;
1803 47027         80404 my $coslon = cos $lon;
1804              
1805             # Rotate X->Y to longitude of station,
1806             # then Z->X to latitude of station
1807              
1808             # NOTE to Flat Earthers: For the next two statements to produce a
1809             # position in a local Cartesian system with the X-Y plane coincident
1810             # with the horizon, the Earth must be the oblate spheroid specified
1811             # by the currently-set reference elllipsoid.
1812              
1813 47027         130629 @tgt[ 0, 1 ] = (
1814             $tgt[0] * $coslon + $tgt[1] * $sinlon,
1815             - $tgt[0] * $sinlon + $tgt[1] * $coslon,
1816             );
1817 47027         111397 @tgt[ 0, 2 ] = (
1818             $tgt[0] * $sinlat - $tgt[2] * $coslat,
1819             $tgt[0] * $coslat + $tgt[2] * $sinlat,
1820             );
1821              
1822 47027         80609 $tgt[0] = - $tgt[0]; # Convert Southing to Northing
1823              
1824 47027 100       110026 if ( @tgt > 5 ) {
1825 16902         44100 @tgt[ 3, 4 ] = (
1826             $tgt[3] * $coslon + $tgt[4] * $sinlon,
1827             - $tgt[3] * $sinlon + $tgt[4] * $coslon,
1828             );
1829 16902         39504 @tgt[ 3, 5 ] = (
1830             $tgt[3] * $sinlat - $tgt[5] * $coslat,
1831             $tgt[3] * $coslat + $tgt[5] * $sinlat,
1832             );
1833              
1834 16902         26644 $tgt[3] = - $tgt[3]; # Convert South velocity to North
1835             }
1836              
1837 47027         187844 return @tgt;
1838             }
1839              
1840             =item $coord = $coord->local_mean_time ($time);
1841              
1842             This method sets the local mean time of the object. B
1843             local standard time,> but the universal time plus the longitude
1844             of the object expressed in seconds. Another definition is mean
1845             solar time plus 12 hours (since the solar day begins at noon).
1846             You will get an exception of some sort if the position of the
1847             object has not been set, or if the object represents inertial
1848             coordinates, or on any subclass whose position depends on the time.
1849              
1850             =item $time = $coord->local_mean_time ()
1851              
1852             This method returns the local mean time of the object. It will raise
1853             an exception if the time has not been set.
1854              
1855             Note that this returns the actual local time, not the GMT equivalent.
1856             This means that in formatting for output, you call
1857              
1858             strftime $format, gmtime $coord->local_mean_time ();
1859              
1860             =cut
1861              
1862             sub local_mean_time {
1863 2     2 1 4 my ($self, @args) = @_;
1864              
1865 2 50       5 ref $self or croak <
1866             Error - The local_mean_time() method may not be called as a class method.
1867             eod
1868              
1869 2 100       4 unless (@args) {
1870 1 50       3 $self->{universal} || croak <
1871             Error - Object's time has not been set.
1872             eod
1873             $self->{local_mean_time} = $self->universal () +
1874             _local_mean_delta ($self)
1875 1 50       4 unless defined $self->{local_mean_time};
1876 1         6 return $self->{local_mean_time};
1877             }
1878              
1879 1 50       4 if (@args == 1) {
1880 1         2 my $time = shift @args;
1881 1 50       4 $self->{specified} or croak <
1882             Error - Object's coordinates have not been set.
1883             eod
1884 1 50       4 $self->{inertial} and croak <
1885             Error - You can not set the local time of an object that represents
1886             a position in an inertial coordinate system, because this
1887             causes the earth-fixed position to change, invalidating the
1888             local time.
1889             $self->can ('time_set') and croak <
1890 0         0 Error - You can not set the local time on an @{[ref $self]}
1891             object, because when you do the time_set() method will just
1892             move the object, invalidating the local time.
1893             eod
1894 1         4 $self->universal($time - _local_mean_delta($self));
1895 1         2 $self->{local_mean_time} = $time;
1896             } else {
1897 0         0 croak <
1898             Error - The local_mean_time() method must be called with either zero
1899             arguments (to retrieve the time) or one argument (to set
1900             the time).
1901             eod
1902             }
1903              
1904 1         5 return $self;
1905             }
1906              
1907             =item $time = $coord->local_time ();
1908              
1909             This method returns the local time (defined as solar time plus 12 hours)
1910             of the given object. There is no way to set the local time.
1911              
1912             This is really just a convenience routine - the calculation is simply
1913             the local mean time plus the equation of time at the given time.
1914              
1915             Note that this returns the actual local time, not the GMT equivalent.
1916             This means that in formatting for output, you call
1917              
1918             strftime $format, gmtime $coord->local_time ();
1919              
1920             =cut
1921              
1922             sub local_time {
1923 0     0 1 0 my $self = shift;
1924 0         0 return $self->local_mean_time() + $self->equation_of_time();
1925             }
1926              
1927             =item ( $maidenhead_loc, $height ) = $coord->maidenhead( $precision );
1928              
1929             This method returns the location of the object in the Maidenhead Locator
1930             System. Height above the reference ellipsoid is not part of the system,
1931             but is returned anyway, in kilometers. The $precision is optional, and
1932             is an integer greater than 0.
1933              
1934             The default precision is 4, but this can be modified by setting
1935             C<$Astro::Coord::ECI::DEFAULT_MAIDENHEAD_PRECISION> to the desired
1936             value. For example, if you want the default precision to be 3 (which it
1937             probably should have been in the first place), you can use
1938              
1939             no warnings qw{ once };
1940             local $Astro::Coord::ECI::DEFAULT_MAIDENHEAD_PRECISION = 3;
1941              
1942             Note that precisions greater than 4 are not defined by the standard.
1943             This method extends the system by alternating letters (base 24) with
1944             digits (base 10), but this is unsupported since the results will change,
1945             possibly without notice, if the standard is extended in a manner
1946             incompatible with this implementation.
1947              
1948             Conversion of latitudes and longitudes to Maidenhead Grid is subject to
1949             truncation error, perhaps more so since latitude and longitude are
1950             specified in radians. An attempt has been made to minimize this by using
1951             Perl's stringification of numbers to ensure that something that looks
1952             like C<42> is not handled as C<41.999999999385>. This probably amounts
1953             to shifting some grid squares very slightly to the north-west, but in
1954             practice it seems to give better results for points on the boundaries of
1955             the grid squares.
1956              
1957             =item $coord->maidenhead( $maidenhead_loc, $height );
1958              
1959             This method sets the geodetic location in the Maidenhead Locator System.
1960             Height above the reference ellipsoid is not part of the system, but is
1961             accepted anyway, in kilometers, defaulting to 0.
1962              
1963             The actual location set is the center of the specified grid square.
1964              
1965             Locations longer than 8 characters are not defined by the standard. This
1966             method extends precision by assuming alternate letters (base 24) and
1967             digits (base 10), but this will change, possibly without notice, if the
1968             standard is extended in a manner incompatible with this implementation.
1969              
1970             The object itself is returned, to allow call chaining.
1971              
1972             =cut
1973             {
1974              
1975             our $DEFAULT_MAIDENHEAD_PRECISION = 4;
1976              
1977             my $alpha = 'abcdefghijklmnopqrstuvwxyz';
1978              
1979             sub maidenhead {
1980 2085     2085 1 947677 my ( $self, @args ) = @_;
1981 2085 100 66     19504 if ( @args > 1 || defined $args[0] && $args[0] =~ m/ [^0-9] /smx ) {
      66        
1982 1042         2730 my ( $loc, $alt ) = @args;
1983 1042 50       2594 defined $alt or $alt = 0;
1984              
1985 1042         1769 my $precision = length $loc;
1986 1042 50       2815 $precision % 2
1987             and croak "Invalid Maidenhead locator; length must be even";
1988 1042         2023 $precision /= 2;
1989              
1990 1042         2017 my $lat = 0.5;
1991 1042         1489 my $lon = 0.5;
1992 1042         9441 my @chars = split qr{}smx, $loc;
1993 1042         3299 foreach my $base ( reverse _maidenhead_bases( $precision ) ) {
1994 3125         5442 foreach ( $lat, $lon ) {
1995 6250         9826 my $chr = pop @chars;
1996 6250 100       11210 if ( $base > 10 ) {
1997 4166 50       10278 ( my $inx = index $alpha, lc $chr ) < 0
1998             and croak 'Invalid Maidenhead locator; ',
1999             "'$chr' is not a letter";
2000 4166 100       7908 my $limit = @chars > 1 ? $base - 1 : $base;
2001 4166 50       8034 $inx > $limit
2002             and croak 'Invalid Maidenhead locator; ',
2003             "'$chr' is greater than '",
2004             substr( $alpha, $limit, 1 ), "'";
2005 4166         6736 $_ += $inx;
2006 4166         9465 $_ /= $base;
2007             } else {
2008 2084 50       5476 $chr =~ m/ [^0-9] /smx
2009             and croak 'Invalid Maidenhead locator; ',
2010             "'$chr' is not a digit";
2011 2084         3718 $_ += $chr;
2012 2084         4090 $_ /= $base;
2013             }
2014             }
2015             }
2016              
2017             $self->geodetic(
2018 1042         5260 deg2rad( $lat * 180 - 90 ),
2019             deg2rad( $lon * 360 - 180 ),
2020             $alt
2021             );
2022 1042         7620 return $self;
2023              
2024             } else {
2025 1043         2740 my ( $precision ) = @args;
2026 1043 50 33     4146 defined $precision
2027             and $precision > 0
2028             or $precision = $DEFAULT_MAIDENHEAD_PRECISION;
2029              
2030 1043         2491 my @bases = reverse _maidenhead_bases( $precision );
2031              
2032             # In order to minimize truncation errors we multiply
2033             # everything out, and then work right-to-left using the mod
2034             # operator. We stringify to take advantage of Perl's smarts
2035             # about when something is 42 versus 41.999999999583.
2036            
2037 1043         1702 my $multiplier = 1;
2038 1043         1886 foreach ( @bases ) {
2039 3126         4873 $multiplier *= $_;
2040             }
2041              
2042 1043         2460 my ( $lat, $lon, $alt ) = $self->geodetic();
2043 1043         2670 $lat = ( $lat + PIOVER2 ) * $multiplier / PI;
2044 1043         1751 $lon = ( $lon + PI ) * $multiplier / TWOPI;
2045 1043         13097 $lat = floor( "$lat" );
2046 1043         6529 $lon = floor( "$lon" );
2047              
2048 1043         1938 my @rslt;
2049 1043         1840 foreach my $base ( @bases ) {
2050 3126         5301 foreach ( $lat, $lon ) {
2051 6252         9249 my $inx = $_ % $base;
2052 6252 100       13638 push @rslt, $base > 10 ?
2053             substr( $alpha, $inx, 1 ) : $inx;
2054 6252         14794 $_ = floor( $_ / $base );
2055             }
2056             }
2057              
2058             @rslt
2059 1043 50       2887 and $rslt[-1] = uc $rslt[-1];
2060 1043 50       2199 @rslt > 1
2061             and $rslt[-2] = uc $rslt[-2];
2062              
2063             return (
2064 1043         8845 join( '', reverse @rslt ),
2065             $alt,
2066             );
2067             }
2068             }
2069              
2070             sub _maidenhead_bases {
2071 2085     2085   4171 my ( $precision ) = @_;
2072 2085         3059 my @bases;
2073 2085         5962 foreach my $inx ( 1 .. $precision ) {
2074 6251 100       14327 push @bases, $inx % 2 ? 24 : 10;
2075             }
2076 2085         3141 $bases[0] = 18;
2077 2085         5520 return @bases;
2078             }
2079             }
2080              
2081             =item $value = $coord->mean_angular_velocity();
2082              
2083             This method returns the mean angular velocity of the body in radians
2084             per second. If the $coord object has a period() method, this method
2085             just returns two pi divided by the period. Otherwise it returns the
2086             contents of the angularvelocity attribute.
2087              
2088             =cut
2089              
2090             sub mean_angular_velocity {
2091 3328     3328 1 6063 my $self = shift;
2092             return $self->can ('period') ?
2093             TWOPI / $self->period :
2094 3328 100       16903 $self->{angularvelocity};
2095             }
2096              
2097             =item $time = $coord->next_azimuth( $body, $azimuth );
2098              
2099             This method returns the next time the given C<$body> passes the given
2100             C<$azimuth> as seen from the given C<$coord>, calculated to the nearest
2101             second. The start time is the current time setting of the C<$body>
2102             object.
2103              
2104             =item $time = $coord->next_azimuth( $azimuth );
2105              
2106             This method returns the next time the C<$coord> object passes the given
2107             C<$azimuth> as seen from the location in the C<$coord> object's
2108             C attribute, calculated to the nearest second. The start time
2109             is the current time setting of the C<$coord> object.
2110              
2111             =cut
2112              
2113             sub next_azimuth {
2114 0     0 1 0 my ( $self, $body, $azimuth ) = _expand_args_default_station( @_ );
2115 0 0       0 ref $self or croak <<'EOD';
2116             Error - The next_azimuth() method may not be called as a class method.
2117             EOD
2118              
2119 0 0       0 $body->represents(__PACKAGE__) or croak <<"EOD";
2120             Error - The argument to next_azimuth() must be a subclass of
2121 0         0 @{[__PACKAGE__]}.
2122             EOD
2123              
2124 0         0 my $want = shift;
2125 0 0       0 defined $want and $want = $want ? 1 : 0;
    0          
2126              
2127 0         0 my $denom = $body->mean_angular_velocity -
2128             $self->mean_angular_velocity;
2129             ## my $retro = $denom >= 0 ? 0 : 1;
2130 0 0       0 ($denom = abs ($denom)) < 1e-11 and croak <
2131             Error - The next_azimuth() method will not work for geosynchronous
2132             bodies.
2133             eod
2134              
2135 0         0 my $apparent = TWOPI / $denom;
2136 0         0 my $begin = $self->universal;
2137 0         0 my $delta = floor( $apparent / 8 );
2138 0         0 my $end = $begin + $delta;
2139              
2140 0         0 my $begin_angle = mod2pi(
2141             ( $self->azel( $body->universal( $begin ) ) )[0] - $azimuth );
2142 0         0 my $end_angle = mod2pi(
2143             ( $self->azel( $body->universal( $end ) ) )[0] - $azimuth );
2144 0   0     0 while ( $begin_angle < PI || $end_angle >= PI ) {
2145 0         0 $begin_angle = $end_angle;
2146 0         0 $begin = $end;
2147 0         0 $end = $end + $delta;
2148 0         0 $end_angle = mod2pi(
2149             ( $self->azel( $body->universal( $end ) ) )[0] - $azimuth );
2150             }
2151              
2152 0         0 while ($end - $begin > 1) {
2153 0         0 my $mid = floor (($begin + $end) / 2);
2154 0         0 my $mid_angle = mod2pi(
2155             ( $self->azel( $body->universal( $mid ) ) )[0] - $azimuth );
2156 0 0       0 ( $begin, $end ) = ( $mid_angle >= PI ) ?
2157             ( $mid, $end ) : ( $begin, $mid );
2158             }
2159              
2160 0         0 $body->universal ($end);
2161 0         0 $self->universal ($end);
2162 0         0 return $end;
2163             }
2164              
2165             =item ($time, $rise) = $coord->next_elevation ($body, $elev, $upper)
2166              
2167             This method calculates the next time the given body passes above or
2168             below the given elevation (in radians) as seen from C<$coord>. The
2169             C<$elev> argument may be omitted (or passed as undef), and will default
2170             to 0. If the C<$upper> argument is true, the calculation will be based
2171             on the upper limb of the body (as determined from its C
2172             attribute); if false, the calculation will be based on the center of the
2173             body. The C<$upper> argument defaults to true if the C<$elev> argument
2174             is zero or positive, and false if the C<$elev> argument is negative.
2175              
2176             In list context, it returns the time, and an indicator which is true if
2177             the body passes above the given elevation at that time, and false if it
2178             passes below the given elevation. In scalar context it just returns the
2179             time.
2180              
2181             The algorithm is successive approximation, and assumes that the
2182             body will be at its highest at meridian passage. It also assumes
2183             that if the body hasn't passed the given elevation in 183 days it
2184             never will. In this case it returns undef in scalar context, or
2185             an empty list in list context.
2186              
2187             =item ($time, $rise) = $coord->next_elevation( $elev, $upper );
2188              
2189             This method calculates the next time the C<$coord> object passes above
2190             or below the given elevation (in radians) as seen from the position
2191             found in the C<$coord> object's C attribute. The C<$elev>
2192             argument may be omitted (or passed as undef), and will default to 0. If
2193             the C<$upper> argument is true, the calculation will be based on the
2194             upper limb of the body (as determined from its C
2195             attribute); if false, the calculation will be based on the center of the
2196             body. The C<$upper> argument defaults to true if the C<$elev> argument
2197             is zero or positive, and false if the C<$elev> argument is negative.
2198              
2199             In list context, it returns the time, and an indicator which is true if
2200             the body passes above the given elevation at that time, and false if it
2201             passes below the given elevation. In scalar context it just returns the
2202             time.
2203              
2204             The algorithm is successive approximation, and assumes that the
2205             body will be at its highest at meridian passage. It also assumes
2206             that if the body hasn't passed the given elevation in 183 days it
2207             never will. In this case it returns undef in scalar context, or
2208             an empty list in list context.
2209              
2210             =cut
2211              
2212 17     17   201 use constant NEVER_PASS_ELEV => 183 * SECSPERDAY;
  17         37  
  17         22809  
2213              
2214             sub next_elevation {
2215 1633     1633 1 14493 my ( $self, $body, $angle, $upper ) = _expand_args_default_station( @_ );
2216 1633 50       5182 ref $self or croak <<'EOD';
2217             Error - The next_elevation() method may not be called as a class method.
2218             EOD
2219              
2220 1633 50       5232 $body->represents(__PACKAGE__) or croak <<"EOD";
2221             Error - The first argument to next_elevation() must be a subclass of
2222 0         0 @{[__PACKAGE__]}.
2223             EOD
2224              
2225 1633   100     8263 $angle ||= 0;
2226 1633 100       4033 defined $upper or $upper = $angle >= 0;
2227 1633 100       3917 $upper = $upper ? 1 : 0;
2228              
2229 1633         4172 my $begin = $self->universal;
2230 1633         3059 my $original = $begin;
2231 1633         4546 my ( undef, $elev ) = $self->azel_offset(
2232             $body->universal( $begin ), $upper );
2233 1633   100     7049 my $rise = ( $elev < $angle ) || 0;
2234              
2235 1633         7143 my ($end, $above) = $self->next_meridian ($body, $rise);
2236              
2237 1633         8345 my $give_up = $body->NEVER_PASS_ELEV ();
2238              
2239 1633         3069 while ( 1 ) {
2240 1635         6656 my ( undef, $elev ) = $self->azel_offset( $body, $upper );
2241 1635 100 100     9846 ( ( $elev < $angle ) || 0 ) == $rise
2242             or last;
2243 3 100       18 return if $end - $original > $give_up;
2244 2         5 $begin = $end;
2245 2         8 ($end, $above) = $self->next_meridian ($body, $rise);
2246             }
2247              
2248 1632         5374 while ($end - $begin > 1) {
2249 25931         75372 my $mid = floor (($begin + $end) / 2);
2250 25931         75185 my ( undef, $elev ) = $self->universal( $mid )->
2251             azel_offset( $body->universal( $mid ), $upper );
2252 25931 100 100     142357 ( $begin, $end ) =
2253             ($elev < $angle || 0) == $rise ? ($mid, $end) : ($begin, $mid);
2254             }
2255              
2256 1632         6749 $self->universal ($end); # Ensure consistent time.
2257 1632         5719 $body->universal ($end);
2258 1632 100       10799 return wantarray ? ($end, $rise) : $end;
2259             }
2260              
2261             =item ( $time, $type ) = $coord->next_elevation_extreme_tod( $body, $elev, $ipper );
2262              
2263             B
2264              
2265             This variation on C returns the earliest (or latest)
2266             time the given body passes above (or below) the given elevation (in
2267             radians) as seen from the given coordinates. If called in list context
2268             it returns the time of the event and the type of the event, encoded as
2269             follows:
2270              
2271             0 - earliest pass below the given elevation
2272             1 - earliest pass above the given elevation
2273             2 - latest pass below the given elevation
2274             3 - latest pass above the given elevation
2275              
2276             If called in scalar context this method just returns the time.
2277              
2278             If no extreme can be computed, this method returns nothing. It will
2279             always return nothing unless otherwise documented for the class of the
2280             C<$body> object.
2281              
2282             The motivation for this method was a desire to compute the earliest and
2283             latest sunrise and sunset at a given location. It appears here in the
2284             object hierarchy out of a perhaps-foolish desire to be consistent with
2285             C.
2286              
2287             Use this method with caution. I have serious doubts about what will
2288             happen when the invocant is north of the Arctic Circle or south of the
2289             Antarctic Circle, and I am a little unsure of its behaviour near the
2290             Equator. In addition, in an early implementation consecutive calls
2291             returned the same extreme over and over. I believe this to be fixed, but
2292             the fix raises the possibility of skipped extrema. B
2293              
2294             =item ( $time, $type ) = $body->next_elevation_extreme_tod( $elev, $ipper );
2295              
2296             This way to call C is equivalent to the
2297             above, but uses the body's C attribute for the C<$coord>
2298             object.
2299              
2300             =cut
2301              
2302             sub next_elevation_extreme_tod {
2303 8     8 1 12790 my ( $self, $body, $angle, $upper ) = _expand_args_default_station( @_ );
2304              
2305 8 50       25 ref $self or croak <<'EOD';
2306             Error - The next_elevation_extreme_tod() method may not be called as a
2307             class method.
2308             EOD
2309              
2310 8 50       53 $body->represents(__PACKAGE__) or croak <<"EOD";
2311             Error - The first argument to next_elevation_extreme_tod() must be a
2312 0         0 subclass of @{[__PACKAGE__]}.
2313             EOD
2314              
2315 8         41 return $body->__next_elevation_extreme_tod( $self, $angle, $upper );
2316             }
2317              
2318             sub __next_elevation_extreme_tod {
2319 0     0   0 return;
2320             }
2321              
2322             =item ( $time, $above ) = $coord->next_meridian( $body, $want )
2323              
2324             This method calculates the next meridian passage of the given C<$body>
2325             over (or under) the location specified by the C<$coord> object. The
2326             C<$body> object must be a subclass of Astro::Coord::ECI.
2327              
2328             The optional C<$want> argument should be specified as true (e.g. 1) if
2329             you want the next passage above the observer, or as false (e.g. 0) if
2330             you want the next passage below the observer. If this argument is
2331             omitted or undefined, you get whichever passage is next.
2332              
2333             The start time of the search is the current time setting of the
2334             C<$coord> object.
2335              
2336             The returns are the time of the meridian passage, and an indicator which
2337             is true if the passage is above the observer (i.e. local noon if the
2338             C<$body> represents the Sun), or false if below (i.e. local midnight if
2339             the C<$body> represents the Sun). If called in scalar context, you get
2340             the time only.
2341              
2342             The current time of both C<$coord> and C<$body> objects are left at the
2343             returned time.
2344              
2345             The algorithm is by successive approximation. It will croak if the
2346             period of the C<$body> is close to synchronous, and will probably not
2347             work well for bodies in highly eccentric orbits. The calculation is to
2348             the nearest second, and the time returned is the first even second after
2349             the body crosses the meridian.
2350              
2351             =item ( $time, $above ) = $coord->next_meridian( $want )
2352              
2353             This method calculates the next meridian passage of the C<$coord> object
2354             over (or under) the location specified by the C<$coord> object's
2355             C attribute.
2356              
2357             The optional C<$want> argument should be specified as true (e.g. 1) if
2358             you want the next passage above the observer, or as false (e.g. 0) if
2359             you want the next passage below the observer. If this argument is
2360             omitted or undefined, you get whichever passage is next.
2361              
2362             The start time of the search is the current time setting of the
2363             C<$coord> object.
2364              
2365             The returns are the time of the meridian passage, and an indicator which
2366             is true if the passage is above the observer (i.e. local noon if the
2367             C<$coord> object represents the Sun), or false if below (i.e. local
2368             midnight if the C<$coord> object represents the Sun). If called in
2369             scalar context, you get the time only.
2370              
2371             The current time of both C<$coord> and its C are left at the
2372             returned time.
2373              
2374             The algorithm is by successive approximation. It will croak if the
2375             period of the C<$body> is close to synchronous, and will probably not
2376             work well for bodies in highly eccentric orbits. The calculation is to
2377             the nearest second, and the time returned is the first even second after
2378             the body crosses the meridian.
2379              
2380             =cut
2381              
2382             sub next_meridian {
2383 1664     1664 1 13204 my ( $self, $body, $want ) = _expand_args_default_station( @_ );
2384 1664 50       5011 ref $self or croak <<'EOD';
2385             Error - The next_meridian() method may not be called as a class method.
2386             EOD
2387              
2388 1664 50       4583 $body->represents(__PACKAGE__) or croak <<"EOD";
2389             Error - The argument to next_meridian() must be a subclass of
2390 0         0 @{[__PACKAGE__]}.
2391             EOD
2392              
2393 1664 100       7254 defined $want and $want = $want ? 1 : 0;
    100          
2394              
2395 1664         6488 my $denom = $body->mean_angular_velocity -
2396             $self->mean_angular_velocity;
2397 1664 50       5725 my $retro = $denom >= 0 ? 0 : 1;
2398 1664 50       4806 ($denom = abs ($denom)) < 1e-11 and croak <<'EOD';
2399             Error - The next_meridian() method will not work for geosynchronous
2400             bodies.
2401             EOD
2402              
2403 1664         3714 my $apparent = TWOPI / $denom;
2404 1664         5699 my $begin = $self->universal;
2405 1664         7434 my $delta = floor ($apparent / 16);
2406 1664         3674 my $end = $begin + $delta;
2407              
2408 1664 100       5951 my ($above, $opposite) =
2409             mod2pi (($body->universal($begin)->geocentric)[1]
2410             - ($self->universal($begin)->geocentric)[1]) >= PI ?
2411             (1 - $retro, PI) : ($retro, 0);
2412              
2413 1664         6378 ($begin, $end) = ($end, $end + $delta)
2414             while mod2pi (($body->universal($end)->geocentric)[1] -
2415             ($self->universal($end)->geocentric)[1] + $opposite) < PI;
2416              
2417 1664 100 100     8719 if (defined $want && $want != $above) {
2418 1498         3891 $above = $want;
2419 1498 100       4050 $opposite = $opposite ? 0 : PI;
2420 1498         6181 ($begin, $end) = ($end, $end + $delta)
2421             while mod2pi (($body->universal($end)->geocentric)[1] -
2422             ($self->universal($end)->geocentric)[1] + $opposite) < PI;
2423             }
2424              
2425 1664         6500 while ($end - $begin > 1) {
2426 20762         61726 my $mid = floor (($begin + $end) / 2);
2427 20762         50932 my $long = ($body->universal($mid)->geocentric)[1];
2428 20762         67942 my $merid = ($self->universal($mid)->geocentric)[1];
2429 20762 100       74608 ($begin, $end) =
2430             mod2pi ($long - $merid + $opposite) < PI ?
2431             ($mid, $end) : ($begin, $mid);
2432             }
2433              
2434 1664         5975 $body->universal ($end);
2435 1664         5287 $self->universal ($end);
2436 1664 100       9330 return wantarray ? ($end, $above) : $end;
2437             }
2438              
2439             =item ( $delta_psi, $delta_epsilon ) = $self->nutation( $time )
2440              
2441             This method calculates the nutation in longitude (delta psi) and
2442             obliquity (delta epsilon) for the given B time. If the time
2443             is unspecified or specified as C, the current B time
2444             of the object is used.
2445              
2446             The algorithm comes from Jean Meeus' "Astronomical Algorithms", 2nd
2447             Edition, Chapter 22, pages 143ff. Meeus states that it is good to
2448             0.5 seconds of arc.
2449              
2450             =cut
2451              
2452             sub nutation {
2453 75310     75310 1 145096 my ( $self, $time ) = @_;
2454 75310 100       160131 defined $time
2455             or $time = $self->dynamical();
2456              
2457 75310         143084 my $T = jcent2000( $time ); # Meeus (22.1)
2458              
2459 75310         218100 my $omega = mod2pi( deg2rad( ( ( $T / 450000 + .0020708 ) * $T -
2460             1934.136261 ) * $T + 125.04452 ) );
2461              
2462 75310         203362 my $L = mod2pi( deg2rad( 36000.7698 * $T + 280.4665 ) );
2463 75310         171387 my $Lprime = mod2pi( deg2rad( 481267.8813 * $T + 218.3165 ) );
2464              
2465 75310         272878 my $delta_psi = deg2rad( ( -17.20 * sin( $omega )
2466             - 1.32 * sin( 2 * $L )
2467             - 0.23 * sin( 2 * $Lprime )
2468             + 0.21 * sin( 2 * $omega ) ) / 3600 );
2469 75310         244037 my $delta_epsilon = deg2rad( ( 9.20 * cos( $omega )
2470             + 0.57 * cos( 2 * $L )
2471             + 0.10 * cos( 2 * $Lprime )
2472             - 0.09 * cos( 2 * $omega ) ) / 3600 );
2473              
2474 75310         195752 return ( $delta_psi, $delta_epsilon );
2475             }
2476              
2477             =item $epsilon = $self->obliquity( $time )
2478              
2479             This method calculates the obliquity of the ecliptic in radians at the
2480             given B time. If the time is unspecified or specified as
2481             C, the current B time of the object is used.
2482              
2483             The algorithm comes from Jean Meeus' "Astronomical Algorithms", 2nd
2484             Edition, Chapter 22, pages 143ff. The conversion from universal to
2485             dynamical time comes from chapter 10, equation 10.2 on page 78.
2486              
2487             =cut
2488              
2489 17     17   155 use constant E0BASE => (21.446 / 60 + 26) / 60 + 23;
  17         42  
  17         22264  
2490              
2491             sub obliquity {
2492 73175     73175 1 143241 my ( $self, $time ) = @_;
2493              
2494 73175 50       268493 if ( looks_like_number( $self ) ) {
2495 0         0 ( $self, $time ) = ( __PACKAGE__, $self );
2496             }
2497 73175 100       226121 defined $time
2498             or $time = $self->dynamical();
2499              
2500 73175         199749 my $T = jcent2000 ($time); # Meeus (22.1)
2501              
2502 73175         184761 my ( undef, $delta_epsilon ) = $self->nutation( $time );
2503              
2504 73175         201962 my $epsilon0 = deg2rad( ( ( 0.001813 * $T - 0.00059 ) * $T - 46.8150 )
2505             * $T / 3600 + E0BASE);
2506 73175         144524 return $epsilon0 + $delta_epsilon;
2507             }
2508              
2509             =item $coord = $coord->precess ($time);
2510              
2511             This method is a convenience wrapper for precess_dynamical(). The
2512             functionality is the same except that B
2513             universal time.>
2514              
2515             =cut
2516              
2517             sub precess {
2518 2 50   2 1 21 $_[1]
2519             and $_[1] += dynamical_delta( $_[1] );
2520 2         5 goto &precess_dynamical;
2521             }
2522              
2523             =item $coord = $coord->precess_dynamical ($time);
2524              
2525             This method precesses the coordinates of the object to the given
2526             equinox, B The starting equinox is the
2527             value of the 'equinox_dynamical' attribute, or the current time setting
2528             if the 'equinox_dynamical' attribute is any false value (i.e. undef, 0,
2529             or ''). A warning will be issued if the value of 'equinox_dynamical' is
2530             undef (which is the default setting) and the object represents inertial
2531             coordinates. As of version 0.013_02, B
2532             unaffected by this operation.>
2533              
2534             As a side effect, the value of the 'equinox_dynamical' attribute will be
2535             set to the dynamical time corresponding to the argument.
2536              
2537             As of version 0.061_01, this does nothing to non-inertial
2538             objects -- that is, those whose position was set in Earth-fixed
2539             coordinates.
2540              
2541             If the object's 'station' attribute is set, the station is also
2542             precessed.
2543              
2544             The object itself is returned.
2545              
2546             The algorithm comes from Jean Meeus, "Astronomical Algorithms", 2nd
2547             Edition, Chapter 21, pages 134ff (a.k.a. "the rigorous method").
2548              
2549             =cut
2550              
2551             sub precess_dynamical {
2552 1461     1461 1 3074 my ( $self, $end ) = @_;
2553              
2554 1461 50       3149 $end
2555             or croak "No equinox time specified";
2556              
2557             # Non-inertial coordinate systems are not referred to the equinox,
2558             # and so do not get precessed.
2559 1461 50       3497 $self->get( 'inertial' )
2560             or return $self;
2561              
2562 1461 50       2917 defined ( my $start = $self->get( 'equinox_dynamical' ) )
2563             or carp "Warning - Precess called with equinox_dynamical ",
2564             "attribute undefined";
2565 1461   33     3178 $start ||= $self->dynamical ();
2566              
2567 1461         2461 my $sta;
2568 1461 100 100     2601 if ( $sta = $self->get( 'station' ) and $sta->get( 'inertial' )
2569             ) {
2570 1 50       4 $sta->get( 'station' )
2571             and croak NO_CASCADING_STATIONS;
2572 1         3 $sta->universal( $self->universal() );
2573 1         20 $sta->precess_dynamical( $end );
2574             }
2575              
2576 1461 100       3458 $start == $end
2577             and return $self;
2578              
2579 1457         4089 my ($alpha0, $delta0, $rho0) = $self->equatorial ();
2580              
2581 1457         3742 my $T = jcent2000($start);
2582 1457         2622 my $t = ($end - $start) / (36525 * SECSPERDAY);
2583              
2584             # The following four assignments correspond to Meeus' (21.2).
2585 1457         2581 my $zterm = (- 0.000139 * $T + 1.39656) * $T + 2306.2181;
2586 1457         12021 my $zeta = deg2rad((((0.017998 * $t + (- 0.000344 * $T + 0.30188)) *
2587             $t + $zterm) * $t) / 3600);
2588 1457         3579 my $z = deg2rad((((0.018203 * $t + (0.000066 * $T + 1.09468)) * $t +
2589             $zterm) * $t) / 3600);
2590 1457         3995 my $theta = deg2rad(((( - 0.041833 * $t - (0.000217 * $T + 0.42665))
2591             * $t + (- 0.000217 * $T - 0.85330) * $T + 2004.3109) * $t) /
2592             3600);
2593              
2594             # The following assignments correspond to Meeus' (21.4).
2595 1457         2548 my $sindelta0 = sin ($delta0);
2596 1457         2308 my $cosdelta0 = cos ($delta0);
2597 1457         2178 my $sintheta = sin ($theta);
2598 1457         2183 my $costheta = cos ($theta);
2599 1457         2761 my $cosdelta0cosalpha0 = cos ($alpha0 + $zeta) * $cosdelta0;
2600 1457         2584 my $A = $cosdelta0 * sin ($alpha0 + $zeta);
2601 1457         2583 my $B = $costheta * $cosdelta0cosalpha0 - $sintheta * $sindelta0;
2602 1457         2529 my $C = $sintheta * $cosdelta0cosalpha0 + $costheta * $sindelta0;
2603              
2604 1457         3498 my $alpha = mod2pi(atan2 ($A , $B) + $z);
2605 1457         2797 my $delta = asin($C);
2606              
2607 1457         4357 $self->equatorial ($alpha, $delta, $rho0);
2608 1457         4968 $self->set (equinox_dynamical => $end);
2609              
2610 1457         4192 return $self;
2611             }
2612              
2613             =item Astro::Coord::ECI->reference_ellipsoid($semi, $flat, $name);
2614              
2615             This class method can be used to define or redefine reference
2616             ellipsoids.
2617              
2618             Nothing bad will happen if you call this as an object method, but
2619             it still just creates a reference ellipsoid definition -- the object
2620             is unaffected.
2621              
2622             It is not an error to redefine an existing ellipsoid.
2623              
2624             =item ($semi, $flat, $name) = Astro::Coord::ECI->reference_ellipsoid($name)
2625              
2626             This class method returns the definition of the named reference
2627             ellipsoid. It croaks if there is no such ellipsoid.
2628              
2629             You can also call this as an object method, but the functionality is
2630             the same.
2631              
2632             The following reference ellipsoids are known to the class initially:
2633              
2634             CLARKE-1866 - 1866.
2635             semimajor => 6378.2064 km, flattening => 1/294.98.
2636             Source: http://www.colorado.edu/geography/gcraft/notes/datum/elist.html
2637              
2638             GRS67 - Geodetic Reference System 1967.
2639             semimajor => 6378.160 km, flattening => 1/298.247.
2640             Source: http://www.colorado.edu/geography/gcraft/notes/datum/elist.html
2641              
2642             GRS80 - Geodetic Reference System 1980.
2643             semimajor => 6378.137 km, flattening => 1/298.25722210088
2644             (flattening per U.S. Department of Commerce 1989).
2645             Source: http://biology.usgs.gov/fgdc.metadata/version2/spref/horiz/geodet/faq.htm
2646              
2647             IAU68 - International Astronomical Union, 1968.
2648             semimajor => 6378.160 km, flattening => 1/298.25.
2649             Source: http://maic.jmu.edu/sic/standards/ellipsoid.htm
2650              
2651             IAU76 - International Astronomical Union, 1976.
2652             semimajor => 6378.14 km, flattening => 1 / 298.257.
2653             Source: Jean Meeus, "Astronomical Algorithms", 2nd Edition
2654              
2655             NAD83 - North American Datum, 1983.
2656             semimajor => 6378.137 km, flattening => 1/298.257.
2657             Source: http://biology.usgs.gov/fgdc.metadata/version2/spref/horiz/geodet/faq.htm
2658             (NAD83 uses the GRS80 ellipsoid)
2659              
2660             sphere - Just in case you were wondering how much difference it
2661             makes (a max of 11 minutes 32.73 seconds of arc, per Jean
2662             Meeus).
2663             semimajor => 6378.137 km (from GRS80), flattening => 0.
2664              
2665             WGS72 - World Geodetic System 1972.
2666             semimajor => 6378.135 km, flattening=> 1/298.26.
2667             Source: http://biology.usgs.gov/fgdc.metadata/version2/spref/horiz/geodet/faq.htm
2668              
2669             WGS84 - World Geodetic System 1984.
2670             semimajor => 6378.137 km, flattening => 1/1/298.257223563.
2671             Source: http://www.colorado.edu/geography/gcraft/notes/datum/elist.html
2672              
2673             Reference ellipsoid names are case-sensitive.
2674              
2675             The default model is WGS84.
2676              
2677             =cut
2678              
2679             # Wish I had:
2680             # Maling, D.H., 1989, Measurements from Maps: Principles and methods of cartometry, Pergamon Press, Oxford, England.
2681             # Maling, D.H., 1993, Coordinate Systems and Map Projections, Pergamon Press, Oxford, England.
2682              
2683             # http://www.gsi.go.jp/PCGIAP/95wg/wg3/geodinf.htm has a partial list of who uses
2684             # what in the Asia/Pacific.
2685              
2686             %known_ellipsoid = ( # Reference Ellipsoids
2687             'CLARKE-1866' => { # http://www.colorado.edu/geography/gcraft/notes/datum/elist.html
2688             semimajor => 6378.2064,
2689             flattening => 1/294.9786982,
2690             },
2691             GRS67 => { # http://www.colorado.edu/geography/gcraft/notes/datum/elist.html
2692             semimajor => 6378.160,
2693             flattening => 1/298.247167427,
2694             },
2695             GRS80 => { # http://biology.usgs.gov/fgdc.metadata/version2/spref/horiz/geodet/faq.htm
2696             semimajor => 6378.137, # km
2697             flattening => 1/298.25722210088, # U.S. Dept of Commerce 1989 (else 1/298.26)
2698             },
2699             IAU68 => { # http://maic.jmu.edu/sic/standards/ellipsoid.htm
2700             semimajor => 6378.160,
2701             flattening => 1/298.25,
2702             },
2703             IAU76 => { # Meeus, p. 82.
2704             semimajor => 6378.14,
2705             flattening => 1/298.257,
2706             },
2707             NAD83 => { # http://biology.usgs.gov/fgdc.metadata/version2/spref/horiz/geodet/faq.htm
2708             semimajor => 6378.137, # km
2709             flattening => 1/298.257,
2710             },
2711             sphere => { # Defined by me for grins, with semimajor from GRS80.
2712             semimajor => 6378.137, # km, from GRS80
2713             flattening => 0, # It's a sphere!
2714             },
2715             WGS72 => { # http://biology.usgs.gov/fgdc.metadata/version2/spref/horiz/geodet/faq.htm
2716             semimajor => 6378.135, # km
2717             flattening => 1/298.26,
2718             },
2719             WGS84 => { # http://www.colorado.edu/geography/gcraft/notes/datum/elist.html
2720             semimajor => 6378.137,
2721             flattening => 1/298.257223563,
2722             },
2723             );
2724             foreach my $name (keys %known_ellipsoid) {
2725             $known_ellipsoid{$name}{name} = $name;
2726             }
2727              
2728             sub reference_ellipsoid {
2729 0     0 1 0 my ( undef, @args ) = @_; # Invocant unused
2730 0 0       0 my $name = pop @args or croak <
2731             Error - You must specify the name of a reference ellipsoid.
2732             eod
2733 0 0       0 if (@args == 0) {
    0          
2734 0 0       0 $known_ellipsoid{$name} or croak <
2735             Error - Reference ellipsoid $name is unknown to this software. Known
2736             ellipsoids are:
2737 0         0 @{[join ', ', sort keys %known_ellipsoid]}.
2738             eod
2739             } elsif (@args == 2) {
2740 0         0 $known_ellipsoid{$name} = {
2741             semimajor => $args[0],
2742             flattening => $args[1],
2743             name => $name,
2744             };
2745             } else {
2746 0         0 croak <
2747             Error - You must call the reference_ellipsoid class method with either one
2748             argument (to fetch the definition of a known ellipsoid) or three
2749             arguments (to define a new ellipsoid or redefine an old one).
2750             eod
2751             }
2752 0         0 return @{$known_ellipsoid{$name}}{qw{semimajor flattening name}}
  0         0  
2753             }
2754              
2755             =item $coord->represents ($class);
2756              
2757             This method returns true if the $coord object represents the given class.
2758             It is pretty much like isa (), but if called on a container class (i.e.
2759             Astro::Coord::ECI::TLE::Set), it returns true based on the class of
2760             the members of the set, and dies if the set has no members.
2761              
2762             The $class argument is optional. If not specified (or undef), it is
2763             pretty much like ref $coord || $coord (i.e. it returns the class
2764             name), but with the delegation behavior described in the previous
2765             paragraph if the $coord object is a container.
2766              
2767             There. This took many more words to explain than it did to implement.
2768              
2769             =cut
2770              
2771             sub represents {
2772 146280 100 66 146280 1 527234 return defined ($_[1]) ?
    100          
2773             ## $_[0]->represents()->isa($_[1]) :
2774             __classisa($_[0]->represents(), $_[1]) ? 1 : 0 :
2775             (ref $_[0] || $_[0]);
2776             }
2777              
2778             =item $coord->set (name => value ...);
2779              
2780             This method sets various attributes of the object. If called as a class
2781             method, it changes the defaults.
2782              
2783             For reasons that seemed good at the time, this method returns the
2784             object it was called on (i.e. $coord in the above example).
2785              
2786             See L for a list of the attributes you can set.
2787              
2788             =cut
2789              
2790 17     17   180 use constant SET_ACTION_NONE => 0; # Do nothing.
  17         45  
  17         1354  
2791 17     17   112 use constant SET_ACTION_RESET => 1; # Reset the coordinates based on the initial setting.
  17         36  
  17         17236  
2792              
2793             sub set {
2794 1980     1980 1 294482 my ($self, @args) = @_;
2795 1980         3375 my $original = $self;
2796 1980 100       4607 ref $self
2797             or $self = \%static;
2798 1980 50       4135 @args % 2
2799             and croak 'Error - The set() method requires an even ',
2800             'number of arguments.';
2801 1980         2967 my $action = 0;
2802 1980         4248 while (@args) {
2803 2013         3629 my $name = shift @args;
2804 2013 50       5173 exists $mutator{$name}
2805             or croak "Error - Attribute '$name' does not exist.";
2806 2013 50       5511 CODE_REF eq ref $mutator{$name}
2807             or croak "Error - Attribute '$name' is read-only";
2808 2013         5040 $action |= $mutator{$name}->($self, $name, shift @args);
2809             }
2810              
2811             $self->{_need_purge} = 1
2812 1979 100 66     10005 if ref $self && $self->{specified} && $action & SET_ACTION_RESET;
      100        
2813              
2814 1979         3626 return $original;
2815             }
2816              
2817             # The following are the mutators for the attributes. All are
2818             # passed three arguments: a reference to the hash to be set,
2819             # the hash key to be set, and the value. They must return the
2820             # bitwise 'or' of the desired action masks, defined above.
2821              
2822             %mutator = (
2823             almanac_horizon => \&_set_almanac_horizon,
2824             angularvelocity => \&_set_value,
2825             debug => \&_set_value,
2826             diameter => \&_set_value,
2827             edge_of_earths_shadow => \&_set_value,
2828             ellipsoid => \&_set_reference_ellipsoid,
2829             equinox_dynamical => \&_set_value, # CAVEAT: _convert_eci_to_ecef
2830             # accesses this directly for
2831             # speed.
2832             flattening => \&_set_custom_ellipsoid,
2833             frequency => \&_set_value,
2834             horizon => \&_set_elevation,
2835             id => \&_set_id,
2836             inertial => undef,
2837             name => \&_set_value,
2838             refraction => \&_set_value,
2839             specified => undef,
2840             semimajor => \&_set_custom_ellipsoid,
2841             station => \&_set_station,
2842             sun => \&_set_sun,
2843             twilight => \&_set_elevation,
2844             );
2845              
2846             {
2847             # TODO this will all be nicer if I had state variables.
2848              
2849             my %special = (
2850             ## horizon => sub { return $_[0]->get( 'horizon' ); },
2851             height => sub { return $_[0]->dip(); },
2852             );
2853              
2854             sub _set_almanac_horizon {
2855 182     182   388 my ( $hash, $attr, $value ) = @_;
2856 182 50       394 defined $value
2857             or $value = 0; # Default
2858 182 50 33     1536 if ( $special{$value} ) {
    50 33        
2859 0         0 $hash->{"_$attr"} = $special{$value};
2860             } elsif ( looks_like_number( $value )
2861             && $value >= - PIOVER2 # Not -PIOVER2 to avoid warning under 5.10.1.
2862             && $value <= PIOVER2
2863             ) {
2864 182     7   1374 $hash->{"_$attr"} = sub { return $_[0]->get( $attr ) };
  7         22  
2865             } else {
2866 0         0 croak "'$value' is an invalid value for '$attr'";
2867             }
2868 182         470 $hash->{$attr} = $value;
2869 182         522 return SET_ACTION_NONE;
2870             }
2871             }
2872              
2873             # Get the actual value of the almanac horizon, from whatever
2874             # source.
2875              
2876             sub __get_almanac_horizon {
2877 7     7   44 goto $_[0]{_almanac_horizon};
2878             }
2879              
2880             # If you set semimajor or flattening, the ellipsoid name becomes
2881             # undefined. Also clear any cached geodetic coordinates.
2882              
2883             sub _set_custom_ellipsoid {
2884 0     0   0 $_[0]->{ellipsoid} = undef;
2885 0         0 $_[0]->{$_[1]} = $_[2];
2886 0         0 return SET_ACTION_RESET;
2887             }
2888              
2889             {
2890             my %dflt = (
2891             twilight => CIVIL_TWILIGHT,
2892             );
2893              
2894             # Any attribute specified as angle above or below the horizon.
2895             sub _set_elevation {
2896 1     1   4 my ( $self, $name, $value ) = @_;
2897             defined $value
2898 1 50 0     4 or $value = ( $dflt{$name} || 0 ); # Default
2899 1 50 33     329 looks_like_number( $value )
      33        
2900             and $value >= - PIOVER2 # Not -PIOVER2 to avoid warning under 5.10.1.
2901             and $value <= PIOVER2
2902             or croak "'$value' is an invalid value for '$name'";
2903 0         0 $self->{$name} = $value;
2904 0         0 return SET_ACTION_NONE;
2905             }
2906             }
2907              
2908             sub _set_station {
2909 13     13   58 my ( $hash, $attr, $value ) = @_;
2910 13 50       47 if ( defined $value ) {
2911 13 50       47 embodies( $value, 'Astro::Coord::ECI' )
2912             or croak "Attribute $attr must be undef or an ",
2913             'Astro::Coord::ECI object';
2914 13 50       48 $value->get( 'station' )
2915             and croak NO_CASCADING_STATIONS;
2916             }
2917 13         46 $hash->{$attr} = $value;
2918 13         52 return SET_ACTION_RESET;
2919             }
2920              
2921 17     17   146 use constant SUN_CLASS => 'Astro::Coord::ECI::Sun';
  17         39  
  17         64942  
2922              
2923             sub _set_sun {
2924 2     2   7 my ( $self, $name, $value ) = @_;
2925 2 50       20 embodies( $value, $self->SUN_CLASS() )
2926             or croak sprintf 'The sun attribute must be a %s',
2927             $self->SUN_CLASS();
2928 2 50       17 ref $value
2929             or $value = $value->new();
2930 2         7 $self->{$name} = $value;
2931 2         11 return SET_ACTION_NONE;
2932             }
2933              
2934             # Unfortunately, the TLE subclass may need objects reblessed if
2935             # the ID changes. So much for factoring. Sigh.
2936              
2937             sub _set_id {
2938 144     144   366 $_[0]{$_[1]} = $_[2];
2939 144 100       878 $_[0]->rebless () if $_[0]->can ('rebless');
2940 144         450 return SET_ACTION_NONE;
2941             }
2942              
2943             # If this is a reference ellipsoid name, check it, and if it's
2944             # OK set semimajor and flattening also. Also clear any cached
2945             # geodetic coordinates.
2946              
2947             sub _set_reference_ellipsoid {
2948 31     31   109 my ($self, $name, $value) = @_;
2949 31 50       103 defined $value or croak <
2950             Error - Can not set reference ellipsoid to undefined.
2951             eod
2952 31 50       94 exists $known_ellipsoid{$value} or croak <
2953             Error - Reference ellipsoid '$value' is unknown.
2954             eod
2955              
2956 31         73 $self->{semimajor} = $known_ellipsoid{$value}{semimajor};
2957 31         72 $self->{flattening} = $known_ellipsoid{$value}{flattening};
2958 31         85 $self->{$name} = $value;
2959 31         118 return SET_ACTION_RESET;
2960             }
2961              
2962             # If this is a vanilla setting, just do it.
2963              
2964             sub _set_value {
2965 1640     1640   3904 $_[0]->{$_[1]} = $_[2];
2966 1640         5329 return SET_ACTION_NONE;
2967             }
2968              
2969             =item $coord->universal ($time)
2970              
2971             This method sets the time represented by the object, in universal time
2972             (a.k.a. CUT, a.k.a. Zulu, a.k.a. Greenwich).
2973              
2974             This method can also be called as a class method, in which case it
2975             instantiates the desired object.
2976              
2977             =item $time = $coord->universal ();
2978              
2979             This method returns the universal time previously set.
2980              
2981             =cut
2982              
2983             sub universal {
2984 380383     380383 1 796428 my ( $self, $time, @args ) = @_;
2985              
2986             @args
2987 380383 50       810858 and croak <<'EOD';
2988             Error - The universal() method must be called with either zero
2989             arguments (to retrieve the time) or one argument (to set the
2990             time).
2991             EOD
2992              
2993 380383 100       711522 if ( defined $time ) {
2994 217456         497268 return $self->__universal( $time, 1 );
2995             } else {
2996 162927 50       333059 ref $self or croak <<'EOD';
2997             Error - The universal() method may not be called as a class method
2998             unless you specify arguments.
2999             EOD
3000             defined $self->{universal}
3001 162927 50       351890 or croak <<'EOD';
3002             Error - Object's time has not been set.
3003             EOD
3004 162927         558252 return $self->{universal};
3005             }
3006             }
3007              
3008             # Set universal time without running model
3009              
3010             sub __universal {
3011 236297     236297   478470 my ( $self, $time, $run_model ) = @_;
3012 236297 50       476683 defined $time
3013             or confess 'Programming error - __universal() requires a defined time';
3014 236297 100       469489 $self = $self->new () unless ref $self;
3015             defined $self->{universal}
3016             and $time == $self->{universal}
3017 236297 100 100     1038374 and return $self;
3018 175306         444404 $self->__clear_time();
3019 175306         361177 $self->{universal} = $time;
3020 175306 100       608133 $run_model
3021             and $self->_call_time_set();
3022 175292         568961 return $self;
3023             }
3024              
3025             sub __clear_time {
3026 175320     175320   309113 my ( $self ) = @_;
3027 175320         310426 delete $self->{universal};
3028 175320         274688 delete $self->{local_mean_time};
3029 175320         283374 delete $self->{dynamical};
3030 175320 100       397504 if ($self->{specified}) {
3031 175199 100       400039 if ($self->{inertial}) {
3032 90495         351361 delete $self->{_ECI_cache}{fixed};
3033             } else {
3034 84704         164187 delete $self->{_ECI_cache}{inertial};
3035             }
3036             }
3037 175320         316720 return;
3038             }
3039              
3040             sub __event_name {
3041 36     36   115 my ( $self, $event, $tplt ) = @_;
3042 36 50       133 ARRAY_REF eq ref $tplt
3043             or confess 'Programming error - $tplt must be array ref';
3044 36         144 return __sprintf( $tplt->[$event], $self->__object_name() );
3045             }
3046              
3047             sub __horizon_name {
3048 12     12   54 my ( $self, $event, $tplt ) = @_;
3049 12   33     79 return $self->__event_name(
3050             $event,
3051             $tplt || $self->__horizon_name_tplt(),
3052             );
3053             }
3054              
3055             sub __horizon_name_tplt {
3056 2     2   11 return [ '%s sets', '%s rises' ];
3057             }
3058              
3059             sub __horizon_extreme_tod_name {
3060 0     0   0 my ( $self, $event, $tplt ) = @_;
3061 0   0     0 return $self->__event_name(
3062             $event,
3063             $tplt || $self->__horizon_extreme_tod_name_tplt(),
3064             );
3065             }
3066              
3067             sub __horizon_extreme_tod_name_tplt {
3068             return [
3069 0     0   0 'earliest %sset', 'earliest %srise',
3070             'latest %sset', 'latest %srise',
3071             ];
3072             }
3073              
3074             sub __transit_name {
3075 14     14   49 my ( $self, $event, $tplt ) = @_;
3076 14   33     93 return $self->__event_name(
3077             $event,
3078             $tplt || $self->__transit_name_tplt(),
3079             );
3080             }
3081              
3082             sub __transit_name_tplt {
3083 10     10   68 return [ undef, '%s transits meridian' ];
3084             }
3085              
3086             sub __object_name {
3087 56     56   154 my ( $self ) = @_;
3088             return $self->get( 'name' ) || $self->get( 'id' ) || (
3089 56   33     232 $self->{_name} ||= $self->__object_name_from_class_name()
3090             );
3091             }
3092              
3093             sub __object_name_from_class_name {
3094 5     5   13 my ( $self ) = @_;
3095 5   33     42 ( my $name = ref $self || $self ) =~ s/ (?: :: | _ ) XS \z //smx;
3096 5         56 $name =~ s/ .* :: //smx;
3097 5         20 return $name;
3098             }
3099              
3100             sub __object_is_self_named {
3101 20     20   52 my ( $self ) = @_;
3102 20   66     97 $self->{_name_re} ||= do {
3103 5         45 my $re = $self->__object_name_from_class_name();
3104 5         138 qr< \A \Q$re\E \z >smxi;
3105             };
3106 20         163 return $self->__object_name() =~ $self->{_name_re};
3107             }
3108              
3109             #######################################################################
3110             #
3111             # Internal
3112             #
3113              
3114             # $coord->_call_time_set ()
3115              
3116             # This method calls the time_set method if it exists and if we are
3117             # not already in it. It is a way to avoid endless recursion if the
3118             # time_set method should happen to set the time.
3119              
3120             sub _call_time_set {
3121 174894     174894   286263 my $self = shift;
3122 174894 100       713232 $self->can ('time_set') or return;
3123 90150         147975 my $exception;
3124 90150 100       270976 unless ($self->{_no_set}++) {
3125 90030 100       168704 eval {$self->time_set (); 1;}
  90030         306267  
  90016         274793  
3126             or $exception = $@;
3127             }
3128 90150 100       256259 --$self->{_no_set} or delete $self->{_no_set};
3129 90150 100       185384 if ($exception) {
3130 14         38 $self->__clear_time();
3131             # Re-raise the exception now that we have cleaned up.
3132 14         48 die $exception; ## no critic (RequireCarping)
3133             }
3134 90136         156541 return;
3135             }
3136              
3137             # $coord->_check_coord (method => \@_)
3138              
3139             # This is designed to be called "up front" for any of the methods
3140             # that retrieve or set coordinates, to be sure the object is in
3141             # a consistent state.
3142             # * If $self is not a reference, it creates a new object if there
3143             # are arguments, or croaks if there are none.
3144             # * If the number arguments passed (after removing self and the
3145             # method name) is one more than a multiple of three, the last
3146             # argument is removed, and used to set the universal time of
3147             # the object.
3148             # * If there are arguments, all coordinate caches are cleared;
3149             # otherwise the coordinates are reset if needed.
3150             # The object itself is returned.
3151              
3152             sub _check_coord {
3153 624603     624603   1281820 my ($self, $method, $args, @extra) = @_;
3154              
3155 624603 100       1271701 unless (ref $self) {
3156 14 50       27 @$args or croak <
3157             Error - The $method() method may not be called as a class method
3158             unless you specify arguments.
3159             eod
3160 14         27 $self = $self->new ();
3161             }
3162              
3163 624603 50       1370437 $self->{debug} and do {
3164 0         0 require Data::Dumper;
3165 0         0 local $Data::Dumper::Terse = 1;
3166 0         0 print "Debug $method (", Data::Dumper::Dumper (@$args, @extra), ")\n";
3167             };
3168              
3169             {
3170 624603         865308 my $inx = 0;
  624603         940544  
3171 624603         1243591 foreach (@$args) {
3172 795071 50       1616700 defined $_
3173             and next;
3174 0         0 require Data::Dumper;
3175 0         0 local $Data::Dumper::Terse = 1;
3176 0 0       0 croak <
3177 0         0 Error - @{[ (caller (1))[3] ]} argument $inx is undefined.
3178             Arguments are (@{[ join ', ',
3179 0         0 map {my $x = Data::Dumper::Dumper $_; chomp $x; $x} @$args ]})
  0         0  
  0         0  
  0         0  
3180             eod
3181 0         0 $inx++;
3182             }
3183             }
3184              
3185 624603 100       1365163 $self->universal (pop @$args) if @$args % 3 == 1;
3186              
3187 624603 100       1352651 if ($self->{specified}) {
3188 621448 100       1462743 if (@$args) {
    100          
3189             # Cached coordinate deletion moved to ecef(), so it's only done once.
3190             } elsif ($self->{_need_purge}) {
3191 4         10 delete $self->{_need_purge};
3192 4         7 my $spec = $self->{specified};
3193 4         26 my $data = [$self->$spec ()];
3194 4         9 foreach my $key (@kilatr) {delete $self->{$key}}
  20         39  
3195 4         12 $self->$spec (@$data);
3196             }
3197             }
3198              
3199 624603         1357317 return $self;
3200             }
3201              
3202             # _check_latitude($arg_name => $value)
3203             #
3204             # This subroutine range-checks the given latitude value,
3205             # generating a warning if it is outside the range -PIOVER2 <=
3206             # $value <= PIOVER2. The $arg_name is used in the exception, if
3207             # any. The value is normalized to the range -PI to PI, and
3208             # returned. Not that a value outside the validation range makes
3209             # any sense.
3210              
3211             sub _check_latitude {
3212 7139 50 33 7139   34586 (-&PIOVER2 <= $_[1] && $_[1] <= &PIOVER2)
3213             or carp (ucfirst $_[0],
3214             ' must be in radians, between -PI/2 and PI/2');
3215 7139         20678 return mod2pi($_[1] + PI) - PI;
3216             }
3217              
3218             # $value = _check_longitude($arg_name => $value)
3219             #
3220             # This subroutine range-checks the given longitude value,
3221             # generating a warning if it is outside the range -TWOPI <= $value
3222             # <= TWOPI. The $arg_name is used in the exception, if any. The
3223             # value is normalized to the range -PI to PI, and returned.
3224              
3225             sub _check_longitude {
3226 4220 50 33 4220   16013 (-&TWOPI <= $_[1] && $_[1] <= &TWOPI)
3227             or carp (ucfirst $_[0],
3228             ' must be in radians, between -2*PI and 2*PI');
3229 4220         8723 return mod2pi($_[1] + PI) - PI;
3230             }
3231              
3232             # _check_right_ascension($arg_name => $value)
3233             #
3234             # This subroutine range-checks the given right ascension value,
3235             # generating a warning if it is outside the range 0 <= $value <=
3236             # TWOPI. The $arg_name is used in the exception, if any. The value
3237             # is normalized to the range 0 to TWOPI, and returned.
3238              
3239             sub _check_right_ascension {
3240 2919 50 33 2919   12294 (0 <= $_[1] && $_[1] <= &TWOPI)
3241             or carp (ucfirst $_[0],
3242             ' must be in radians, between 0 and 2*PI');
3243 2919         8166 return mod2pi($_[1]);
3244             }
3245              
3246             # @cartesian = _convert_spherical_to_cartesian( @spherical )
3247             #
3248             # This subroutine converts spherical coordinates to Cartesian
3249             # coordinates of the same handedness.
3250             #
3251             # The first three arguments are Phi (in the X-Y plane, e.g. azimuth or
3252             # longitude, in radians), Theta (perpendicular to the X-Y plane, e.g.
3253             # elevation or latitude, in radians) and Rho (range). Subsequent
3254             # triplets of arguments are optional, and can represent derivitaves of
3255             # position (velocity, acceleration ... ) at that point.
3256             #
3257             # The return is the corresponding X, Y, and Z coordinates. If more than
3258             # three triplets of arguments are specified, they will be converted to
3259             # spherical coordinates as though measured at that point, and returned
3260             # in the same order. That is, if you supplied Phi, Theta, and Rho
3261             # velocities, you will get back X, Y, and Z velocities. velocities, you
3262             # will get back Phi, Theta, and Rho velocities, in that order.
3263              
3264             sub _convert_spherical_to_cartesian {
3265 74634     74634   142999 my @sph_data = @_;
3266             @sph_data
3267 74634 50 33     285997 and not @sph_data % 3
3268             or confess( 'Programming error - Want 3 or 6 arguments' );
3269              
3270             # The first triplet is position. We extract it into its own array,
3271             # then compute the corresponding Cartesian coordinates using the
3272             # definition of the coordinate system.
3273              
3274 74634         187194 my @sph_pos = splice @sph_data, 0, 3;
3275 74634         116953 my $range = $sph_pos[2];
3276 74634         147834 my $sin_theta = sin $sph_pos[1];
3277 74634         116215 my $cos_theta = cos $sph_pos[1];
3278 74634         115750 my $sin_phi = sin $sph_pos[0];
3279 74634         116552 my $cos_phi = cos $sph_pos[0];
3280 74634         116240 my $diag = $range * $cos_theta;
3281              
3282 74634         120663 my $X = $diag * $cos_phi;
3283 74634         119569 my $Y = $diag * $sin_phi;
3284 74634         104347 my $Z = $range * $sin_theta;
3285              
3286             # Accumulate results.
3287              
3288 74634         157653 my @rslt = ( $X, $Y, $Z );
3289              
3290             # If we have velocity (accelelation, etc) components
3291              
3292 74634 100       166358 if ( @sph_data ) {
3293              
3294             # We compute unit vectors in the Cartesian coordinate system.
3295              
3296             # x = cos Theta cos Phi r - sin Theta cos Phi theta - sin Phi phi
3297             # y = cos Theta sin Phi r - sin Theta sin Phi theta - cos Phi phi
3298             # z = sin Theta r + cos Theta theta
3299              
3300 1         3 my $X_hat = [ - $sin_phi, - $sin_theta * $cos_phi,
3301             $cos_theta * $cos_phi ];
3302 1         4 my $Y_hat = [ $cos_phi, - $sin_theta * $sin_phi,
3303             $cos_theta * $sin_phi ];
3304 1         2 my $Z_hat = [ 0, $cos_theta, $sin_theta ];
3305              
3306 1         3 while ( @sph_data ) {
3307              
3308             # Each triplet is then converted by projecting the Cartesian
3309             # vector onto the appropriate unit vector. Azimuth and
3310             # elevation are also converted to length by multiplying by
3311             # the range. NOTE that this is the small-angle
3312             # approximation, but should be OK since we assume we're
3313             # dealing with derivatives of position.
3314              
3315 1         4 my @sph_info = splice @sph_data, 0, 3;
3316 1         2 $sph_info[0] *= $range;
3317 1         2 $sph_info[1] *= $range;
3318 1         3 push @rslt, vector_dot_product( $X_hat, \@sph_info );
3319 1         2 push @rslt, vector_dot_product( $Y_hat, \@sph_info );
3320 1         3 push @rslt, vector_dot_product( $Z_hat, \@sph_info );
3321             }
3322              
3323             }
3324              
3325 74634         328962 return @rslt;
3326             }
3327              
3328             # @cartesian = _convert_spherical_x_to_cartesian( @spherical )
3329             #
3330             # This subroutine is a convenience wrapper for
3331             # _convert_spherical_to_cartesian(). The only difference is that the
3332             # arguments are Theta (perpendicular to the X-Y plane), Phi (in the X-Y
3333             # plane) and Rho, rather than Phi, Theta, Rho. This subroutine is my
3334             # penance for not having all the methods that involve spherical
3335             # coordinates return their arguments in the same order.
3336              
3337             sub _convert_spherical_x_to_cartesian {
3338 71714     71714   146879 my @args = @_;
3339 71714         173576 for ( my $inx = 0; $inx < @args; $inx += 3 ) {
3340 71714         260201 @args[ $inx, $inx + 1 ] = @args[ $inx + 1, $inx ];
3341             }
3342 71714         167438 return _convert_spherical_to_cartesian( @args );
3343             }
3344              
3345             # @spherical = _convert_cartesian_to_spherical( @cartesian )
3346             #
3347             # This subroutine converts three-dimensional Cartesian coordinates to
3348             # spherical coordinates of the same handedness.
3349             #
3350             # The first three arguments are the X, Y, and Z coordinates, and are
3351             # required. Subsequent triplets af arguments are optional, and can
3352             # represent anything (velocity, acceleration ... ) at that point.
3353             #
3354             # The return is the spherical coordinates Phi (in the X-Y plane, e.g.
3355             # azimuth or longitude, in radians), Theta (perpendicular to the X-Y
3356             # plane, e.g. elevation or latitude, in radians), and Rho (range). If
3357             # more than three triplets of arguments are specified, they will be
3358             # converted to spherical coordinates as though measured at that point,
3359             # and returned in the same order. That is, if you supplied X, Y, and Z
3360             # velocities, you will get back Phi, Theta, and Rho velocities, in that
3361             # order.
3362              
3363             sub _convert_cartesian_to_spherical {
3364 50182     50182   138451 my @cart_data = @_;
3365             @cart_data
3366 50182 50 33     191719 and not @cart_data % 3
3367             or confess( 'Programming error - Want 3 or 6 arguments' );
3368              
3369             # The first triplet is position. We extract it into its own array,
3370             # then compute the corresponding spherical coordinates using the
3371             # definition of the coordinate system.
3372              
3373 50182         126545 my @cart_pos = splice @cart_data, 0, 3;
3374 50182         171806 my $range = vector_magnitude( \@cart_pos );
3375 50182 100 66     252731 my $azimuth = ( $cart_pos[0] || $cart_pos[1] ) ?
3376             mod2pi( atan2 $cart_pos[1], $cart_pos[0] ) :
3377             0;
3378 50182 100       172952 my $elevation = $range ? asin( $cart_pos[2] / $range ) : 0;
3379              
3380             # Accumulate results.
3381              
3382 50182         120128 my @rslt = ( $azimuth, $elevation, $range );
3383              
3384             # If we have velocity (accelelation, etc) components
3385              
3386 50182 100       114853 if ( @cart_data ) {
3387              
3388             # We compute unit vectors in the spherical coordinate system.
3389             #
3390             # The "Relationships among Unit Vectors" at
3391             # http://plaza.obu.edu/corneliusk/mp/rauv.pdf (and retained in
3392             # the ref/ directory) gives the transformation both ways. With
3393             # x, y, and z being the Cartesian unit vectors, Theta and Phi
3394             # being the elevation (in the range 0 to pi, 0 being along the +
3395             # Z axis) and azimuth (X toward Y, i.e. right-handed), and r,
3396             # theta, and phi being the corresponding unit vectors:
3397             #
3398             # r = sin Theta cos Phi x + sin Theta sin Phi y + cos Theta z
3399             # theta = cos Theta cos Phi x + cos Theta sin Phi y - sin Theta z
3400             # phi = - sin Phi x + cos phi y
3401             #
3402             # and
3403             #
3404             # x = sin Theta cos Phi r + cos Theta cos Phi theta - sin Phi phi
3405             # y = sin Theta sin Phi r + cos Theta sin Phi theta - cos Phi phi
3406             # z = cos Theta r - sin Theta theta
3407             #
3408             # It looks to me like I get the Theta convention I'm using by
3409             # replacing sin Theta with cos Theta and cos Theta by sin Theta
3410             # (because Dr. Cornelius takes 0 as the positive Z axis whereas
3411             # I take zero as the X-Y plane) and changing the sign of theta
3412             # (since Dr. Cornelius' Theta increases in the negative Z
3413             # direction, whereas mine increases in the positive Z
3414             # direction).
3415             #
3416             # The document was found at http://plaza.obu.edu/corneliusk/
3417             # which is the page for Dr. Kevin Cornelius' Mathematical
3418             # Physics (PHYS 4053) course at Ouachita Baptist University in
3419             # Arkadelphia AR.
3420              
3421 16898         35829 my $diag = sqrt( $cart_pos[0] * $cart_pos[0] +
3422             $cart_pos[1] * $cart_pos[1] );
3423 16898         28028 my ( $sin_theta, $cos_theta, $sin_phi, $cos_phi );
3424 16898 50       37464 if ( $range > 0 ) {
3425 16898         32448 $sin_theta = $cart_pos[2] / $range;
3426 16898         25036 $cos_theta = $diag / $range;
3427 16898 50       33850 if ( $diag > 0 ) {
3428 16898         26680 $sin_phi = $cart_pos[1] / $diag;
3429 16898         25535 $cos_phi = $cart_pos[0] / $diag;
3430             } else {
3431 0         0 $sin_phi = 0;
3432 0         0 $cos_phi = 1;
3433             }
3434              
3435             # phi = - sin Phi x + cos phi y
3436             # theta = - sin Theta cos Phi x - sin Theta sin Phi y + cos Theta z
3437             # r = cos Theta cos Phi x + cos Theta sin Phi y + sin Theta z
3438              
3439 16898         49353 my $az_hat = [ - $sin_phi, $cos_phi, 0 ];
3440 16898         60537 my $el_hat = [ - $sin_theta * $cos_phi, - $sin_theta * $sin_phi,
3441             $cos_theta ];
3442 16898         49445 my $rng_hat = [ $cos_theta * $cos_phi, $cos_theta * $sin_phi,
3443             $sin_theta ];
3444              
3445 16898         42708 while ( @cart_data ) {
3446              
3447             # Each triplet is then converted by projecting the
3448             # Cartesian vector onto the appropriate unit vector.
3449             # Azimuth and elevation are also converted to radians by
3450             # dividing by the range. NOTE that this is the
3451             # small-angle approximation, but since we assume we're
3452             # dealing with derivitaves, it's OK.
3453              
3454 16898         37109 my @cart_info = splice @cart_data, 0, 3;
3455 16898         50022 push @rslt, vector_dot_product( $az_hat, \@cart_info ) / $range;
3456 16898         41690 push @rslt, vector_dot_product( $el_hat, \@cart_info ) / $range;
3457 16898         39558 push @rslt, vector_dot_product( $rng_hat, \@cart_info );
3458             }
3459             } else {
3460             # $sin_theta = $sin_phi = 0;
3461             # $cos_theta = $cos_phi = 1;
3462             # We used to do the above and then drop through and do the
3463             # velocity calculation if needed. But in this case the
3464             # velocity calulation blows up. So for the moment we are
3465             # just going to punt.
3466             }
3467              
3468             }
3469              
3470 50182         175426 return @rslt;
3471              
3472             }
3473              
3474             # @spherical = _convert_cartesian_to_spherical_x( @cartesian )
3475             #
3476             # This subroutine is a convenience wrapper for
3477             # _convert_cartesian_to_spherical(). The only difference is that the
3478             # return is Theta (perpendicular to the X-Y plane), Phi (in the X-Y
3479             # plane) and Rho, rather than Phi, Theta, Rho. This subroutine is my
3480             # penance for not having all the methods that involve spherical
3481             # coordinates return their arguments in the same order.
3482              
3483             sub _convert_cartesian_to_spherical_x {
3484 1697     1697   4292 my @sph_data = _convert_cartesian_to_spherical( @_ );
3485 1697         3964 for ( my $inx = 0; $inx < @sph_data; $inx += 3 ) {
3486 1697         5918 @sph_data[ $inx, $inx + 1 ] = @sph_data[ $inx + 1, $inx ];
3487             }
3488 1697         10836 return @sph_data;
3489             }
3490              
3491             # @eci = $self->_convert_ecef_to_eci ()
3492              
3493             # This subroutine converts the object's ECEF setting to ECI, and
3494             # both caches and returns the result.
3495              
3496             sub _convert_ecef_to_eci {
3497 7     7   12 my $self = shift;
3498 7         17 my $thetag = thetag ($self->universal);
3499 7         17 my @data = $self->ecef ();
3500 7 50       32 $self->{debug} and print <
3501             Debug eci - thetag = $thetag
3502             (x, y) = (@data[0, 1])
3503             eod
3504 7         13 my $costh = cos ($thetag);
3505 7         14 my $sinth = sin ($thetag);
3506 7         21 @data[0, 1] = ($data[0] * $costh - $data[1] * $sinth,
3507             $data[0] * $sinth + $data[1] * $costh);
3508 7 50       19 $self->{debug} and print <
3509             Debug eci - after rotation,
3510             (x, y) = (@data[0, 1])
3511             eod
3512 7 50       26 if ( @data > 5 ) {
3513              
3514 7         27 @data[3, 4] = ($data[3] * $costh - $data[4] * $sinth,
3515             $data[3] * $sinth + $data[4] * $costh);
3516 7         16 $data[3] -= $data[1] * $self->{angularvelocity};
3517 7         13 $data[4] += $data[0] * $self->{angularvelocity};
3518             }
3519              
3520             # A bunch of digging says this was added by Subversion commit 697,
3521             # which was first released with Astro::Coord::ECI version 0.014. The
3522             # comment says "Handle equinox in conversion between eci and ecef.
3523             # Correctly, I hope." I'm leaving it in for now, but ...
3524 7         24 $self->set (equinox_dynamical => $self->dynamical);
3525 7         10 return @{$self->{_ECI_cache}{inertial}{eci} = \@data};
  7         36  
3526             }
3527              
3528             # This subroutine converts the object's ECI setting to ECEF, and
3529             # both caches and returns the result.
3530              
3531             our $EQUINOX_TOLERANCE = 365 * SECSPERDAY;
3532              
3533             sub _convert_eci_to_ecef {
3534 88232     88232   154829 my $self = shift;
3535 88232         204620 my $thetag = thetag ($self->universal);
3536              
3537 88232         227777 my $dyn = $self->dynamical;
3538             ## my $equi = $self->get ('equinox_dynamical') || do {
3539             ## $self->set (equinox_dynamical => $dyn); $dyn};
3540 88232   66     224491 my $equi = $self->{equinox_dynamical} ||= $dyn;
3541 88232 50       224514 if (abs ($equi - $dyn) > $EQUINOX_TOLERANCE) {
3542 0         0 $self->precess_dynamical ($dyn);
3543             }
3544              
3545 88232         196823 my @ecef = $self->eci ();
3546 88232         203053 my $costh = cos (- $thetag);
3547 88232         154943 my $sinth = sin (- $thetag);
3548 88232         237443 @ecef[0, 1] = ($ecef[0] * $costh - $ecef[1] * $sinth,
3549             $ecef[0] * $sinth + $ecef[1] * $costh);
3550              
3551 88232 100       196213 if ( @ecef > 3 ) {
3552 18309         44798 @ecef[ 3, 4 ] = ( $ecef[3] * $costh - $ecef[4] * $sinth,
3553             $ecef[3] * $sinth + $ecef[4] * $costh );
3554 18309         35323 $ecef[3] += $ecef[1] * $self->{angularvelocity};
3555 18309         34171 $ecef[4] -= $ecef[0] * $self->{angularvelocity};
3556             }
3557              
3558 88232         242208 $self->{_ECI_cache}{fixed}{ecef} = \@ecef;
3559              
3560             defined wantarray
3561 88232 50       198378 or return;
3562 88232         294208 return @ecef;
3563             }
3564              
3565             # my @args = _expand_args_default_station( @_ )
3566             #
3567             # This subroutine handles the placing of the contents of the
3568             # 'station' attribute into the argument list of methods that,
3569             # prior to the introduction of the 'station' attribute, formerly
3570             # took two Astro::Coord::ECI objects and computed the position of
3571             # the second as seen from the first.
3572              
3573             sub _expand_args_default_station {
3574 67231     67231   163851 my @args = @_;
3575 67231 100       189478 if ( ! embodies( $args[1], 'Astro::Coord::ECI' ) ) {
3576 21         97 unshift @args, $args[0]->get( 'station' );
3577 21 50       67 embodies( $args[0], 'Astro::Coord::ECI' )
3578             or croak 'Station not set';
3579             defined $args[1]->{universal}
3580 21 50       110 and $args[0]->universal( $args[1]->universal() );
3581             }
3582 67231         211019 return @args;
3583             }
3584              
3585             # $value = $self->__initial_inertial
3586             #
3587             # Return the initial setting of the inertial attribute. At this
3588             # level we are assumed not inertial until we acquire a position.
3589             # This is not part of the public interface, but may be used by
3590             # subclasses to set an initial value for this read-only attribute.
3591             # Setting the coordinates explicitly will still set the {inertial}
3592             # attribute appropriately.
3593              
3594 64     64   178 sub __initial_inertial{ return };
3595              
3596             # $value = _local_mean_delta ($coord)
3597              
3598             # Calculate the delta from universal to civil time for the object.
3599             # An exception is raised if the coordinates of the object have not
3600             # been set.
3601              
3602             sub _local_mean_delta {
3603 2     2   5 return ($_[0]->geodetic ())[1] * SECSPERDAY / TWOPI;
3604             }
3605              
3606             =begin comment
3607              
3608             # $string = _rad2dms ($angle)
3609              
3610             # Convert radians to degrees, minutes, and seconds of arc.
3611             # Used for debugging.
3612              
3613             sub _rad2dms {
3614             my $angle = rad2deg (shift);
3615             my $deg = floor ($angle);
3616             $angle = ($angle - $deg) * 60;
3617             my $min = floor ($angle);
3618             $angle = ($angle - $min) * 60;
3619             return "$deg degrees $min minutes $angle seconds of arc";
3620             }
3621              
3622             =end comment
3623              
3624             =cut
3625              
3626             #######################################################################
3627             #
3628             # Package initialization
3629             #
3630              
3631             __PACKAGE__->set (ellipsoid => 'WGS84');
3632              
3633             %savatr = map {$_ => 1} (keys %static, qw{dynamical id name universal});
3634             # Note that local_mean_time does not get preserved, because it
3635             # changes if the coordinates change.
3636              
3637             1;
3638              
3639             __END__