File Coverage

blib/lib/Astro/Coord/ECI/TLE.pm
Criterion Covered Total %
statement 2342 2994 78.2
branch 401 920 43.5
condition 136 269 50.5
subroutine 162 183 88.5
pod 42 42 100.0
total 3083 4408 69.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Astro::Coord::ECI::TLE - Compute satellite locations using NORAD orbit propagation models
4              
5             =head1 SYNOPSIS
6              
7             The following is a semi-brief script to calculate International Space
8             Station visibility. You will need to substitute your own location where
9             indicated.
10              
11             use Astro::SpaceTrack;
12             use Astro::Coord::ECI;
13             use Astro::Coord::ECI::TLE;
14             use Astro::Coord::ECI::TLE::Set;
15             use Astro::Coord::ECI::Utils qw{deg2rad rad2deg};
16            
17             # 1600 Pennsylvania Avenue, Washington DC, USA
18             my $your_north_latitude_in_degrees = 38.898748;
19             my $your_east_longitude_in_degrees = -77.037684;
20             my $your_height_above_sea_level_in_meters = 16.68;
21            
22             # Create object representing the observers' location.
23             # Note that the input to geodetic() is latitude north
24             # and longitude west, in RADIANS, and height above sea
25             # level in KILOMETERS.
26            
27             my $loc = Astro::Coord::ECI->geodetic (
28             deg2rad ($your_north_latitude_in_degrees),
29             deg2rad ($your_east_longitude_in_degrees),
30             $your_height_above_sea_level_in_meters/1000);
31            
32             # Get the 'stations' catalog from Celestrak. This includes
33             # all space stations and related bodies.
34             # The data are all direct-fetched, so no password is
35             # needed.
36            
37             my $st = Astro::SpaceTrack->new( direct => 1 );
38             my $data = $st->celestrak( 'stations' );
39             $data->is_success or die $data->status_line;
40            
41             # Parse the fetched data, yielding TLE objects. Aggregate
42             # them into Set objects where this is warranted. We grep
43             # the data because the Celestrak catalog we fetched
44             # contains other stuff than the International Space
45             # Station.
46            
47             my @sats = grep { '25544' eq $_->get( 'id' ) }
48             Astro::Coord::ECI::TLE::Set->aggregate(
49             Astro::Coord::ECI::TLE->parse( $data->content() ) );
50            
51             # We want passes for the next 7 days.
52            
53             my $start = time ();
54             my $finish = $start + 7 * 86400;
55            
56             # Loop through our objects and predict passes. The
57             # validate() step is usually not needed for data from
58             # Space Track, but NASA's predicted elements for Space
59             # Shuttle flights can be funky.
60            
61             my @passes;
62             foreach my $tle (@sats) {
63             $tle->validate($start, $finish) or next;
64             push @passes, $tle->pass($loc, $start, $finish);
65             }
66             print <
67             Date/Time Satellite Elevation Azimuth Event
68             eod
69             foreach my $pass (sort {$a->{time} <=> $b->{time}} @passes) {
70            
71             # The returned angles are in radians, so we need to
72             # convert back to degrees.
73             #
74             # Note that unless Scalar::Util::dualvar works, the event output
75             # will be integers.
76            
77             print "\n";
78            
79             foreach my $event (@{$pass->{events}}) {
80             printf "%s %-15s %9.1f %9.1f %-5s\n",
81             scalar localtime $event->{time},
82             $event->{body}->get ('name'),
83             rad2deg ($event->{elevation}),
84             rad2deg ($event->{azimuth}),
85             $event->{event};
86             }
87             }
88              
89             =head1 NOTICE
90              
91             Users of JSON functionality (if any!) should be aware of a potential
92             problem in the way L encodes numbers. The problem
93             basically is that the locale leaks into the encoded JSON, and if the
94             locale uses commas for decimal points the encoded JSON can not be
95             decoded. As I understand the discussion on the associated Perl ticket
96             the problem has always been there, but changes introduced in Perl 5.19.8
97             made it more likely to manifest.
98              
99             Unfortunately the nature of the JSON interface is such that I have no
100             control over the issue, since the workaround needs to be applied at the
101             point the JSON C method is called. See test F
102             for the workaround that allows tests to pass in the affected locales.
103             The relevant L ticket is
104             L. The relevant Perl
105             ticket is L.
106              
107             The C attribute has undergone a slight change in
108             functionality from version 0.046, in which it was introduced. In the new
109             functionality, if the C attribute is true, the satellite must
110             actually be visible above the threshold to be reported. This is actually
111             how the attribute would have worked when introduced if I had thought it
112             through clearly.
113              
114             Use of the C JSON attribute to represent the common name of the
115             satellite is deprecated in favor of the C attribute, since
116             the latter is what Space Track uses in their TLE data. Beginning with
117             0.053_01, JSON output of TLEs will use the new name.
118              
119             Beginning with release 0.056_01, loading JSON TLE data which specifies
120             C produces a warning the first time it happens. As of version
121             0.061 there is a warning every time it happens. As of version 0.066
122             loading JSON TLE data which specifies C is a fatal error. Six
123             months after this, all code referring to C will be removed,
124             meaning that the key will be silently ignored.
125              
126             =head1 DESCRIPTION
127              
128             This module implements the orbital propagation models described in
129             "SPACETRACK REPORT NO. 3, Models for Propagation of NORAD Element Sets"
130             and "Revisiting Spacetrack Report #3." See the
131             L section for details on these
132             reports.
133              
134             In other words, this module turns the two- or three-line element sets
135             available from such places as L or
136             L into predictions of where the relevant orbiting
137             bodies will be. Additionally, the pass() method implements an actual
138             visibility prediction system.
139              
140             The models implemented are:
141              
142             SGP - fairly simple, only useful for near-earth bodies;
143             SGP4 - more complex, only useful for near-earth bodies;
144             SDP4 - corresponds to SGP4, but for deep-space bodies;
145             SGP8 - more complex still, only for near-earth bodies;
146             SDP8 - corresponds to SGP8, but for deep-space bodies;
147             SGP4R - updates and combines SGP4 and SDP4.
148              
149             All the above models compute ECI coordinates in kilometers, and
150             velocities along the same axes in kilometers per second.
151              
152             There are also some meta-models, with the smarts to run either a
153             near-earth model or the corresponding deep-space model depending on the
154             body the object represents:
155              
156             model - uses the preferred model (sgp4r);
157             model4 - runs sgp4 or sdp4;
158             model4r - runs sgp4r;
159             model8 - runs sgp8 or sdp8.
160              
161             In addition, I have on at least one occasion wanted to turn off the
162             automatic calculation of position when the time was set. That is
163             accomplished with this model:
164              
165             null - does nothing.
166              
167             The models do not return the coordinates directly, they simply set the
168             coordinates represented by the object (by virtue of being a subclass of
169             L) and return the object itself.
170             You can then call the appropriate inherited method to get the
171             coordinates of the body in whatever coordinate system is convenient. For
172             example, to find the latitude, longitude, and altitude of a body at a
173             given time, you do
174              
175             my ($lat, $long, $alt) = $body->model ($time)->geodetic;
176              
177             Or, assuming the C attribute is set the way you want
178             it, by
179              
180             my ($lat, $long, $alt) = $body->geodetic ($time);
181              
182             It is also possible to run the desired model (as specified by the
183             C attribute) simply by setting the time represented
184             by the object.
185              
186             As of release 0.016, the recommended model to use is SGP4R, which was
187             added in that release. The SGP4R model, described in "Revisiting
188             Spacetrack Report #3"
189             (L), combines SGP4
190             and SDP4, and updates them. For the details of the changes, see the
191             report.
192              
193             Prior to release 0.016, the recommended model to use was either SGP4 or
194             SDP4, depending on whether the orbital elements are for a near-earth or
195             deep-space body. For the purpose of these models, any body with a period
196             of at least 225 minutes is considered to be a deep-space body.
197              
198             The NORAD report claims accuracy of 5 or 6 places a day after the epoch
199             of an element set for the original FORTRAN IV, which used (mostly) 8
200             place single-precision calculations. Perl typically uses many more
201             places, but it does not follow that the models are correspondingly more
202             accurate when implemented in Perl. My understanding is that in general
203             (i.e. disregarding the characteristics of a particular implementation of
204             the models involved) the total error of the predictions (including error
205             in measuring the position of the satellite) runs from a few hundred
206             meters to as much as a kilometer.
207              
208             I have no information on the accuracy claims of SGP4R.
209              
210             This module is a computer-assisted translation of the FORTRAN reference
211             implementations in "SPACETRACK REPORT NO. 3" and "Revisiting Spacetrack
212             Report #3." That means, basically, that I ran the FORTRAN through a Perl
213             script that handled the translation of the assignment statements into
214             Perl, and then fixed up the logic by hand. Dominik Borkowski's SGP C-lib
215             was used as a reference implementation for testing purposes, because I
216             didn't have a Pascal compiler, and I have yet to get any model but SGP
217             to run correctly under g77.
218              
219             =head2 Methods
220              
221             The following methods should be considered public:
222              
223             =over 4
224              
225             =cut
226              
227             package Astro::Coord::ECI::TLE;
228              
229 16     16   158594 use strict;
  16         88  
  16         460  
230 16     16   87 use warnings;
  16         28  
  16         730  
231              
232             our $VERSION = '0.130';
233              
234 16     16   108 use base qw{ Astro::Coord::ECI Exporter };
  16         30  
  16         12235  
235              
236 16         4159 use Astro::Coord::ECI::Utils qw{ :params :ref :greg_time deg2rad distsq
237             dynamical_delta embodies find_first_true fold_case
238             __format_epoch_time_usec
239             format_space_track_json_time load_module looks_like_number max min
240             mod2pi PI PIOVER2 rad2deg SECSPERDAY TWOPI thetag __default_station
241             @CARP_NOT
242 16     16   117 };
  16         35  
243              
244 16     16   115 use Carp qw{carp croak confess};
  16         39  
  16         948  
245 16     16   9389 use Data::Dumper;
  16         97989  
  16         967  
246 16     16   7794 use IO::File;
  16         140245  
  16         1955  
247 16     16   130 use POSIX qw{ ceil floor fmod modf strftime };
  16         31  
  16         165  
248 16     16   1433 use Scalar::Util ();
  16         77  
  16         1240  
249              
250             BEGIN {
251 16     16   69 local $@;
252 16         109 eval {require Scalar::Util; Scalar::Util->import ('dualvar'); 1}
  16         464  
  16         2375  
253 16 50       33 or *dualvar = sub {$_[0]};
  0         0  
254             }
255              
256             { # Local symbol block.
257             my @const = qw{
258             PASS_EVENT_NONE
259             PASS_EVENT_SHADOWED
260             PASS_EVENT_LIT
261             PASS_EVENT_DAY
262             PASS_EVENT_RISE
263             PASS_EVENT_MAX
264             PASS_EVENT_SET
265             PASS_EVENT_APPULSE
266             PASS_EVENT_START
267             PASS_EVENT_END
268             PASS_EVENT_BRIGHTEST
269             PASS_VARIANT_VISIBLE_EVENTS
270             PASS_VARIANT_FAKE_MAX
271             PASS_VARIANT_NO_ILLUMINATION
272             PASS_VARIANT_START_END
273             PASS_VARIANT_BRIGHTEST
274             PASS_VARIANT_TRUNCATE
275             PASS_VARIANT_NONE
276             BODY_TYPE_UNKNOWN
277             BODY_TYPE_DEBRIS
278             BODY_TYPE_ROCKET_BODY
279             BODY_TYPE_PAYLOAD
280             };
281             our @EXPORT_OK = @const;
282             our %EXPORT_TAGS = (
283             all => \@EXPORT_OK,
284             constants => \@const
285             );
286             }
287              
288 16     16   119 use constant RE_ALL_DIGITS => qr{ \A [0-9]+ \z }smx;
  16         32  
  16         1284  
289              
290             # The following constants are from section 12 (Users Guide, Constants,
291             # and Symbols) of SpaceTrack Report No. 3, Models for Propagation of
292             # NORAD Element Sets by Felix R. Hoots and Ronald L. Roehrich, December
293             # 1980, compiled by T. S. Kelso 31 December 1988. The FORTRAN variables
294             # in the original are defined without the "SGP_" prefix. Were there
295             # are duplicates (with one commented out), the commented-out version is
296             # the one in the NORAD report, and the replacement has greater
297             # precision. If there are two commented out, the second was a greater
298             # precision constant, and the third is (ultimately) calculated based
299             # on pi = atan2 (0, -1).
300              
301 16     16   100 use constant SGP_CK2 => 5.413080E-4;
  16         43  
  16         890  
302 16     16   93 use constant SGP_CK4 => .62098875E-6;
  16         51  
  16         854  
303 16     16   111 use constant SGP_E6A => 1.0E-6;
  16         37  
  16         912  
304 16     16   107 use constant SGP_QOMS2T => 1.88027916E-9;
  16         38  
  16         787  
305 16     16   90 use constant SGP_S => 1.01222928;
  16         32  
  16         972  
306             ## use constant SGP_TOTHRD => .66666667;
307 16     16   120 use constant SGP_TOTHRD => 2 / 3;
  16         40  
  16         858  
308 16     16   118 use constant SGP_XJ3 => -.253881E-5;
  16         31  
  16         939  
309 16     16   118 use constant SGP_XKE => .743669161E-1;
  16         33  
  16         873  
310 16     16   102 use constant SGP_XKMPER => 6378.135; # Earth radius, KM.
  16         27  
  16         762  
311 16     16   107 use constant SGP_XMNPDA => 1440.0; # Time units per day.
  16         53  
  16         909  
312 16     16   103 use constant SGP_XSCPMN => 60; # Seconds per time unit.
  16         35  
  16         875  
313 16     16   94 use constant SGP_AE => 1.0; # Distance units / earth radii.
  16         41  
  16         1004  
314             ## use constant SGP_DE2RA => .174532925E-1; # radians/degree.
315             ## use constant SGP_DE2RA => 0.0174532925199433; # radians/degree.
316 16     16   119 use constant SGP_DE2RA => PI / 180; # radians/degree.
  16         31  
  16         979  
317             ## use constant SGP_PI => 3.14159265; # Pi.
318             ## use constant SGP_PI => 3.14159265358979; # Pi.
319 16     16   102 use constant SGP_PI => PI; # Pi.
  16         51  
  16         844  
320             ## use constant SGP_PIO2 => 1.57079633; # Pi/2.
321             ## use constant SGP_PIO2 => 1.5707963267949; # Pi/2.
322 16     16   102 use constant SGP_PIO2 => PIOVER2; # Pi/2.
  16         30  
  16         868  
323             ## use constant SGP_TWOPI => 6.2831853; # 2 * Pi.
324             ## use constant SGP_TWOPI => 6.28318530717959; # 2 * Pi.
325 16     16   106 use constant SGP_TWOPI => TWOPI; # 2 * Pi.
  16         34  
  16         954  
326             ## use constant SGP_X3PIO2 => 4.71238898; # 3 * Pi / 2.
327             ## use constant SGP_X3PIO2 => 4.71238898038469; # 3 * Pi / 2.
328 16     16   118 use constant SGP_X3PIO2 => 3 * PIOVER2;
  16         37  
  16         814  
329              
330 16     16   93 use constant SGP_RHO => .15696615;
  16         32  
  16         14745  
331              
332             # FORTRAN variable glossary, read from same source, and stated in
333             # terms of the output produced by the parse method.
334             #
335             # EPOCH => epoch
336             # XNDT20 => firstderivative
337             # XNDD60 => secondderivative
338             # BSTAR => bstardrag
339             # XINCL => inclination
340             # XNODE0 => ascendingnode
341             # E0 => eccentricity
342             # OMEGA0 => argumentofperigee
343             # XM0 => meananomaly
344             # XNO => meanmotion
345              
346             # List all the legitimate attributes for the purposes of the
347             # get and set methods. Possible values of the hash are:
348             # undef => read-only attribute
349             # 0 => no model re-initializing necessary
350             # 1 => at least one model needs re-initializing
351             # code reference - the reference is called with the
352             # object unmodified, with the arguments
353             # being the object, the name of the attribute,
354             # and the new value of the attribute. The code
355             # must make the needed changes to the attribute, and
356             # return 0 or 1, interpreted as above.
357              
358             my %attrib = (
359             backdate => 0,
360             effective => sub {
361             my ($self, $name, $value) = @_;
362             if ( defined $value && ! looks_like_number( $value ) ) {
363             if ( $value =~ m{ \A ([0-9]+) / ([0-9]+) / ([0-9]+) : ([0-9]+) :
364             ([0-9]+ (?: [.] [0-9]* )? ) \z }smx ) {
365             $value = greg_time_gm( 0, 0, 0, 1, 0,
366             __tle_year_to_Gregorian_year( $1 + 0 ) ) + (
367             (($2 - 1) * 24 + $3) * 60 + $4) * 60 + $5;
368             } else {
369             carp "Invalid effective date '$value'";
370             $value = undef;
371             }
372             }
373             $self->{$name} = $value;
374             return 0;
375             },
376             classification => 0,
377             international => \&_set_intldes,
378             epoch => sub {
379             $_[0]{$_[1]} = $_[2];
380             $_[0]{ds50} = $_[0]->ds50 ();
381             $_[0]{epoch_dynamical} = $_[2] + dynamical_delta ($_[2]);
382             return 1;
383             },
384             firstderivative => 1,
385             gravconst_r => sub {
386             ($_[2] == 72 || $_[2] == 721 || $_[2] == 84)
387             or croak "Error - Illegal gravconst_r; must be 72, 721, or 84";
388             $_[0]{$_[1]} = $_[2];
389             return 1; # sgp4r needs reinit if this changes.
390             },
391             secondderivative => 1,
392             bstardrag => 1,
393             ephemeristype => 0,
394             elementnumber => 0,
395             inclination => 1,
396             model => sub {
397             $_[0]->is_valid_model ($_[2]) || croak <
398             Error - Illegal model name '$_[2]'.
399             eod
400             $_[0]{$_[1]} = $_[2];
401             return 0;
402             },
403             model_error => 0,
404             ascendingnode => 1,
405             eccentricity => 1,
406             argumentofperigee => 1,
407             meananomaly => 1,
408             meanmotion => 1,
409             revolutionsatepoch => 0,
410             debug => 0,
411             geometric => 0, # Use geometric horizon for pass rise/set.
412             visible => 0, # Pass() reports only illuminated passes.
413             appulse => 0, # Maximum appulse to report.
414             interval => 0, # Interval for pass() positions, if positive.
415             lazy_pass_position => 0, # Position optional if true.
416             pass_variant => sub {
417             my ( $self, $name, $val ) = @_;
418             $val =~ RE_ALL_DIGITS
419             or croak 'The pass_variant attribute must be an unsigned number';
420             $self->{$name} = $val;
421             return 0;
422             },
423             ds50 => undef, # Read-only
424             epoch_dynamical => undef, # Read-only
425             rcs => 0, # Radar cross-section
426             tle => undef, # Read-only
427             file => \&_set_optional_unsigned_integer_no_reinit,
428             illum => \&_set_illum,
429             launch_year => \&_set_intldes_part,
430             launch_num => \&_set_intldes_part,
431             launch_piece => \&_set_intldes_part,
432             object_type => \&_set_object_type,
433             ordinal => \&_set_optional_unsigned_integer_no_reinit,
434             originator => 0,
435             pass_threshold => sub {
436             my ($self, $name, $value) = @_;
437             not defined $value
438             or looks_like_number( $value )
439             or carp "Invalid $name '$value'";
440             $self->{$name} = $value;
441             return 0;
442             },
443             reblessable => sub {
444             my $doit = !$_[0]{$_[1]} && $_[2] && $_[0]->get ('id');
445             $_[0]{$_[1]} = $_[2];
446             $doit and $_[0]->rebless ();
447             return 0;
448             },
449             intrinsic_magnitude => \&_set_optional_float_no_reinit,
450             );
451             my %static = (
452             appulse => deg2rad (10), # Report appulses < 10 degrees.
453             backdate => 1, # Use object in pass before its epoch.
454             geometric => 0, # Use geometric horizon for pass rise/set.
455             gravconst_r => 72, # Specify geodetic data set for sgp4r.
456             illum => 'sun',
457             interval => 0,
458             lazy_pass_position => 0,
459             model => 'model',
460             pass_variant => 0,
461             reblessable => 1,
462             visible => 1,
463             );
464             my %model_attrib = ( # For the benefit of is_model_attribute()
465             ds50 => 1, # Read-only, but it fits the definition.
466             epoch => 1, # Hand-set, since we dont want to call the code.
467             epoch_dynamical => 1, # Read-only, but fits the definition.
468             );
469             foreach (keys %attrib) {
470             $model_attrib{$_} = 1 if $attrib{$_} && !ref $attrib{$_}
471             }
472             my %status; # Subclassing data - initialized at end
473             my %magnitude_table; # Magnitude data - initialized at end
474             my $magnitude_adjust = 0; # Adjustment to magnitude table value
475              
476 16     16   139 use constant TLE_INIT => '_init';
  16         103  
  16         6858  
477              
478             =item $tle = Astro::Coord::ECI::TLE->new()
479              
480             This method instantiates an object to represent a NORAD two- or
481             three-line orbital element set. This is a subclass of
482             L.
483              
484             Any arguments get passed to the set() method.
485              
486             It is both anticipated and recommended that you use the parse()
487             method instead of this method to create an object, since the models
488             currently have no code to guard against incomplete data.
489              
490             =cut
491              
492             sub new {
493 64     64 1 1664 my $class = shift;
494 64         412 my $self = $class->SUPER::new (%static, @_);
495 64         227 return $self;
496             }
497              
498             =item $tle->after_reblessing (\%possible_attributes)
499              
500             This method supports reblessing into a subclass, with the argument
501             representing attributes that the subclass may wish to set. It is called
502             by rebless() and should not be called by the user.
503              
504             At this level it does nothing.
505              
506             =cut
507              
508       87 1   sub after_reblessing {}
509              
510             =item Astro::Coord::ECI::TLE->alias (name => class ...)
511              
512             This static method adds an alias for a class name, for the benefit of
513             users of the status() method and 'illum' attributes, and ultimately of
514             the rebless() method. It is intended to be used by subclasses to
515             register short names for themselves upon initialization, though of
516             course you can call it yourself as well.
517              
518             For example, this class calls
519              
520             __PACKAGE__->alias (tle => __PACKAGE__);
521              
522             You can register more than one alias in a single call. Aliases
523             can be deleted by assigning them a false value (e.g. '' or undef).
524              
525             If called without arguments, it returns the current aliases.
526              
527             You can actually call this as a normal method, but it still behaves
528             like a static method.
529              
530             =cut
531              
532             my %type_map = ();
533              
534             sub alias {
535 48     48 1 156 my ($self, @args) = @_;
536 48 50       158 @args % 2 and croak <
537             Error - Must have even number of arguments for alias().
538             eod
539 48 0       128 return wantarray ? %type_map : {%type_map} unless @args;
    50          
540 48         120 while (@args) {
541 48         89 my $name = shift @args;
542 48 50       137 my $class = shift @args or do {
543 0         0 delete $type_map{$name};
544 0         0 next;
545             };
546 48 50       134 $class = $type_map{$class} if $type_map{$class};
547 48         192 load_module ($class);
548 48         213 $type_map{$name} = $class;
549             }
550 48         248 return $self;
551             }
552             __PACKAGE__->alias (tle => __PACKAGE__);
553              
554             =item $kilometers = $tle->apoapsis();
555              
556             This method returns the apoapsis of the orbit, in kilometers. Since
557             Astro::Coord::ECI::TLE objects always represent bodies orbiting the
558             Earth, this is more usually called apogee.
559              
560             Note that this is the distance from the center of the Earth, not the
561             altitude.
562              
563             =cut
564              
565             sub apoapsis {
566 8     8 1 39 my $self = shift;
567             return $self->{&TLE_INIT}{TLE_apoapsis} ||=
568 8   66     35 (1 + $self->get('eccentricity')) * $self->semimajor();
569             }
570              
571             =item $kilometers = $tle->apogee();
572              
573             This method is simply a synonym for apoapsis().
574              
575             =cut
576              
577             *apogee = \&apoapsis;
578              
579             # See Astro::Coord::ECI for docs.
580              
581             sub attribute {
582 0 0   0 1 0 return exists $attrib{$_[1]} ?
583             __PACKAGE__ :
584             $_[0]->SUPER::attribute ($_[1])
585             }
586              
587             =item $tle->before_reblessing ()
588              
589             This method supports reblessing into a subclass. It is intended to do
590             any cleanup the old class needs before reblessing into the new class. It
591             is called by rebless(), and should not be called by the user.
592              
593             At this level it does nothing.
594              
595             =cut
596              
597       87 1   sub before_reblessing {}
598              
599             =item $type = $tle->body_type ()
600              
601             This method returns the type of the body as one of the BODY_TYPE_*
602             constants. This is the C<'object_type'> attribute if that is defined.
603             Otherwise it is derived from the common name using an algorithm similar
604             to the one used by the Space Track web site. This algorithm will not
605             work if the common name is not available, or if it does not conform to
606             the Space Track naming conventions. Known or suspected differences from
607             the algorithm described at the bottom of the Satellite Box Score page
608             include:
609              
610             * The C algorithm is not case-sensitive. The
611             Space Track algorithm appears to assume all upper-case.
612              
613             * The C algorithm looks for words (that is,
614             alphanumeric strings delimited by non-alphanumeric characters), whereas
615             the Space Track documentation seems to say it just looks for substrings.
616             However, implementing the documented algorithm literally results in OID
617             20479 'DEBUT (ORIZURU)' being classified as debris, whereas Space Track
618             returns it in response to a query for name 'deb' that excludes debris.
619              
620             The possible returns are:
621              
622             C<< BODY_TYPE_UNKNOWN => dualvar( 0, 'unknown' ) >> if the value of the
623             C attribute is C, or if it is empty or contains only
624             white space.
625              
626             C<< BODY_TYPE_DEBRIS => dualvar( 1, 'debris' ) >> if the value of the
627             C attribute contains one of the words 'deb', 'debris', 'coolant',
628             'shroud', or 'westford needles', all checks being case-insensitive.
629              
630             C<< BODY_TYPE_ROCKET_BODY => dualvar( 2, 'rocket body' ) >> if the body
631             is not debris, but the value of the C attribute contains one of
632             the strings 'r/b', 'akm' (for 'apogee kick motor') or 'pkm' (for
633             'perigee kick motor') all checks being case-insensitive.
634              
635             C<< BODY_TYPE_PAYLOAD => dualvar( 3, 'payload' ) >> if the body is not
636             unknown, debris, or a rocket body.
637              
638             The above constants are not exported by default, but they are exportable
639             either by name or using the C<:constants> tag.
640              
641             If L does not export C, the
642             constants are defined to be numeric. The cautious programmer will
643             therefore test them using numeric tests.
644              
645             =cut
646              
647 16     16   148 use constant BODY_TYPE_UNKNOWN => dualvar( 0, 'unknown' );
  16         40  
  16         1276  
648 16     16   117 use constant BODY_TYPE_DEBRIS => dualvar( 1, 'debris' );
  16         55  
  16         1104  
649 16     16   102 use constant BODY_TYPE_ROCKET_BODY => dualvar( 2, 'rocket body' );
  16         45  
  16         1005  
650 16     16   109 use constant BODY_TYPE_PAYLOAD => dualvar( 3, 'payload' );
  16         34  
  16         37001  
651              
652             sub body_type {
653 12     12 1 829 my ( $self ) = @_;
654 12         27 my $type;
655 12 50       26 $type = $self->get( 'object_type' )
656             and return $type;
657 12 100       23 defined( my $name = $self->get( 'name' ) )
658             or return BODY_TYPE_UNKNOWN;
659 11 50       51 $name =~ m/ \A \s* \z /smx
660             and return BODY_TYPE_UNKNOWN;
661 11 100 100     130 ( $name =~ m/ \b deb \b /smxi
      100        
      100        
      100        
662             || $name =~ m/ \b debris \b /smxi
663             || $name =~ m/ \b coolant \b /smxi
664             || $name =~ m/ \b shroud \b /smxi
665             || $name =~ m/ \b westford \s+ needles \b /smxi )
666             and return BODY_TYPE_DEBRIS;
667 5 100 100     32 ( $name =~ m{ \b r/b \b }smxi
668             || $name =~ m/ \b [ap] km \b /smxi )
669             and return BODY_TYPE_ROCKET_BODY;
670 2         9 return BODY_TYPE_PAYLOAD;
671             }
672              
673             =item $tle->can_flare ()
674              
675             This method returns true if the object is capable of generating flares
676             (i.e. predictable bright flashes) and false otherwise. At this level
677             of the inheritance hierarchy, it always returns false, but subclasses
678             may return true.
679              
680             =cut
681              
682 0     0 1 0 sub can_flare {return 0}
683              
684             =item $elevation = $tle->correct_for_refraction( $elevation )
685              
686             This override of the superclass' method simply returns the elevation
687             passed to it. Atmospheric refraction at orbital altitudes is going to be
688             negligible except B close to the horizon, and I have no
689             algorithm for that.
690              
691             If I B come up with something to handle refraction close to the
692             horizon, though, it will appear here. One would expect the refraction
693             right at the limb to be twice that calculated by Thorfinn's algorithm
694             (used in the superclass) because the light travels to the Earth's
695             surface and back out again.
696              
697             See the L C and
698             C documentation for whether this class'
699             C method is actually called by those methods.
700              
701             =cut
702              
703             sub correct_for_refraction {
704 917     917 1 1903 my ( undef, $elevation ) = @_; # Invocant unused
705 917         1777 return $elevation;
706             }
707              
708             =item $value = $tle->ds50($time)
709              
710             This method converts the time to days since 1950 Jan 0, 0 h GMT.
711             The time defaults to the epoch of the data set. This method does not
712             affect the $tle object - it is exposed for convenience and for testing
713             purposes.
714              
715             It can also be called as a "static" method, i.e. as
716             Astro::Coord::ECI::TLE->ds50 ($time), but in this case the time may not
717             be defaulted, and no attempt has been made to make this a pretty error.
718              
719             =cut
720              
721             { # Begin local symbol block
722              
723             # Because different Perl implementations may have different
724             # epochs, we assume that 2000 Jan 1 0h UT is representable, and
725             # pre-calculate that time in terms of seconds since the epoch.
726             # Then, when the method is called, we convert the argument to
727             # days since Y2K, and then add the magic number needed to get
728             # us to days since 1950 Jan 0 0h UT.
729              
730             my $y2k = greg_time_gm( 0, 0, 0, 1, 0, 2000 ); # Calc. time of 2000 Jan 1 0h UT
731              
732             sub ds50 {
733 59     59 1 223 my ($self, $epoch) = @_;
734 59 50       156 defined $epoch or $epoch = $self->{epoch};
735 59         151 my $rslt = ($epoch - $y2k) / SECSPERDAY + 18263;
736 59 50 33     301 (ref $self && $self->{debug}) and print <
737             Debug ds50 ($epoch) = $rslt
738             eod
739 59         141 return $rslt;
740             }
741             } # End local symbol block
742              
743             =item $value = $tle->get('attribute')
744              
745             This method retrieves the value of the given attribute. See the
746             L section for a description of the attributes.
747              
748             =cut
749              
750             {
751             my %accessor = (
752             tle => sub {$_[0]{$_[1]} ||= $_[0]->_make_tle()},
753             );
754             sub get {
755 45601     45601 1 1224223 my $self = shift;
756 45601         67627 my $name = shift;
757 45601 50       86482 if (ref $self) {
758 45601 100       151034 exists $attrib{$name} or return $self->SUPER::get ($name);
759             return $accessor{$name} ?
760             $accessor{$name}->($self, $name) :
761 4697 100       18156 $self->{$name};
762             } else {
763 0 0       0 exists $static{$name} or
764             return $self->SUPER::get ($name);
765 0         0 return $static{$name};
766             }
767             }
768             }
769              
770             =item $illuminated = $tle->illuminated();
771              
772             This method returns a true value if the body is illuminated, and a false
773             value if it is not.
774              
775             =cut
776              
777             sub illuminated {
778 502     502 1 1088 my ( $self, $time ) = @_;
779 502         1195 return $self->__sun_elev_from_sat( $time ) >= 0;
780             }
781              
782             =item @events = $tle->intrinsic_events( $start, $end );
783              
784             This method returns any events that are intrinsic to the C<$tle> object.
785             If optional argument C<$start> is defined, only events occurring at or
786             after that Perl time are returned. Similarly, if optional argument
787             C<$end> is defined, only events occurring before that Perl time are
788             returned.
789              
790             The return is an array of array references. Each array reference
791             specifies the Perl time of the event and a text description of the
792             event.
793              
794             At this level of the object hierarchy nothing is returned. Subclasses
795             may override this to add C events. The overrides should return
796             anything returned by C in addition to
797             anything they return themselves.
798              
799             The order of the returned events is undefined.
800              
801             =cut
802              
803             sub intrinsic_events {
804 47     47 1 179 return;
805             }
806              
807             =item $deep = $tle->is_deep();
808              
809             This method returns true if the object is in deep space - meaning that
810             its period is at least 225 minutes (= 13500 seconds).
811              
812             =cut
813              
814             sub is_deep {
815             return $_[0]->{&TLE_INIT}{TLE_isdeep}
816 10 100   10 1 65 if exists $_[0]->{&TLE_INIT}{TLE_isdeep};
817 4         14 return ($_[0]->{&TLE_INIT}{TLE_isdeep} = $_[0]->period () >= 13500);
818             }
819              
820             =item $boolean = $tle->is_model_attribute ($name);
821              
822             This method returns true if the named attribute is an attribute of
823             the model - i.e. it came from the TLE data and actually affects the
824             model computations. It is really for the benefit of
825             Astro::Coord::ECI::TLE::Set, so that class can determine how its
826             set() method should handle the attribute.
827              
828             =cut
829              
830 1     1 1 4 sub is_model_attribute { return $model_attrib{$_[1]} }
831              
832             =item $boolean = $tle->is_valid_model ($model_name);
833              
834             This method returns true if the given name is the name of an orbital
835             model, and false otherwise.
836              
837             Actually, in the spirit of UNIVERSAL::can, it returns a reference to
838             the code if the model exists, and undef otherwise.
839              
840             This is really for the benefit of Astro::Coord::ECI::TLE::Set, so it
841             knows it needs to select the correct member object before running the
842             model.
843              
844             This method can be called as a static method, or even as a subroutine.
845              
846             =cut
847              
848             { # Begin local symbol block
849              
850             my %valid = map {$_ => __PACKAGE__->can ($_)}
851             qw{model model4 model4r model8 null sdp4 sdp8 sgp sgp4 sgp4r sgp8};
852              
853             #>>> NOTE WELL
854             #>>> If a model is added, the period method must change
855             #>>> as well, to calculate using the new model. I really
856             #>>> ought to do all this with code attributes.
857              
858             sub is_valid_model {
859 128     128 1 396 return $valid{$_[1]}
860             }
861              
862             } # End local symbol block
863              
864             =item $mag = $tle->magnitude( $station );
865              
866             This method returns the magnitude of the body as seen from the given
867             station. If no C<$station> is specified, the object's C<'station'>
868             attribute is used. If that is not set, and exception is thrown.
869              
870             This is calculated from the C<'intrinsic_magnitude'> attribute, the
871             distance from the station to the satellite, and the fraction of the
872             satellite illuminated. The formula is from Mike McCants.
873              
874             We return C if the C<'intrinsic_magnitude'> or C<'illum'>
875             attributes are C, or if the illuminating body is below the
876             horizon as seen from the satellite.
877              
878             After this method returns the time set in the station attribute should
879             be considered undefined. In fact, it will be set to the same time as the
880             invocant if a defined magnitude was returned. But if C was
881             returned, the station's time may not have been changed.
882              
883             Some very desultory investigation of International Space Station
884             magnitude predictions suggests that this method produces magnitude
885             estimates about half a magnitude less bright than Heavens Above.
886              
887             =cut
888              
889             sub magnitude {
890 1     1 1 7 my ( $self, $sta ) = __default_station( @_ );
891              
892             # If we have no standard magnitude, just return undef.
893 1 50       5 defined( my $std_mag = $self->get( 'intrinsic_magnitude' ) )
894             or return undef; ## no critic (ProhibitExplicitReturnUndef)
895              
896             # If we have no illuminating body for some reason, we also have to
897             # just return undef.
898 1 50       4 my $illum = $self->get( 'illum' )
899             or return undef; ## no critic (ProhibitExplicitReturnUndef)
900              
901             # Pick up the time.
902 1         4 my $time = $self->universal();
903              
904             # If the illuminating body is below the horizon, we return undef.
905 1 50       4 $self->illuminated()
906             or return undef; ## no critic (ProhibitExplicitReturnUndef)
907              
908             # Compute the range amd the elevation.
909 1         6 my ( undef, $elev, $range ) = $sta->universal( $time )->azel( $self );
910              
911             # If the satellite is below the horizon, just return undef
912 1 50       7 $elev < 0
913             and return undef; ## no critic (ProhibitExplicitReturnUndef)
914              
915             # Adjust the magnitude if the illuminating body is not the Sun.
916 1 50       6 my $mag_adj = $illum->isa( 'Astro::Coord::ECI::Sun' ) ? 0 :
917             $illum->magnitude() - Astro::Coord::ECI::Sun->MEAN_MAGNITUDE();
918              
919             # Compute the fraction of the satellite illuminated.
920 1         40 my $frac_illum = ( 1 + cos( $self->angle( $illum, $sta ) ) ) / 2;
921              
922             # Finally we get to McCants' algorithm
923 1         9 return $std_mag + $mag_adj - 15.75 +
924             2.5 * log( $range ** 2 / $frac_illum ) / log( 10 );
925              
926             }
927              
928             =item Astro::Coord::ECI::TLE->magnitude_table( command => arguments ...)
929              
930             This method maintains the internal magnitude table, which is used by the
931             parse() method to fill in magnitudes, since they are not normally
932             available from the usual sources. The first argument determines what is
933             done to the status table; subsequent arguments depend on the first
934             argument. Valid commands and arguments are:
935              
936             C $id, $mag )> adds a magnitude entry to the
937             table, replacing the existing entry for the given OID if any.
938              
939             C $adjustment )> maintains a magnitude
940             adjustment to be added to the value in the magnitude table before
941             setting the C of an object. If the argument is
942             C the current adjustment is returned; otherwise the argument
943             becomes the new adjustment. Actual magnitude table entries are not
944             modified by this operation; the adjustment is done in the C
945             method.
946              
947             C clears the magnitude table.
948              
949             C $id )> removes the given OID from the table
950             if it is there.
951              
952             C \%mag ) replaces the magnitude table
953             with the contents of the given hash. The keys will be normalized to 5
954             digits.
955              
956             C $file_name, $mag_offset )> replaces the
957             magnitude table with the contents of the named Molczan-format file. The
958             C<$file_name> argument can also be a scalar reference with the scalar
959             containing the data, or an open handle. The C<$mag_offset> is an
960             adjustment to be added to the magnitudes read from the file, and
961             defaults to 0.
962              
963             C $file_name, $mag_offset )> replaces the
964             magnitude table with the contents of the named Quicksat-format file. The
965             C<$file_name> argument can also be a scalar reference with the scalar
966             containing the data, or an open handle. The C<$mag_offset> is an
967             adjustment to be added to the magnitudes read from the file, and
968             defaults to 0. In addition to this value, C<0.7> is added to the
969             magnitude before storage to adjust the data from full-phase to
970             half-phase.
971              
972             C ... )> returns an array which is a slice of
973             the magnitude table, which is stored as a hash. In other words, it
974             returns OID/magnitude pairs in no particular order. If any further
975             arguments are passed, they are the OIDs to return. Otherwise all are
976             returned.
977              
978             Examples of Molczan-format data are contained in F and
979             F available on Mike McCants' web site; these can be fetched
980             using the L C method. An
981             example of Quicksat-format data is contained in F. See Mike
982             McCants' web site, L for an
983             explanation of the differences.
984              
985             Note that if you have one of the reported pure Perl versions of
986             L, you can not pass open handles to
987             functionality that would otherwise accept them.
988              
989             =cut
990              
991             {
992             my $openhandle = Scalar::Util->can( 'openhandle' ) || sub { return };
993              
994             my $parse_file = sub {
995             my ( $file_name, $mag_offset, $parse_info ) = @_;
996             defined $mag_offset
997             or $mag_offset = 0;
998             $mag_offset += $parse_info->{mag_offset};
999             my %mag;
1000             my $fh;
1001             if ( $openhandle->( $file_name ) ) {
1002             $fh = $file_name;
1003             } else {
1004             open $fh, '<', $file_name ## no critic (RequireBriefOpen)
1005             or croak "Failed to open $file_name: $!";
1006             }
1007             local $_ = undef; # while (<>) ... does not localize $_.
1008             while ( <$fh> ) {
1009             chomp;
1010             m/ \A \s* (?: \# | \z ) /smx
1011             and next; # Extension to syntax.
1012             $parse_info->{pad} > length
1013             and $_ = sprintf '%-*s', $parse_info->{pad}, $_;
1014             # Perl 5.8 and below require an explicit buffer to unpack.
1015             my ( $id, $mag ) = unpack $parse_info->{template}, $_;
1016             $mag =~ s/ \s+ //smxg;
1017             looks_like_number( $mag )
1018             or next;
1019             $mag{ _normalize_oid( $id ) } = $mag + $parse_info->{mag_offset};
1020             }
1021             close $fh;
1022             %magnitude_table = %mag;
1023             };
1024              
1025             my %cmd_def = (
1026             add => sub {
1027             my ( $id, $mag ) = @_;
1028             defined $id
1029             and $id =~ m/ \A [0-9]+ \z /smx
1030             and defined $mag
1031             and looks_like_number( $mag )
1032             or croak 'magnitude_table add needs an OID and a magnitude';
1033             $magnitude_table{ _normalize_oid( $id ) } = $mag;
1034             return;
1035             },
1036             adjust => sub {
1037             my ( $adj ) = @_;
1038             if ( defined $adj ) {
1039             looks_like_number( $adj )
1040             or croak 'magnitude_table adjust needs a floating point number';
1041             $magnitude_adjust = $adj;
1042             return;
1043             } else {
1044             return $magnitude_adjust;
1045             }
1046             },
1047             clear => sub {
1048             %magnitude_table = ();
1049             return;
1050             },
1051             dump => sub {
1052             local $Data::Dumper::Terse = 1;
1053             local $Data::Dumper::Sortkeys = 1;
1054             print Dumper( \%magnitude_table );
1055             return;
1056             },
1057             drop => sub {
1058             my ( $id ) = @_;
1059             defined $id
1060             and $id =~ m/ \A [0-9]+ \z /smx
1061             or croak 'magnitude_table drop needs an OID';
1062             delete $magnitude_table{ _normalize_oid( $id ) };
1063             return;
1064             },
1065             magnitude => sub {
1066             my ( $tbl ) = @_;
1067             HASH_REF eq ref $tbl
1068             or croak 'magnitude_table magnitude needs a hash ref';
1069             my %mag;
1070             foreach my $key ( keys %{ $tbl } ) {
1071             my $val = $tbl->{$key};
1072             $key =~ m/ \A [0-9]+ \z /smx
1073             or croak "OID '$key' must be numeric";
1074             looks_like_number( $val )
1075             or croak "Magnitude '$val' must be numeric";
1076             $mag{ _normalize_oid( $key ) } = $val;
1077             }
1078             %magnitude_table = %mag;
1079             return;
1080             },
1081             molczan => sub {
1082             my ( $file_name, $mag_factor ) = @_;
1083             $parse_file->( $file_name, $mag_factor, {
1084             mag_offset => 0,
1085             pad => 49,
1086             template => 'a5x32a5',
1087             } );
1088             return;
1089             },
1090             quicksat => sub {
1091             my ( $file_name, $mag_factor ) = @_;
1092             $parse_file->( $file_name, $mag_factor, {
1093             mag_offset => 0.7,
1094             pad => 56,
1095             template => 'a5x28a5',
1096             } );
1097             return;
1098             },
1099             show => sub {
1100             my ( @arg ) = @_;
1101             @arg
1102             or return %magnitude_table;
1103             return (
1104             map { $_ => $magnitude_table{$_} }
1105             grep { defined $magnitude_table{$_} }
1106             map { _normalize_oid( $_ ) } @arg
1107             );
1108             },
1109             );
1110              
1111             sub magnitude_table {
1112 29     29 1 13340 my ( undef, $cmd, @arg ) = @_; # Invocant not used
1113 29 50       100 my $code = $cmd_def{$cmd}
1114             or croak "'$cmd' is not a valid magnitude_table subcommand";
1115 29         81 return $code->( @arg );
1116             }
1117             }
1118              
1119             =item $time = $tle->max_effective_date(...);
1120              
1121             This method returns the maximum date among its arguments and the
1122             effective date of the $tle object as set in the C attribute,
1123             if that is defined. If no effective date is set but the C
1124             attribute is false, the C of the object is used as the effective
1125             date. If there are no arguments and no effective date, C is
1126             returned.
1127              
1128             =cut
1129              
1130             sub max_effective_date {
1131 26     26 1 91 my ($self, @args) = @_;
1132 26 100       72 if (my $effective = $self->get('effective')) {
    100          
1133 5         13 push @args, $effective;
1134             } elsif (!$self->get('backdate')) {
1135 3         7 push @args, $self->get('epoch');
1136             }
1137 26         110 return max( grep {defined $_} @args );
  31         186  
1138             }
1139              
1140             =item $tle = $tle->members();
1141              
1142             This method simply returns the object it is called on. It exists for
1143             convenience in getting back validated objects when iterating over a
1144             mixture of L and
1145             L objects.
1146              
1147             =cut
1148              
1149             sub members {
1150 0     0 1 0 return shift;
1151             }
1152              
1153             =item $tle = $tle->model($time)
1154              
1155             This method calculates the position of the body described by the TLE
1156             object at the given time, using the preferred model. As of
1157             Astro::Coord::ECI::TLE 0.010_10 this is sgp4r; previously it was sgp4 or
1158             sdp4, whichever was appropriate.
1159              
1160             The intent is that this method will use whatever model is currently
1161             preferred. If the preferred model changes, this method will use the
1162             new preferred model as soon as I:
1163              
1164             - Find out about the change;
1165             - Can get the specifications for the new model;
1166             - Can find the time to code up the new model.
1167              
1168             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1169             or equatorial ()) to retrieve the position you just calculated.
1170              
1171             =cut
1172              
1173             BEGIN {
1174 16     16   1584 *model = \&sgp4r;
1175             }
1176              
1177             =item $tle = $tle->model4 ($time)
1178              
1179             This method calculates the position of the body described by the TLE
1180             object at the given time, using either the SGP4 or SDP4 model,
1181             whichever is appropriate.
1182              
1183             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1184             or equatorial ()) to retrieve the position you just calculated.
1185              
1186             =cut
1187              
1188             sub model4 {
1189 0 0   0 1 0 return $_[0]->is_deep ? $_[0]->sdp4 ($_[1]) : $_[0]->sgp4 ($_[1]);
1190             }
1191              
1192             =item $tle = $tle->model4r ($time)
1193              
1194             This method calculates the position of the body described by the TLE
1195             object at the given time, using the "Revisiting Spacetrack Report #3"
1196             model (sgp4r). It is really just a synonym for sgp4r, which covers both
1197             near-earth and deep space bodies, but is provided for consistency's
1198             sake. If some other model becomes preferred, this method will still call
1199             sgp4r.
1200              
1201             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1202             or equatorial ()) to retrieve the position you just calculated.
1203              
1204             =cut
1205              
1206             BEGIN {
1207 16     16   21418 *model4r = \&sgp4r;
1208             }
1209              
1210             =item $tle = $tle->model8 ($time)
1211              
1212             This method calculates the position of the body described by the TLE
1213             object at the given time, using either the SGP8 or SDP8 model,
1214             whichever is appropriate.
1215              
1216             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1217             or equatorial ()) to retrieve the position you just calculated.
1218              
1219             =cut
1220              
1221             sub model8 {
1222 0 0   0 1 0 return $_[0]->is_deep ? $_[0]->sdp8 ($_[1]) : $_[0]->sgp8 ($_[1]);
1223             }
1224              
1225             =item $tle = $tle->null ($time)
1226              
1227             This method does nothing. It is a valid orbital model, though. If you
1228             call $tle->set (model => 'null'), no position calculation is done as a
1229             side effect of calling $tle->universal ($time).
1230              
1231             =cut
1232              
1233 6     6 1 10 sub null { return $_[0] }
1234              
1235             =item @elements = Astro::Coord::ECI::TLE->parse( @data );
1236              
1237             This method parses NORAD two- or three-line element sets, JSON element
1238             sets, or a mixture, returning a list of Astro::Coord::ECI::TLE objects.
1239             The L section identifies those attributes which will be
1240             filled in by this method.
1241              
1242             TLE input will be split into individual lines, and all blank lines and
1243             lines beginning with '#' will be eliminated. The remaining lines are
1244             assumed to represent two- or three-line element sets, in so-called
1245             external format. Internal format (denoted by a 'G' in column 79 of line
1246             1 of the set, not counting the common name if any) is not supported,
1247             and the presence of such data will result in an exception being thrown.
1248              
1249             Input beginning with C<[{> (with optional spaces) is presumed to be
1250             NORAD JSON element sets and parsed accordingly.
1251              
1252             Optionally, the first argument (after the invocant) can be a reference
1253             to a hash of default attribute values. These are preferred over the
1254             static values, but attributes provided by the TLE or JSON input override
1255             both.
1256              
1257             =cut
1258              
1259             sub parse {
1260 15     15 1 5618 my ($self, @args) = @_;
1261 15         34 my @rslt;
1262 15 100       76 my $attrs = HASH_REF eq ref $args[0] ? shift @args : {};
1263              
1264 15         29 my @data;
1265 15         50 foreach my $datum (@args) {
1266 15 50       43 ref $datum and croak <
1267             Error - Arguments to parse() must be scalar.
1268             eod
1269 15 50       66 if ( $datum =~ m/ \A \s* \[? \s* \{ /smx ) {
1270 0         0 push @rslt, $self->_parse_json( $attrs, $datum );
1271             } else {
1272 15         138 foreach my $line (split qr{\n}, $datum) {
1273 96         378 $line =~ s/ \s+ \z //smx;
1274 96 50       197 $line =~ m/ \A \s* [#] /smx and next;
1275 96 50       331 $line and push @data, $line;
1276             }
1277             }
1278             }
1279              
1280 15         63 while (@data) {
1281 44         183 my %ele = ( %static, %{ $attrs } );
  44         244  
1282 44         96 my $name;
1283 44         93 my $line = shift @data;
1284 44         221 $line =~ s/\s+$//;
1285 44         104 my $tle = "$line\n";
1286 44 100 100     312 $line =~ m{ \A 1 (\s* [0-9]+) }smx and length $1 == 6 or do {
1287 8         27 ( $name = $line ) =~ s/ \A 0 \s+ //smx; # SpaceTrack 3le
1288 8         16 $line = shift @data;
1289 8         27 $tle .= "$line\n";
1290             };
1291 44 50 33     183 if (length ($line) > 79 && substr ($line, 79, 1) eq 'G') {
1292 0         0 croak "G (internal) format data not supported";
1293             } else {
1294 44 50 33     248 ($line =~ m/^1(\s*[0-9]+)/ && length ($1) == 6)
1295             or croak "Invalid line 1 '$line'";
1296 44 50       253 length ($line) < 80 and $line .= ' ' x (80 - length ($line));
1297              
1298 44         416 @ele{qw{id classification international epoch firstderivative
1299             secondderivative bstardrag ephemeristype elementnumber}} =
1300             unpack 'x2A5A1x1A8x1A14x1A10x1A8x1A8x1A1x1A4', $line;
1301 44         179 $ele{elementnumber} =~ s/ \A \s+ //smx;
1302              
1303 44         101 $line = shift @data;
1304 44         124 $tle .= "$line\n";
1305 44 50 33     252 ($line =~ m/^2(\s*[0-9]+)/ && length ($1) == 6)
1306             or croak "Invalid line 2 '$line'";
1307 44 100       143 length ($line) < 80 and $line .= ' ' x (80 - length ($line));
1308 44         274 @ele{qw{id_2 inclination ascendingnode eccentricity
1309             argumentofperigee meananomaly meanmotion
1310             revolutionsatepoch}} =
1311             unpack 'x2A5x1A8x1A8x1A7x1A8x1A8x1A11A5', $line;
1312              
1313 44         133 foreach my $key ( qw{ id epoch firstderivative
1314             secondderivative bstardrag ephemeristype elementnumber
1315             id_2 inclination ascendingnode eccentricity
1316             argumentofperigee meananomaly meanmotion }
1317             ) {
1318 616         1448 $ele{$key} =~ s/ \s /0/smxg;
1319             }
1320              
1321             $ele{id} == $ele{id_2} or
1322 44 50       192 croak "Invalid data. Line 1 was for id $ele{id} but ",
1323             "line 2 was for $ele{id_2}";
1324 44         97 delete $ele{id_2};
1325             }
1326 44         86 foreach (qw{eccentricity}) {
1327 44         189 $ele{$_} = "0.$ele{$_}" + 0;
1328             }
1329 44         86 foreach (qw{secondderivative bstardrag}) {
1330 88         565 $ele{$_} =~ s/(.)(.{5})(..)/$1.$2e$3/;
1331 88         320 $ele{$_} += 0;
1332             }
1333 44         87 foreach (qw{epoch}) {
1334 44         201 my ($yr, $day) = $ele{$_} =~ m/(..)(.*)/;
1335 44         203 $yr = __tle_year_to_Gregorian_year( $yr );
1336 44         153 $ele{$_} = greg_time_gm( 0, 0, 0, 1, 0, $yr ) +
1337             ( $day - 1 ) * SECSPERDAY;
1338             }
1339              
1340             # From here is conversion to the units expected by the
1341             # models.
1342              
1343 44         1529 foreach (qw{ascendingnode argumentofperigee meananomaly
1344             inclination}) {
1345 176         379 $ele{$_} *= SGP_DE2RA;
1346             }
1347 44         78 my $temp = SGP_TWOPI;
1348 44         81 foreach (qw{meanmotion firstderivative secondderivative}) {
1349 132         243 $temp /= SGP_XMNPDA;
1350 132         279 $ele{$_} *= $temp;
1351             }
1352              
1353 44         285 my $body = __PACKAGE__->new (%ele); # Note that setting the
1354             # ID does the reblessing.
1355 44         246 $body->__parse_name( $name );
1356 44         97 $body->{tle} = $tle;
1357 44         313 push @rslt, $body;
1358             }
1359              
1360 15 50       104 if ( keys %magnitude_table ) {
1361 15         54 foreach my $tle ( @rslt ) {
1362 44 50       90 defined( my $oid = $tle->get( 'id' ) )
1363             or next;
1364 44 50       105 defined $tle->get( 'intrinsic_magnitude' )
1365             and next;
1366 44 100       106 defined( my $std_mag = $magnitude_table{ _normalize_oid( $oid ) } )
1367             or next;
1368 2         6 $tle->set( intrinsic_magnitude => $std_mag +
1369             $magnitude_adjust );
1370             }
1371             }
1372 15         126 return @rslt;
1373             }
1374              
1375             sub __parse_name {
1376 44     44   96 my ( $self, $name ) = @_;
1377 44 100       109 defined $name
1378             or return;
1379 8         41 $name =~ s{ \s* -- ( effective | rcs ) \s+ ( \S+ ) }{
1380 4         15 $self->set( $1 => $2 );
1381 4         14 ''
1382             }smxge;
1383 8 50       39 $name ne ''
1384             and $self->set( name => $name );
1385 8         12 return;
1386             }
1387              
1388             # Parse information for the above from
1389             # CelesTrak "FAQs: Two-Line Element Set Format", by Dr. T. S. Kelso,
1390             # http://celestrak.org/columns/v04n03/
1391             # Per this, all data are for the NORAD SGP4/SDP4 model, except for the
1392             # first and second time derivative, which are for the simpler SGP model.
1393             # The actual documentation of the algorithms, along with a reference
1394             # implementation in FORTRAN, is available at
1395             # http://celestrak.org/NORAD/documentation/spacetrk.pdf
1396              
1397             =item @passes = $tle->pass ($station, $start, $end, \@sky)
1398              
1399             This method returns passes of the body over the given station between
1400             the given start end end times. The \@sky argument is background bodies
1401             to compute appulses with (see note 3).
1402              
1403             A pass is detected by this method when the body sets. Unless
1404             C (see below) is in effect, this means that
1405             passes are not usefully detected for geosynchronous or
1406             near-geosynchronous bodies, and that passes where the body sets after
1407             the C<$end> time will not be detected.
1408              
1409             All arguments are optional, the defaults being
1410              
1411             $station = the 'station' attribute of the invocant
1412             $start = time()
1413             $end = $start + 7 days
1414             \@sky = []
1415              
1416             The return is a list of passes, which may be empty. Each pass is
1417             represented by an anonymous hash containing the following keys:
1418              
1419             {body} => Reference to body making pass;
1420             {time} => Time of pass (culmination);
1421             {events} => [the individual events of the pass].
1422              
1423             The individual events are also anonymous hashes, with each hash
1424             containing the following keys:
1425              
1426             {azimuth} => Azimuth of event in radians (see note 1);
1427             {body} => Reference to body making pass (see note 2);
1428             {appulse} => { # This is present only for PASS_EVENT_APPULSE;
1429             {angle} => minimum separation in radians;
1430             {body} => other body involved in appulse;
1431             }
1432             {elevation} => Elevation of event in radians (see note 1);
1433             {event} => Event code (PASS_EVENT_xxxx);
1434             {illumination} => Illumination at time of event (PASS_EVENT_xxxx);
1435             {range} => Distance to event in kilometers (see note 1);
1436             {station} => Reference to observing station (see note 2);
1437             {time} => Time of event;
1438              
1439             The events are coded by the following manifest constants:
1440              
1441             PASS_EVENT_NONE => dualvar (0, '');
1442             PASS_EVENT_SHADOWED => dualvar (1, 'shdw');
1443             PASS_EVENT_LIT => dualvar (2, 'lit');
1444             PASS_EVENT_DAY => dualvar (3, 'day');
1445             PASS_EVENT_RISE => dualvar (4, 'rise');
1446             PASS_EVENT_MAX => dualvar (5, 'max');
1447             PASS_EVENT_SET => dualvar (6, 'set');
1448             PASS_EVENT_APPULSE => dualvar (7, 'apls');
1449             PASS_EVENT_START => dualvar( 11, 'start' );
1450             PASS_EVENT_END => dualvar( 12, 'end' );
1451             PASS_EVENT_BRIGHTEST => dualvar( 13, 'brgt' );
1452              
1453             The C and C events are not normally
1454             generated. You can get them in lieu of whatever events start and end the
1455             pass by setting C in the C
1456             attribute. Unless you are filtering out non-visible events, though, they
1457             are just the rise and set events under different names.
1458              
1459             The dualvar function comes from Scalar::Util, and generates values
1460             which are numeric in numeric context and strings in string context. If
1461             Scalar::Util cannot be loaded the numeric values are returned.
1462              
1463             These manifest constants can be imported using the individual names, or
1464             the tags ':constants' or ':all'. They can also be accessed as methods
1465             using (e.g.) $tle->PASS_EVENT_LIT, or as static methods using (e.g.)
1466             Astro::Coord::ECI::TLE->PASS_EVENT_LIT.
1467              
1468             Illumination is represented by one of PASS_EVENT_SHADOWED,
1469             PASS_EVENT_LIT, or PASS_EVENT_DAY. The first two are calculated based on
1470             whether the illuminating body (i.e. the body specified by the 'illum'
1471             attribute) is above the horizon; the third is based on whether the Sun
1472             is higher than specified by the 'twilight' attribute, and trumps the
1473             other two (i.e. if it's day it doesn't matter whether the satellite is
1474             illuminated).
1475              
1476             Time resolution of the events is typically to the nearest second, except
1477             for appulses, which need to be calculated more closely to detect
1478             transits. The time reported for the event is the time B the event
1479             occurred. For example, the time reported for rise is the earliest time
1480             the body is found above the horizon, and the time reported for set is
1481             the earliest time the body is found below the horizon.
1482              
1483             The operation of this method is affected by the following attributes,
1484             in addition to its arguments and the orbital elements associated with
1485             the object:
1486              
1487             * appulse # Maximum appulse to report
1488             * edge_of_earths_shadow # Used in the calculation of
1489             # whether the satellite is illuminated or in
1490             # shadow.
1491             * geometric # Use geometric horizon for pass rise/set
1492             * horizon # Effective horizon
1493             * interval # Interval for pass() positions, if positive
1494             * lazy_pass_position # {azimuth}, {elevation} and {range}
1495             # are optional if true (see note 1).
1496             * pass_threshold # Minimum elevation satellite must reach
1497             # for the pass to be reportable. If visible
1498             # is true, it must be visible above this
1499             # elevation
1500             * pass_variant # Tweak what pass() returns; currently no
1501             # effect unless 'visible' is true.
1502             * illum # Source of illumination.
1503             * twilight # Distance of illuminator below horizon
1504             * visible # Pass() reports only illuminated passes
1505              
1506             Note 1:
1507              
1508             If the C attribute is true, the {azimuth},
1509             {elevation}, and {range} keys may not be present. This attribute gives
1510             the event-calculating algorithm permission to omit these if the time of
1511             the event can be determined without computing the position of the body.
1512             Currently this happens only for events generated in response to setting
1513             the C attribute, but the user should not make this assumption
1514             in his or her own code.
1515              
1516             Typically you will only want to set this true if, after calling the
1517             C method, you are not interested in the azimuth, elevation and
1518             range, but compute the event positions in some coordinates other than
1519             azimuth, elevation, and range.
1520              
1521             Note 2:
1522              
1523             The time set in the various {body} and {station} objects is B
1524             guaranteed to be anything in particular. Specifically, it is almost
1525             certainly not the time of the event. If you make use of the {body}
1526             object you will probably need to set its time to the time of the event
1527             before you do so.
1528              
1529             Note 3:
1530              
1531             The algorithm for computing appulses has been modified slightly in
1532             version 0.056_04. This modification only applies to elements
1533             of the optional C<\@sky> array that represent artificial satellites.
1534              
1535             The problem I'm trying to address is that two satellites in very similar
1536             orbits can appear to converge again after their appulse, due to their
1537             increasing distance from the observer. If this happens early enough in
1538             the pass it can fool the binary search algorithm that determines the
1539             appulse time.
1540              
1541             The revision is to first step across the pass, finding the closest
1542             approach of the two bodies. A binary search is then done on a small
1543             interval around the closest approach.
1544              
1545             =cut
1546              
1547 16     16   152 use constant PASS_EVENT_NONE => dualvar (0, ''); # Guaranteed false.
  16         37  
  16         1225  
1548 16     16   113 use constant PASS_EVENT_SHADOWED => dualvar (1, 'shdw');
  16         35  
  16         1106  
1549 16     16   108 use constant PASS_EVENT_LIT => dualvar (2, 'lit');
  16         36  
  16         1456  
1550 16     16   118 use constant PASS_EVENT_DAY => dualvar (3, 'day');
  16         35  
  16         1282  
1551 16     16   133 use constant PASS_EVENT_RISE => dualvar (4, 'rise');
  16         41  
  16         1047  
1552 16     16   113 use constant PASS_EVENT_MAX => dualvar (5, 'max');
  16         31  
  16         958  
1553 16     16   101 use constant PASS_EVENT_SET => dualvar (6, 'set');
  16         77  
  16         1006  
1554 16     16   112 use constant PASS_EVENT_APPULSE => dualvar (7, 'apls');
  16         59  
  16         1123  
1555 16     16   106 use constant PASS_EVENT_START => dualvar( 11, 'start' );
  16         28  
  16         1042  
1556 16     16   109 use constant PASS_EVENT_END => dualvar( 12, 'end' );
  16         37  
  16         1012  
1557 16     16   109 use constant PASS_EVENT_BRIGHTEST => dualvar( 13, 'brgt' );
  16         68  
  16         929  
1558              
1559 16     16   104 use constant PASS_VARIANT_VISIBLE_EVENTS => 0x01;
  16         69  
  16         907  
1560 16     16   111 use constant PASS_VARIANT_FAKE_MAX => 0x02;
  16         30  
  16         752  
1561 16     16   98 use constant PASS_VARIANT_START_END => 0x04;
  16         29  
  16         1241  
1562 16     16   104 use constant PASS_VARIANT_NO_ILLUMINATION => 0x08;
  16         30  
  16         844  
1563 16     16   103 use constant PASS_VARIANT_BRIGHTEST => 0x10;
  16         44  
  16         1264  
1564 16     16   96 use constant PASS_VARIANT_TRUNCATE => 0x20;
  16         39  
  16         865  
1565 16     16   106 use constant PASS_VARIANT_NONE => 0x00; # Must be 0.
  16         36  
  16         1573  
1566              
1567             my @pass_variant_mask = (
1568             PASS_VARIANT_NO_ILLUMINATION | PASS_VARIANT_START_END |
1569             PASS_VARIANT_BRIGHTEST | PASS_VARIANT_TRUNCATE,
1570             PASS_VARIANT_VISIBLE_EVENTS | PASS_VARIANT_FAKE_MAX |
1571             PASS_VARIANT_START_END | PASS_VARIANT_BRIGHTEST |
1572             PASS_VARIANT_TRUNCATE,
1573             );
1574              
1575 16     16   112 use constant SCREENING_HORIZON_OFFSET => deg2rad( -3 );
  16         35  
  16         77  
1576              
1577             # ***** Promise Astro::Coord::ECI::TLE::Set that pass() only uses the
1578             # ***** public interface. That way pass() will get the Set object,
1579             # ***** and will work if we have more than one set of elements for the
1580             # ***** body, even if we switch element sets in the middle of a pass.
1581              
1582             *_nodelegate_pass = \&pass;
1583              
1584             # The following method is not supported, and may be changed or retracted
1585             # at any time without notice. Its purpose in life is to provide a handle
1586             # by which the experimental and unreleased Astro::Coord::ECI::Points
1587             # objects can manipulate the the start and end times of the pass
1588             # calculation.
1589             sub __default_pass_times {
1590 14     14   53 my ( undef, $start, $end ) = @_; # Invocant unused
1591 14 50       50 defined $start
1592             or $start = time;
1593 14 50       35 defined $end
1594             or $end = $start + 7 * SECSPERDAY;
1595 14         49 return ( $start, $end );
1596             }
1597              
1598             sub pass {
1599 14     14 1 1108 my @args = __default_station( @_ );
1600 14         43 my @sky;
1601             ARRAY_REF eq ref $args[-1]
1602 14 100       64 and @sky = @{pop @args};
  12         42  
1603 14         42 my $tle = shift @args;
1604 14         29 my $sta = shift @args;
1605              
1606             # We give subclasses a way of specifying their own default times. If
1607             # an undefined end time is returned, the subclass is stating that
1608             # there are no passes in the given range, and we simply return.
1609 14         75 my ( $pass_start, $pass_end ) = $tle->__default_pass_times(
1610             splice @args, 0, 2 );
1611 14 50       51 defined $pass_start
1612             or return;
1613              
1614 14 50       39 $pass_end >= $pass_start or croak <
1615             Error - End time must be after start time.
1616             eod
1617              
1618 14         57 $pass_start = $tle->max_effective_date($pass_start);
1619 14 50       64 $pass_start <= $pass_end or return;
1620              
1621 14         59 my @lighting = (
1622             PASS_EVENT_SHADOWED,
1623             PASS_EVENT_LIT,
1624             PASS_EVENT_DAY,
1625             );
1626 14         38 my $verbose = $tle->get ('interval');
1627 14         32 my $pass_step = 60;
1628 14         39 my $horizon = $tle->get ('horizon');
1629 14 50       51 my $effective_horizon = $tle->get ('geometric') ? 0 : $horizon;
1630 14         43 my $pass_threshold = $tle->get( 'pass_threshold' );
1631 14         97 my $twilight = $tle->get ('twilight');
1632 14         63 my $want_visible = $tle->get ('visible');
1633 14         49 my $appulse_dist = $tle->get ('appulse');
1634 14         43 my $debug = $tle->get ('debug');
1635 14 100       65 my $pass_variant = $tle->get( 'pass_variant' ) &
1636             $pass_variant_mask[ $want_visible ? 1 : 0 ];
1637 14 50       58 defined $tle->get( 'intrinsic_magnitude' )
1638             or $pass_variant &= ~ PASS_VARIANT_BRIGHTEST;
1639 14         41 my $truncate = $pass_variant & PASS_VARIANT_TRUNCATE;
1640 14 100 66     50 defined $pass_threshold
1641             and $pass_threshold > $horizon
1642             or $pass_threshold = $horizon;
1643              
1644             # We need the number of radians the satellite travels in a minute so
1645             # we can be slightly conservative determining whether the satellite
1646             # might be lit while screening for a pass.
1647             # TODO For something not in orbit the period should be undefined.
1648             # But we might call pass() on it anyway because something like a
1649             # sounding rocket would still rise and set. What we have at the
1650             # moment is a total crock, but until I can figure out something
1651             # better ...
1652 14         89 my $period = $tle->period();
1653             # TODO the next statement is the crock referred to just above
1654 14 50       47 defined $period
1655             or $period = 90 * 60; # Pretend we're in a 90 min orbit
1656 14         43 my $min_sun_elev_from_sat = - TWOPI / $period * 60;
1657              
1658             # We also want to be slightly conservative when deciding whether the
1659             # satellite passes above the horizon. Since the above is clearly too
1660             # much (since at its maximum elevation the apparent path of the
1661             # satellite is horizontal) we reduce it using a piece of pure
1662             # ad-hocery.
1663 14         44 my $screening_horizon = $horizon + SCREENING_HORIZON_OFFSET;
1664 14 50       89 $effective_horizon < $screening_horizon
1665             and $screening_horizon = $effective_horizon;
1666              
1667             # We need the sun at some point, maybe
1668              
1669 14         44 my ( $sun, $suntim, $dawn, $sun_screen, $sun_limit );
1670 14 100       50 if ( $pass_variant & PASS_VARIANT_NO_ILLUMINATION ) {
1671 1         2 $suntim = $sun_screen = $sun_limit = $pass_end + SECSPERDAY;
1672 1         2 $dawn = 1;
1673             } else {
1674 13         43 $sun = $tle->get( 'sun' );
1675 13         100 ( $suntim, $dawn, $sun_screen, $sun_limit ) =
1676             _next_elevation_screen( $sta->universal( $pass_start ),
1677             $pass_step, $sun, $twilight );
1678             }
1679              
1680             # For each time to be covered
1681              
1682 14         33 my $step = $pass_step;
1683 14         27 my $bigstep = 5 * $step;
1684 14         29 my $littlestep = $step;
1685 14         22 my $end = $pass_end;
1686 14 100       50 $truncate
1687             and $end += $littlestep;
1688 14         49 my @info; # Information on an individual pass.
1689             my @passes; # Accumulated informtion on all passes.
1690 14         0 my $visible;
1691 14         43 for (my $time = $pass_start; $time <= $end; $time += $step) {
1692              
1693             # If the current sun event has occurred, handle it and calculate
1694             # the next one.
1695              
1696 41453 100       71917 if ( $time >= $sun_limit ) {
1697 82         304 ( $suntim, $dawn, $sun_screen, $sun_limit ) =
1698             _next_elevation_screen( $sta->universal( $suntim ),
1699             $pass_step, $sun, $twilight );
1700             }
1701              
1702             # Skip if the sun is up. We set the step size small, because we
1703             # are not actually tracking the satellite so we do not know what
1704             # the appropriate size is.
1705              
1706             $want_visible
1707             and not @info
1708             and not $dawn
1709             and $time < $sun_screen
1710 41453 100 100     172632 and do {
      100        
      100        
1711 28770         36332 $step = $littlestep;
1712 28770         48756 next;
1713             };
1714              
1715             # Calculate azimuth and elevation.
1716              
1717 12683         33339 my ($azm, $elev, $rng) = $sta->azel ($tle->universal ($time));
1718              
1719             # Adjust the step size based on how far the body is below the
1720             # horizon.
1721              
1722 12683 100       30775 $step = $elev < -.4 ? $bigstep : $littlestep;
1723              
1724             # If the body is below the horizon, we check for accumulated data,
1725             # handle it if any, clear it, and on to the next iteration. We
1726             # have to make the check on effective horizon as well as screening
1727             # horizon, because maybe we are at the very end of the prediction
1728             # period and the satellite makes it below the effective horizon
1729             # but not the screening horizon before the end of the prediction
1730             # period. Sigh.
1731              
1732 12683 100 66     34358 if ( $elev < $screening_horizon
      33        
      66        
      100        
      66        
1733             || @info && $elev < $effective_horizon &&
1734             $info[-1]{elevation} >= $effective_horizon
1735             || $truncate && $time >= $pass_end
1736             ) {
1737 12022 100       26277 @info = () unless $visible;
1738 12022 100       37536 next unless @info;
1739              
1740             # We may have skipped part of the pass because it began in
1741             # daylight or before the official beginning of the prediction
1742             # period. Pick up that part now.
1743              
1744             { # Single-iteration loop.
1745 113         444 my $time = $info[0]{time} - $step;
  113         412  
1746 113 100 100     517 $truncate
1747             and $time < $pass_start
1748             and last;
1749 112         427 my ( $try_azm, $try_elev, $try_rng ) = $sta->azel (
1750             $tle->universal( $time ) );
1751 112 50       865 last if $try_elev < $effective_horizon;
1752 0 0       0 my $litup = $time < $suntim ? 2 - $dawn : 1 + $dawn;
1753 0 0 0     0 1 == $litup
1754             and not $tle->illuminated( $time )
1755             and $litup = 0;
1756 0         0 unshift @info, {
1757             azimuth => $try_azm,
1758             elevation => $try_elev,
1759             event => PASS_EVENT_NONE,
1760             illumination => $lighting[$litup],
1761             range => $try_rng,
1762             time => $time,
1763             };
1764 0         0 redo;
1765             }
1766              
1767             # Compute the exact events.
1768              
1769 113         223 my @time;
1770              
1771             # Compute exact max
1772              
1773             =begin comment
1774              
1775             {
1776             my @try;
1777             if ( @info > 1 ) {
1778             @try = (
1779             [ $info[0]{time}, $sta->azel( $tle->universal(
1780             $info[0]{time} ) ) ],
1781             [ $info[-1]{time}, $sta->azel( $tle->universal(
1782             $info[-1]{time} ) ) ],
1783             );
1784             } else {
1785             my $trial_time = $info[0]{time} - 30;
1786             push @try, [ $trial_time, $sta->azel(
1787             $tle->universal( $trial_time ) ) ];
1788             $trial_time += 60;
1789             push @try, [ $trial_time, $sta->azel(
1790             $tle->universal( $trial_time ) ) ];
1791             }
1792              
1793             while ( $try[1][0] - $try[0][0] > 0.01 ) {
1794             my $middle = ( $try[0][0] + $try[1][0] ) / 2;
1795             my $inx = $try[0][2] > $try[1][2] ? 1 : 0;
1796             splice @try, $inx, 1, [ $middle, $sta->azel(
1797             $tle->universal( $middle ) ) ];
1798             }
1799              
1800             push @time, [ floor( $try[1][0] + .5 ), PASS_EVENT_MAX ];
1801              
1802             }
1803              
1804             =end comment
1805              
1806             =cut
1807              
1808             my ( $trial_start, $trial_finish ) =
1809             ( $info[0]{time} - $pass_step,
1810 113         487 $info[-1]{time} + $pass_step
1811             );
1812 113 100       370 $truncate
1813             and ( $trial_start, $trial_finish ) = (
1814             max( $trial_start, $pass_start ),
1815             min( $trial_finish, $pass_end )
1816             );
1817             my $culmination = find_first_true( $trial_start,
1818             $trial_finish,
1819 983     983   2980 sub { ( $sta->azel( $tle->universal( $_[0] ) ) )[1] >
1820             ( $sta->azel( $tle->universal( $_[0] + 1 ) ) )[1]
1821 113         1366 });
1822 113         836 push @time, [ $culmination, PASS_EVENT_MAX ];
1823              
1824             # Compute exact rise and set.
1825              
1826             $truncate
1827             or ( $trial_start, $trial_finish ) = (
1828 113 100       634 $info[0]{time} - $step, $info[-1]{time} + $step );
1829             my $sat_rise = find_first_true( $trial_start,
1830             $culmination,
1831 844     844   3008 sub { ( $sta->azel( $tle->universal( $_[0] ) ) )[1] >=
1832             $effective_horizon
1833             },
1834 113         960 );
1835             my $sat_set = find_first_true ( $culmination,
1836             $trial_finish,
1837 878     878   3278 sub { ( $sta->azel( $tle->universal( $_[0] ) ) )[1] <
1838             $effective_horizon
1839             },
1840 113         1386 );
1841 113         1047 push @time,
1842             [ $sat_rise, PASS_EVENT_RISE ],
1843             [ $sat_set, PASS_EVENT_SET ],
1844             ;
1845              
1846 113 50       492 warn <
1847              
1848 0         0 Debug - Computed @{[strftime '%d-%b-%Y %H:%M:%S', localtime $time[0][0]
1849             ]} $time[0][1]
1850 0         0 @{[strftime '%d-%b-%Y %H:%M:%S', localtime $time[1][0]
1851             ]} $time[1][1]
1852 0         0 @{[strftime '%d-%b-%Y %H:%M:%S', localtime $time[2][0]
1853             ]} $time[2][1]
1854             eod
1855              
1856             # Because we relaxed the detection criteria to be sure we
1857             # caught all passes, we may have a pass that ended before
1858             # the prediction interval started. Reject that here.
1859              
1860             $sat_set < $pass_start
1861 113 50       414 and do {
1862 0         0 @info = ();
1863 0         0 next;
1864             };
1865              
1866             # Clear the original data.
1867              
1868 113         920 @info = ();
1869              
1870             # Generate the full data for the exact events.
1871              
1872 113         329 my ($suntim, $dawn);
1873 113 50       349 warn "Contents of \@time: ", Dumper (\@time) ## no critic (RequireCarping)
1874             if $debug;
1875 113         1027 foreach (sort {$a->[0] <=> $b->[0]} @time) {
  339         1149  
1876 339         983 my ( $time, $evnt_name, @extra ) = @$_;
1877 339         1015 my ($azm, $elev, $rng) = $sta->azel (
1878             $tle->universal ($time));
1879 339         980 my @illumination;
1880 339 100       1087 if ( $sun ) {
1881 219 100 66     1194 ($suntim, $dawn) =
1882             $sta->universal ($time)->next_elevation ($sun,
1883             $twilight)
1884             if !$suntim || $time >= $suntim;
1885 219 50       664 my $litup = $time < $suntim ? 2 - $dawn : 1 + $dawn;
1886 219 100 66     923 1 == $litup
1887             and not $tle->illuminated( $time )
1888             and $litup = 0;
1889 219         887 push @illumination, illumination => $lighting[$litup];
1890             }
1891 339         3384 push @info, {
1892             azimuth => $azm,
1893             body => $tle,
1894             elevation => $elev,
1895             event => $evnt_name,
1896             range => $rng,
1897             station => $sta,
1898             time => $time,
1899             @illumination,
1900             @extra,
1901             };
1902             }
1903              
1904             # Compute illumination changes
1905              
1906 113 100       810 if ( $sun ) {
1907 73         264 my @illum;
1908             my $prior;
1909 73         194 foreach my $evt ( @info ) {
1910 219 100       561 $prior or next;
1911             $prior->{illumination} == $evt->{illumination}
1912 146 100       441 and next;
1913             my ($suntim, $dawn) =
1914 36         181 $sta->universal ($prior->{time})->
1915             next_elevation ($sun, $twilight);
1916             my $time =
1917             find_first_true ($prior->{time}, $evt->{time},
1918             sub {
1919 282 50   282   732 my $litup = $_[0] < $suntim ?
1920             2 - $dawn : 1 + $dawn;
1921 282 100 66     974 1 == $litup
1922             and not $tle->illuminated( $_[0] )
1923             and $litup = 0;
1924             $lighting[$litup] == $evt->{illumination}
1925 36         496 });
  282         1593  
1926 36         328 my ($azm, $elev, $rng) = $sta->azel (
1927             $tle->universal ($time));
1928             push @illum, {
1929             azimuth => $azm,
1930             body => $tle,
1931             elevation => $elev,
1932             event => $evt->{illumination},
1933             illumination => $evt->{illumination},
1934 36         583 range => $rng,
1935             station => $sta,
1936             time => $time,
1937             };
1938             } continue {
1939 219         514 $prior = $evt;
1940             }
1941 73         263 push @info, @illum;
1942             }
1943              
1944             # Do not record this pass if it turns out not to contain
1945             # any points that meet the recording criteria.
1946              
1947             eval { # So I can return().
1948 113         299 foreach my $event ( @info ) {
1949 319 100       906 $event->{elevation} < $pass_threshold
1950             and next;
1951             not $want_visible
1952 50 100 100     737 or $event->{illumination} == PASS_EVENT_LIT
1953             or next;
1954 47         201 return 1;
1955             }
1956 66         291 return 0;
1957 113 100       231 } or do {
1958 66         448 @info = ();
1959 66         375 next;
1960             };
1961              
1962             # Put the events created thus far into order.
1963              
1964 47         299 @info = sort { $a->{time} <=> $b->{time} } @info;
  168         424  
1965              
1966             # Compute the brightest moment if desired.
1967              
1968 47 50       242 if ( $pass_variant & PASS_VARIANT_BRIGHTEST ) {
1969              
1970 0         0 @info = sort { $a->{time} <=> $b->{time} } @info,
  0         0  
1971             _pass_compute_brightest( $tle, $sta, $sun, \@info );
1972             }
1973              
1974             # If we want visible events only
1975              
1976 47 100       215 if ( $pass_variant & PASS_VARIANT_VISIBLE_EVENTS ) {
1977              
1978             # Filter out anything that does not pass muster
1979              
1980 20         61 @info = grep { $_->{illumination} == PASS_EVENT_LIT ||
1981             $_->{event} == PASS_EVENT_SHADOWED ||
1982 70 100 66     351 $_->{event} == PASS_EVENT_DAY
1983             } @info;
1984              
1985             # If we want to fake a max event if that took place in
1986             # darkness
1987              
1988 20 100 100     114 if ( $pass_variant & PASS_VARIANT_FAKE_MAX &&
1989 41         129 ! grep { $_->{event} == PASS_EVENT_MAX } @info ) {
1990              
1991             # Given that the max got dropped, the fake max is
1992             # either the first or the last point.
1993              
1994             my ( $dup_inx, $splice_inx ) =
1995             $info[0]{elevation} > $info[-1]{elevation} ?
1996 1 50       7 ( 0, 1 ) : ( -1, -1 );
1997              
1998             # Shallow clone, and change the event code to max.
1999              
2000 1         3 my $max = { %{ $info[$dup_inx] } };
  1         12  
2001 1         6 $max->{event} = PASS_EVENT_MAX;
2002              
2003             # Insert the max either just after the first, or
2004             # just before the last event, as the case may be.
2005              
2006 1         8 splice @info, $splice_inx, 0, $max;
2007              
2008             }
2009             }
2010              
2011             # If we want the first and last events to be 'start' and
2012             # 'end', willy-nilly, hammer these codes into them.
2013              
2014 47 100       172 if ( $pass_variant & PASS_VARIANT_START_END ) {
2015 8         31 $info[0]{event} = PASS_EVENT_START;
2016 8         22 $info[-1]{event} = PASS_EVENT_END;
2017             }
2018              
2019             # If PASS_VARIANT_TRUNCATE is in effect, the first and last
2020             # events should be 'start' and 'end' IF AND ONLY IF the
2021             # satellite is above the horizon at that point AND the time
2022             # is at the start or end of the interval. Because the first
2023             # event is AFTER its exact time, we need to back up a bit
2024             # and recalculate.
2025              
2026 47 100       159 if ( $truncate ) {
2027 2         10 my $prior = $info[0]{time} - 1;
2028 2 100       9 if ( $prior <= $pass_start ) {
2029 1         6 my $elevation = ( $sta->azel(
2030             $tle->universal( $prior ) ) )[1];
2031             $elevation > $effective_horizon
2032 1 50       20 and $info[0]{event} = PASS_EVENT_START;
2033             }
2034             $info[-1]{elevation} > $effective_horizon
2035             and $info[-1]{time} >= $pass_end
2036 2 100 66     18 and $info[-1]{event} = PASS_EVENT_END;
2037             }
2038              
2039             # Pick up the first and last event times, to use to bracket
2040             # future calculations.
2041              
2042 47         135 my $first_time = $info[0]{time};
2043 47         123 my $last_time = $info[-1]{time};
2044 47         107 my $number_of_events = @info;
2045              
2046             # Compute nearest approach to background bodies
2047              
2048             # Note (fortuitous discovery) the ISS travels 1.175
2049             # degrees per second at the zenith, so I need better
2050             # than 1 second resolution to detect a transit.
2051              
2052 47         179 foreach my $body (@sky) {
2053             my $when = find_first_true(
2054             _pass_bracket_appulse( $sta, $tle, $body,
2055             $first_time, $last_time ),
2056 571     571   1713 sub {$sta->angle ($body->universal ($_[0]),
2057             $tle->universal ($_[0])) <
2058             $sta->angle ($body->universal ($_[0] + .1),
2059             $tle->universal ($_[0] + .1))},
2060 45         235 .1);
2061 45         420 my $angle =
2062             $sta->angle ($body->universal ($when),
2063             $tle->universal ($when));
2064 45 100       414 next if $angle > $appulse_dist;
2065 12         53 my ( $azimuth, $elevation, $range ) = $sta->azel( $tle );
2066 12         173 push @info, {
2067             body => $tle,
2068             event => PASS_EVENT_APPULSE,
2069             station => $sta,
2070             time => $when,
2071             azimuth => $azimuth,
2072             elevation => $elevation,
2073             range => $range,
2074             appulse => {
2075             angle => $angle,
2076             body => $body,
2077             },
2078             _find_illumination( $sun, $when, \@info ),
2079             };
2080              
2081 12 50       60 warn <<"EOD" if $debug; ## no critic (RequireCarping)
2082 0         0 $time[$#time][1] @{[strftime '%d-%b-%Y %H:%M:%S',
2083             localtime $time[$#time][0]]}
2084             EOD
2085             }
2086              
2087             # Add in the intrinsic events if there are any.
2088 47         295 foreach my $evt (
2089             $tle->intrinsic_events( $first_time, $last_time )
2090             ) {
2091 0         0 my ( $when, $event ) = @{ $evt };
  0         0  
2092 0         0 push @info, {
2093             body => $tle,
2094             event => $event,
2095             station => $sta,
2096             time => $when,
2097             _find_illumination( $sun, $when, \@info ),
2098             $tle->_find_position( $sta, $when ),
2099             };
2100             }
2101              
2102             # If we're verbose, calculate the points.
2103              
2104 47 100       158 if ( $verbose ) {
2105              
2106 2         13 my %events = map { $_->{time} => 1 } @info;
  6         29  
2107 2         18 for ( my $it = ceil( $first_time ); $it < $last_time;
2108             $it += $verbose ) {
2109              
2110             # If we already have an event for this time, skip.
2111              
2112 32 100       82 $events{$it} and next;
2113              
2114             # The next line of code relies on the fact that the
2115             # events from rise through max and set are already
2116             # in chronological order. Yes, in theory we step off
2117             # the end of that part of @info, but in practice we
2118             # exit the for loop before we get to that point.
2119              
2120 30         78 push @info, {
2121             body => $tle,
2122             event => PASS_EVENT_NONE,
2123             station => $sta,
2124             time => $it,
2125             _find_illumination( $sun, $it, \@info ),
2126             $tle->_find_position( $sta, $it ),
2127             };
2128             }
2129             }
2130              
2131             # Sort the data again if we have added events.
2132              
2133             @info > $number_of_events
2134 47 100       228 and @info = sort { $a->{time} <=> $b->{time} } @info;
  158         320  
2135              
2136             # Record the data for the pass.
2137              
2138 47 50       186 confess <
2139             Programming error - \$culmination undefined at end of pass calculation.
2140             eod
2141 47         303 push @passes, {
2142             body => $tle,
2143             events => [@info],
2144             time => $culmination,
2145             };
2146              
2147             # Clear out the data.
2148              
2149 47         148 @info = ();
2150 47         114 $visible = 0;
2151 47         102 $culmination = undef;
2152 47         353 next;
2153             }
2154              
2155             { # Localize
2156              
2157             # Calculate whether the body is visible.
2158              
2159 661         1055 my @illumination;
  661         1002  
2160 661 100       1317 if ( $sun ) {
2161 415 50       966 my $litup = $time < $sun_screen ? 2 - $dawn : 1 + $dawn;
2162 415         1109 my $sun_elev_from_sat = $tle->__sun_elev_from_sat( $time );
2163 415   66     1531 $visible ||= $elev > $screening_horizon && (
      100        
2164             ! $want_visible ||
2165             $litup == 1 && $sun_elev_from_sat >= $min_sun_elev_from_sat
2166             );
2167 415 50       991 $litup = $time < $suntim ? 2 - $dawn : 1 + $dawn;
2168 415 100 66     1553 $litup == 1
2169             and $sun_elev_from_sat < 0
2170             and $litup = 0;
2171 415         1311 push @illumination, illumination => $lighting[$litup];
2172             } else {
2173 246         469 $visible = $elev > $screening_horizon;
2174             }
2175              
2176             # Accumulate results.
2177              
2178 661         5895 push @info, {
2179             azimuth => $azm,
2180             elevation => $elev,
2181             event => PASS_EVENT_NONE,
2182             range => $rng,
2183             time => $time,
2184             @illumination,
2185             };
2186              
2187             }
2188              
2189             }
2190 14         297 return @passes;
2191              
2192             }
2193              
2194             # The problem the following attempts to deal with is that if two
2195             # satellites with similar orbits rise about the same time, they may
2196             # appear to approach, diverge, and approach again. The last apparent
2197             # approach is because they are receding from the observer faster than
2198             # from each other.
2199             #
2200             # What the following code attempts to do is to provide reasonable
2201             # brackets around the time of closest approach. If the body is a TLE
2202             # object, we step across the pass in 30-second intervals, and return the
2203             # interval 30 seconds before and after the closest position found.
2204             # Otherwise we just return the beginning and end of the pass.
2205             #
2206             # Originally there was an attempt to determine if the orbits were
2207             # "sufficiently close", and only step across if that was the case. But
2208             # it proved impracticable to define "sufficiently close", and it was
2209             # determined by benchmarking that the preliminary stepping had only a
2210             # minimal effect on the algorithm's execution time. So we step any time
2211             # we are computing an appulse of an artificial satellite to another
2212             # artificial satellite.
2213              
2214             {
2215              
2216             # The following manifest constant is to be used only here. Pretend
2217             # it is localized.
2218              
2219 16     16   141 use constant APPULSE_CHECK_STEP => 30; # seconds
  16         56  
  16         219323  
2220              
2221             sub _pass_bracket_appulse {
2222 45     45   173 my ( $sta, $tle, $body, $first_time, $last_time ) = @_;
2223              
2224             # The problem we're trying to avoid does not occur unless the
2225             # body is a TLE.
2226 45 100       209 embodies( $body, 'Astro::Coord::ECI::TLE' )
2227             or return ( $first_time, $last_time );
2228              
2229             # OK, we think we have a problem. Step across the entire pass in
2230             # 30-second intervals and find the one where the two bodies
2231             # approach most closely.
2232 1         6 my ( $smallest, $mark );
2233 1         8 for ( my $time = $first_time; $time <= $last_time;
2234             $time += APPULSE_CHECK_STEP
2235             ) {
2236 16         41 my $angle = $sta->angle(
2237             $body->universal( $time ),
2238             $tle->universal( $time ),
2239             );
2240 16 100 66     90 defined $smallest
2241             and $angle > $smallest
2242             or ( $smallest, $mark ) = ( $angle, $time );
2243             }
2244              
2245             # We return an interval around this closest point as the
2246             # interval in which to apply the binary search algorithm.
2247             return (
2248 1         16 max( $mark - APPULSE_CHECK_STEP, $first_time ),
2249             min( $mark + APPULSE_CHECK_STEP, $last_time ),
2250             );
2251             }
2252             }
2253              
2254             # Compute the position of the satellite at its brightest. We expect to
2255             # be called only if the computation makes sense -- that is, if the
2256             # intrinsic_magnitude attribute is set and we are calculating
2257             # visibility. We will return an event hash, or nothing if there are no
2258             # illuminated points. We will return nothing with a warning if there is
2259             # exactly one illuminated point, since we can't conveniently make the
2260             # calculation from this and it should not happen anyway.
2261             #
2262             # The arguments are:
2263             # $tle - The orbiting body
2264             # $sta - The observing body
2265             # $sun - The illuminating body (assumed defined)
2266             # $info - A reference to the array of events computed thus far, in order
2267             # by time.
2268             #
2269             # The $info array is assumed to already have visibility and visibility
2270             # events calculated.
2271             sub _pass_compute_brightest {
2272 0     0   0 my ( $tle, $sta, $sun, $info ) = @_;
2273 0         0 my @wrk = @{ $info };
  0         0  
2274              
2275             # We skip over all the un-illuminated events at the start.
2276 0         0 while ( $wrk[0]{illumination} == PASS_EVENT_SHADOWED ) {
2277 0         0 shift @wrk;
2278             @wrk
2279 0 0       0 or return;
2280             }
2281 0         0 my $earliest = $wrk[0]{time};
2282              
2283             # We want the time of the first shadowed event, since we're
2284             # illuminated up to that point.
2285 0         0 my $latest = $wrk[-1]{time};
2286 0         0 while ( $wrk[-1]{illumination} == PASS_EVENT_SHADOWED ) {
2287 0         0 $latest = $wrk[-1]{time};
2288 0         0 pop @wrk;
2289             @wrk
2290 0 0       0 or return;
2291             }
2292              
2293             # We back off a second from the time of the shadow (or set) event,
2294             # to get a time when we are illuminated and above the horizon.
2295 0         0 $latest -= 1;
2296             @wrk > 1
2297 0 0       0 or do {
2298             # carp 'No magnitude calculation done: only one illuminated position';
2299 0         0 return;
2300             };
2301              
2302             # Because the behavior is non-linear, we step through the time at
2303             # 30-second intervals, then at 1-second intervals to find the
2304             # brightest.
2305 0         0 my $twilight = $tle->get( 'twilight' );
2306 0         0 foreach my $delta ( 30, 1 ) {
2307 0         0 @wrk = ();
2308 0         0 for ( my $time = $earliest; $time <= $latest; $time += $delta ) {
2309 0         0 push @wrk, [
2310             $time,
2311             $tle->universal( $time )->magnitude( $sta ),
2312             ];
2313             }
2314             # Because our time span is probably not a multiple of our step
2315             # size, we slap the last time onto the end.
2316 0 0       0 $wrk[-1][0] < $latest
2317             and push @wrk, [
2318             $latest,
2319             $tle->universal( $latest )->magnitude( $sta ),
2320             ];
2321              
2322             # The next interval becomes the brightest and second-brightest
2323             # time found.
2324 0         0 @wrk = sort { $a->[1] <=> $b->[1] } grep { defined $_->[1] } @wrk;
  0         0  
  0         0  
2325 0         0 ( $earliest, $latest ) = sort { $a <=> $b }
2326 0         0 map { $wrk[$_][0] } 0, 1;
  0         0  
2327             }
2328              
2329             # Make up and return the event.
2330 0         0 my $time = $wrk[0][0];
2331 0         0 my ( $azm, $elev, $rng ) =
2332             $sta->azel( $tle->universal( $time ) );
2333 0         0 my ( undef, $sun_elev ) = $sta->azel( $sun->universal(
2334             $time ) );
2335 0 0       0 my $illum = $sun_elev < $twilight ?
2336             PASS_EVENT_LIT :
2337             PASS_EVENT_DAY;
2338             return {
2339 0         0 azimuth => $azm,
2340             body => $tle,
2341             elevation => $elev,
2342             event => PASS_EVENT_BRIGHTEST,
2343             illumination => $illum,
2344             magnitude => $wrk[0][1],
2345             range => $rng,
2346             station => $sta,
2347             time => $time,
2348             };
2349             }
2350              
2351             =item $kilometers = $tle->periapsis();
2352              
2353             This method returns the periapsis of the orbit, in kilometers. Since
2354             Astro::Coord::ECI::TLE objects always represent bodies orbiting the
2355             Earth, this is more usually called perigee.
2356              
2357             Note that this is the distance from the center of the Earth, not the
2358             altitude.
2359              
2360             =cut
2361              
2362             sub periapsis {
2363 8     8 1 42 my $self = shift;
2364             return $self->{&TLE_INIT}{TLE_periapsis} ||=
2365 8   66     39 (1 - $self->get('eccentricity')) * $self->semimajor();
2366             }
2367              
2368             =item $kilometers = $tle->perigee();
2369              
2370             This method is simply a synonym for periapsis().
2371              
2372             =cut
2373              
2374             *perigee = \&periapsis;
2375              
2376             =item $seconds = $tle->period ($model);
2377              
2378             This method returns the orbital period of the object in seconds using
2379             the given model. If the model is unspecified (or specified as a false
2380             value), the current setting of the 'model' attribute is used.
2381              
2382             There are actually only two period calculations available. If the model
2383             is 'sgp4r' (or its equivalents 'model' and 'model4r'), the sgp4r
2384             calculation will be used. Otherwise the calculation from the original
2385             Space Track Report Number 3 will be used. 'Otherwise' includes the case
2386             where the model is 'null'.
2387              
2388             The difference between using the original and the revised algorithm is
2389             minimal. For the objects in the sgp4-ver.tle file provided with the
2390             'Revisiting Spacetrack Report #3' code, the largest is about 50
2391             nanoseconds for OID 23333, which is in a highly eccentric orbit.
2392              
2393             The difference between using the various values of gravconst_r with
2394             sgp4r is somewhat more pronounced. Among the objects in sgp4-ver.tle the
2395             largest difference was about a millisecond, again for OID 23333.
2396              
2397             Neither of these differences seems to me significant, but I thought it
2398             would be easier to take the model into account than to explain why I did
2399             not.
2400              
2401             A note on subclassing: A body that is not in orbit should return a
2402             period of C.
2403              
2404             =cut
2405              
2406             {
2407             my %model_map = (
2408             model => \&_period_r,
2409             model4r => \&_period_r,
2410             sgp4r => \&_period_r,
2411             );
2412             sub period {
2413 52     52 1 13004 my $self = shift;
2414 52   100     416 my $code = $model_map{shift || $self->{model}} || \&_period;
2415 52         159 return $code->($self);
2416             }
2417             }
2418              
2419             # Original period calculation, recast to remove an equivocation on
2420             # where the period was cached, which caused the cache to be
2421             # ineffective.
2422              
2423             sub _period {
2424 2     2   4 my $self = shift;
2425 2   33     8 return $self->{&TLE_INIT}{TLE_period} ||= do {
2426 2         11 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
2427             my $temp = 1.5 * SGP_CK2 * (3 * cos ($self->{inclination}) ** 2 - 1) /
2428 2         36 (1 - $self->{eccentricity} * $self->{eccentricity}) ** 1.5;
2429 2         4 my $del1 = $temp / ($a1 * $a1);
2430 2         6 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD +
2431             $del1 * (1 + 134/81 * $del1)));
2432 2         4 my $del0 = $temp / ($a0 * $a0);
2433 2         4 my $xnodp = $self->{meanmotion} / (1 + $del0);
2434 2         17 SGP_TWOPI / $xnodp * SGP_XSCPMN;
2435             };
2436             }
2437              
2438             # Compute period using sgp4r's adjusted mean motion. Yes, I took
2439             # the coward's way out and initialized the model, but we use this
2440             # only if the model is sgp4r (implying that it will be initialized
2441             # anyway) or if the user explicitly asked for it.
2442              
2443             sub _period_r {
2444 50     50   123 my ($self) = @_;
2445 50   66     339 my $parm = $self->{&TLE_INIT}{TLE_sgp4r} ||= $self->_r_sgp4init ();
2446 50         592 return &SGP_TWOPI/$parm->{meanmotion} * 60;
2447             }
2448              
2449             =item $tle = $tle->rebless ($class, \%possible_attributes)
2450              
2451             This method reblesses a TLE object. The class must be either
2452             L or a subclass thereof, as must
2453             the object passed in to be reblessed. If the $tle object has its
2454             C attribute false, it will not be reblessed,
2455             but will be returned unmodified. Before reblessing, the
2456             before_reblessing() method is called. After reblessing, the
2457             after_reblessing() method is called with the \%possible_attributes hash
2458             reference as argument.
2459              
2460             It is possible to omit the $class argument if the \%possible_attributes
2461             argument contains the keys {class} or {type}, taken in that order. If
2462             the $class argument is omitted and the \%possible_attributes hash does
2463             B have the requisite keys, the $tle object is unmodified.
2464              
2465             It is also possible to omit both arguments, in which case the object
2466             will be reblessed according to the content of the internal status
2467             table.
2468              
2469             For convenience, you can pass an alias instead of the full class name. The
2470             following aliases are recognized:
2471              
2472             tle => 'Astro::Coord::ECI::TLE'
2473              
2474             If you install
2475             L it
2476             will define alias
2477              
2478             iridium => 'Astro::Coord::ECI::TLE::Iridium'
2479              
2480             Other aliases may be defined with the alias() static method.
2481              
2482             Note that this method returns the original object (possibly reblessed).
2483             It does not under any circumstances manufacture another object.
2484              
2485             =cut
2486              
2487             sub rebless {
2488 87     87 1 182 my ($tle, @args) = @_;
2489 87 50       284 __instance( $tle, __PACKAGE__ ) or croak <
2490 0         0 Error - You can only rebless an object of class @{[__PACKAGE__]}
2491             or a subclass thereof. The object you are trying to rebless
2492 0         0 is of class @{[ref $tle]}.
2493             eod
2494 87 50       222 $tle->get ('reblessable') or return $tle;
2495 87 50       210 @args or do {
2496 87 50       165 my $id = $tle->get ('id') or return $tle;
2497 87 50       450 $id =~ m/ [^0-9] /smx
2498             or $id = sprintf '%05d', $id;
2499 87   50     691 @args = $status{$id} || 'tle';
2500             };
2501             my $class = HASH_REF eq ref $args[0] ?
2502 87 50 0     330 ($args[0]->{class} || $args[0]->{type}) : shift @args
    50          
2503             or return $tle;
2504 87 50       256 $class = $type_map{$class} if $type_map{$class};
2505 87         250 load_module ($class);
2506 87 50       202 __classisa( $class, __PACKAGE__ ) or croak <
2507 0         0 Error - You can only rebless an object into @{[__PACKAGE__]} or
2508             a subclass thereof. You are trying to rebless the object
2509             into $class.
2510             eod
2511 87         263 $tle->before_reblessing ();
2512 87         146 bless $tle, $class;
2513 87         214 $tle->after_reblessing (@args);
2514 87         163 return $tle;
2515             }
2516              
2517             =item $kilometers = $tle->semimajor();
2518              
2519             This method calculates the semimajor axis of the orbit, using Kepler's
2520             Third Law (Isaac Newton's version) in the form
2521              
2522             T ** 2 / a ** 3 = 4 * pi ** 2 / mu
2523              
2524             where
2525              
2526             T is the orbital period,
2527             a is the semimajor axis of the orbit,
2528             pi is the circle ratio (3.14159 ...), and
2529             mu is the Earth's gravitational constant,
2530             3.986005e5 km ** 3 / sec ** 2
2531              
2532             The calculation is carried out using the period implied by the current
2533             model.
2534              
2535             =cut
2536              
2537             {
2538             my $mu = 3.986005e5; # km ** 3 / sec ** 2 -- for Earth.
2539             sub semimajor {
2540 12     12 1 37 my $self = shift;
2541 12   66     61 return $self->{&TLE_INIT}{TLE_semimajor} ||= do {
2542 4         11 my $to2pi = $self->period / SGP_TWOPI;
2543 4         33 exp (log ($to2pi * $to2pi * $mu) / 3);
2544             };
2545             }
2546             }
2547              
2548             =item $kilometers = $tle->semiminor();
2549              
2550             This method calculates the semiminor axis of the orbit, using the
2551             semimajor axis and the eccentricity, by the equation
2552              
2553             b = a * sqrt(1 - e)
2554              
2555             where a is the semimajor axis and e is the eccentricity.
2556              
2557             =cut
2558              
2559             sub semiminor {
2560 0     0 1 0 my $self = shift;
2561 0   0     0 return $self->{&TLE_INIT}{TLE_semiminor} ||= do {
2562 0         0 my $e = $self->get('eccentricity');
2563 0         0 $self->semimajor() * sqrt(1 - $e * $e);
2564             };
2565             }
2566              
2567             =item $tle->set (attribute => value ...)
2568              
2569             This method sets the values of the various attributes. The changing of
2570             attributes actually used by the orbital models will cause the models to
2571             be reinitialized. This happens transparently, and is no big deal. For
2572             a description of the attributes, see L.
2573              
2574             Because this is a subclass of L,
2575             any attributes of that class can also be set.
2576              
2577             =cut
2578              
2579             sub set {
2580 216     216 1 4967 my ($self, @args) = @_;
2581 216 50       613 @args % 2 and croak "The set method takes an even number of arguments.";
2582 216         378 my ($clear, $extant);
2583 216 50       488 if (ref $self) {
2584 216         382 $extant = \%attrib;
2585             } else {
2586 0         0 $self = $extant = \%static;
2587             }
2588 216         469 while (@args) {
2589 2112         3180 my $name = shift @args;
2590 2112         3002 my $val = shift @args;
2591 2112 100       3984 exists $extant->{$name} or do {
2592 194         637 $self->SUPER::set ($name, $val);
2593 194         458 next;
2594             };
2595 1918 50       3377 defined $attrib{$name} or croak "Attribute $name is read-only.";
2596 1918 100       3453 if ( CODE_REF eq ref $attrib{$name} ) {
2597 684 100       1553 $attrib{$name}->($self, $name, $val) and $clear = 1;
2598             } else {
2599 1234         2434 $self->{$name} = $val;
2600 1234   100     3083 $clear ||= $attrib{$name};
2601             }
2602             }
2603 216 100       572 $clear and delete $self->{&TLE_INIT};
2604 216         431 return $self;
2605             }
2606              
2607             =item Astro::Coord::ECI::TLE->status (command => arguments ...)
2608              
2609             This method maintains the internal status table, which is used by the
2610             parse() method to determine which subclass (if any) to bless the
2611             created object into. The first argument determines what is done to the
2612             status table; subsequent arguments depend on the first argument. Valid
2613             commands and arguments are:
2614              
2615             status (add => $id, $type => $status, $name, $comment) adds an item to
2616             the status table or modifies an existing item. The $id is the NORAD ID
2617             of the body.
2618              
2619             No types are supported out of the box, but if you have installed
2620             L that
2621             or C<'iridium'> will work.
2622              
2623             The $status is 0, 1, 2, or 3 representing in-service, spare, failed, or
2624             decayed respectively. The strings '+' or '' will be interpreted as 0,
2625             'S', 's', or '?' as 1, 'D' as 3, and any other non-numeric string as 2.
2626             The $name and $comment arguments default to empty.
2627              
2628             status ('clear') clears the status table.
2629              
2630             status (clear => 'type') clears all entries of the given type in the
2631             status table. For supported types, see the discussion of 'add',
2632             above.
2633              
2634             status (drop => $id) removes the given NORAD ID from the status table.
2635              
2636             status ('show') returns a list of list references, representing the
2637             'add' commands which would be used to regenerate the status table.
2638              
2639             Initially, the status table is populated with the status as of December
2640             3, 2010.
2641              
2642             =cut
2643              
2644             sub status {
2645 0     0 1 0 my ( undef, $cmd, @arg ) = @_; # Invocant unused
2646 0 0       0 if ($cmd eq 'add') {
    0          
    0          
    0          
    0          
    0          
2647 0         0 my ( $id, $type, $status, $name, $comment ) = @arg;
2648 0 0       0 $id or croak <
2649             Error - The status ('add') call requires a NORAD ID.
2650             eod
2651 0 0       0 $id =~ m/ [^0-9] /smx
2652             or $id = sprintf '%05d', $id;
2653 0 0       0 $type or croak <
2654             Error - The status (add => $id) call requires a type.
2655             eod
2656 0   0     0 my $class = $type_map{$type} || $type;
2657 0 0       0 __classisa( $class, __PACKAGE__ ) or croak <
2658 0         0 Error - $type must specify a subclass of @{[__PACKAGE__]}.
2659             eod
2660 0   0     0 $status ||= 0;
2661 0 0       0 if ( my $code = $class->can( '__decode_operational_status' ) ) {
2662 0         0 $status = $code->( $status );
2663             }
2664 0   0     0 $name ||= '';
2665 0   0     0 $comment ||='';
2666 0         0 $status{$id} = {
2667             comment => $comment,
2668             status => $status,
2669             name => $name,
2670             id => $id,
2671             type => $type,
2672             class => $class,
2673             };
2674             } elsif ($cmd eq 'clear') {
2675 0         0 my ( $type ) = @arg;
2676 0 0       0 if (!defined $type) {
2677 0         0 %status = ();
2678             } else {
2679 0   0     0 my $class = $type_map{$type} || $type;
2680 0 0       0 __classisa( $class, __PACKAGE__ ) or croak <
2681 0         0 Error - $type must specify a subclass of @{[__PACKAGE__]}.
2682             eod
2683 0         0 foreach my $key (keys %status) {
2684 0 0       0 $status{$key}{class} eq $class and delete $status{$key};
2685             }
2686             }
2687             } elsif ($cmd eq 'drop') {
2688 0 0       0 my $id = $arg[0] or croak <
2689             Error - The status ('drop') call requires a NORAD ID.
2690             eod
2691 0         0 delete $status{$id};
2692             } elsif ($cmd eq 'dump') { # <<<< Undocumented!!!
2693             # This functionality is UNDOCUMENTED and UNSUPPORTED. It exists
2694             # for the convenience of the author, who reserves the right to
2695             # change or revoke it without notice.
2696             # If called in void context, prints a Data::Dumper dump of the
2697             # status information; otherwise returns the dump.
2698 0         0 local $Data::Dumper::Terse = 1;
2699 0         0 local $Data::Dumper::Sortkeys = 1;
2700             my $data = @arg ?
2701 0 0       0 +{ map { $_ => $status{$_} } grep { $status{$_} } @arg } :
  0         0  
  0         0  
2702             \%status;
2703             defined wantarray
2704 0 0       0 and return __PACKAGE__ . ' status = ', Dumper( $data );
2705 0         0 print __PACKAGE__, " status = ", Dumper ( $data );
2706             } elsif ($cmd eq 'show') {
2707             return (
2708 0         0 sort { $a->[0] <=> $b->[0] }
2709             map { [ $_->{id}, $_->{type}, $_->{status}, $_->{name},
2710 0         0 $_->{comment} ] }
2711 0 0       0 map { defined $status{$_} ? $status{$_} : () }
  0 0       0  
2712             @arg ? @arg : keys %status
2713             );
2714             } elsif ($cmd eq 'yaml') { # <<<< Undocumented!!!
2715             # This functionality is UNDOCUMENTED and UNSUPPORTED. It exists
2716             # for the convenience of the author, who reserves the right to
2717             # change or revoke it without notice.
2718             # If called in void context, prints a YAML dump of the status
2719             # information; otherwise returns the YAML dump.
2720 0 0       0 load_module( 'YAML' )
2721             or croak 'YAML not available';
2722             my $data = @arg ?
2723 0 0       0 +{ map { $_ => $status{$_} } grep { $status{$_} } @arg } :
  0         0  
  0         0  
2724             \%status;
2725             defined wantarray
2726 0 0       0 and return YAML::Dump( $data );
2727 0         0 print YAML::Dump( $data );
2728             } else {
2729 0         0 croak <
2730             Error - '$cmd' is not a legal status() command.
2731             eod
2732             }
2733 0         0 return;
2734             }
2735              
2736             =item $tle = $tle->sgp($time)
2737              
2738             This method calculates the position of the body described by the TLE
2739             object at the given time, using the SGP model. The universal time of the
2740             object is set to $time, and the 'equinox_dynamical' attribute is set to
2741             to the current value of the 'epoch_dynamical' attribute.
2742              
2743             The result is the original object reference. You need to call one of
2744             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
2745             retrieve the position you just calculated.
2746              
2747             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
2748             model can be used for either near-earth or deep-space orbits, but the
2749             reference implementation they provide dies on an attempt to use this
2750             model for a deep-space object, and I have followed the reference
2751             implementation.
2752              
2753             =cut
2754              
2755             sub sgp {
2756 7     7 1 22 my ($self, $time) = @_;
2757 7         15 my $oid = $self->get('id');
2758 7         18 $self->{model_error} = undef;
2759 7         22 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
2760              
2761             #* Initialization.
2762              
2763             #>>> Rather than use a separate indicator argument to trigger
2764             #>>> initialization of the model, we use the Orcish maneuver to
2765             #>>> retrieve the results of initialization, performing the
2766             #>>> calculations if needed. -- TRW
2767              
2768 7   66     39 my $parm = $self->{&TLE_INIT}{TLE_sgp} ||= do {
2769 2 50       11 $self->is_deep and croak <
2770             Error - The SGP model is not valid for deep space objects.
2771             Use the SDP4, SDP4R, or SDP8 models instead.
2772             EOD
2773 2         12 my $c1 = SGP_CK2 * 1.5;
2774 2         10 my $c2 = SGP_CK2 / 4;
2775 2         4 my $c3 = SGP_CK2 / 2;
2776 2         5 my $c4 = SGP_XJ3 * SGP_AE ** 3 / (4 * SGP_CK2);
2777 2         8 my $cosi0 = cos ($self->{inclination});
2778 2         13 my $sini0 = sin ($self->{inclination});
2779 2         9 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
2780             my $d1 = $c1 / $a1 / $a1 * (3 * $cosi0 * $cosi0 - 1) /
2781 2         21 (1 - $self->{eccentricity} * $self->{eccentricity}) ** 1.5;
2782 2         8 my $a0 = $a1 *
2783             (1 - 1/3 * $d1 - $d1 * $d1 - 134/81 * $d1 * $d1 * $d1);
2784 2         7 my $p0 = $a0 * (1 - $self->{eccentricity} * $self->{eccentricity});
2785 2         5 my $q0 = $a0 * (1 - $self->{eccentricity});
2786             my $xlo = $self->{meananomaly} + $self->{argumentofperigee} +
2787 2         6 $self->{ascendingnode};
2788 2         3 my $d10 = $c3 * $sini0 * $sini0;
2789 2         7 my $d20 = $c2 * (7 * $cosi0 * $cosi0 - 1);
2790 2         3 my $d30 = $c1 * $cosi0;
2791 2         4 my $d40 = $d30 * $sini0;
2792 2         5 my $po2no = $self->{meanmotion} / ($p0 * $p0);
2793 2         8 my $omgdt = $c1 * $po2no * (5 * $cosi0 * $cosi0 - 1);
2794 2         5 my $xnodot = -2 * $d30 * $po2no;
2795 2         7 my $c5 = .5 * $c4 * $sini0 * (3 + 5 * $cosi0) / (1 + $cosi0);
2796 2         4 my $c6 = $c4 * $sini0;
2797 2 50       17 $self->{debug} and warn <
2798             Debug sgp initialization -
2799             A0 = $a0
2800             C5 = $c5
2801             C6 = $c6
2802             D10 = $d10
2803             D20 = $d20
2804             D30 = $d30
2805             D40 = $d40
2806             OMGDT = $omgdt
2807             Q0 = $q0
2808             XLO = $xlo
2809             XNODOT = $xnodot
2810             eod
2811             {
2812 2         26 a0 => $a0,
2813             c5 => $c5,
2814             c6 => $c6,
2815             d10 => $d10,
2816             d20 => $d20,
2817             d30 => $d30,
2818             d40 => $d40,
2819             omgdt => $omgdt,
2820             q0 => $q0,
2821             xlo => $xlo,
2822             xnodot => $xnodot,
2823             };
2824             };
2825              
2826             #* Update for secular gravity and atmospheric drag.
2827              
2828             my $a = $self->{meanmotion} +
2829             (2 * $self->{firstderivative} +
2830 7         23 3 * $self->{secondderivative} * $tsince) * $tsince;
2831             # $a is only magic inside certain constructions, but Perl::Critic
2832             # either does not know this, or does not realize that it is a
2833             # lexical variable here.
2834             $a = ## no critic (RequireLocalizedPunctuationVars)
2835 7         22 $parm->{a0} * ($self->{meanmotion} / $a) ** SGP_TOTHRD;
2836 7 100       22 my $e = $a > $parm->{q0} ? 1 - $parm->{q0} / $a : SGP_E6A;
2837 7         13 my $p = $a * (1 - $e * $e);
2838 7         14 my $xnodes = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
2839 7         12 my $omgas = $self->{argumentofperigee} + $parm->{omgdt} * $tsince;
2840             my $xls = mod2pi ($parm->{xlo} + ($self->{meanmotion} + $parm->{omgdt} +
2841             $parm->{xnodot} + ($self->{firstderivative} +
2842 7         33 $self->{secondderivative} * $tsince) * $tsince) * $tsince);
2843 7 50       23 $self->{debug} and warn <
2844             Debug sgp - atmospheric drag and gravity
2845             TSINCE = $tsince
2846             A = $a
2847             E = $e
2848             P = $p
2849             XNODES = $xnodes
2850             OMGAS = $omgas
2851             XLS = $xls
2852             eod
2853              
2854             #* Long period periodics.
2855              
2856 7         15 my $axnsl = $e * cos ($omgas);
2857 7         19 my $aynsl = $e * sin ($omgas) - $parm->{c6} / $p;
2858 7         28 my $xl = mod2pi ($xls - $parm->{c5} / $p * $axnsl);
2859 7 50       17 $self->{debug} and warn <
2860             Debug sgp - long period periodics
2861             AXNSL = $axnsl
2862             AYNSL = $aynsl
2863             XL = $xl
2864             eod
2865              
2866             #* Solve Kepler's equation.
2867              
2868 7         16 my $u = mod2pi ($xl - $xnodes);
2869 7         18 my ($item3, $eo1, $tem5) = (0, $u, 1);
2870 7         12 my ($sineo1, $coseo1);
2871 7         16 while (1) {
2872 27         45 $sineo1 = sin ($eo1);
2873 27         41 $coseo1 = cos ($eo1);
2874 27 100 66     102 last if abs ($tem5) < SGP_E6A || $item3++ >= 10;
2875 20         37 $tem5 = 1 - $coseo1 * $axnsl - $sineo1 * $aynsl;
2876 20         32 $tem5 = ($u - $aynsl * $coseo1 + $axnsl * $sineo1 - $eo1) / $tem5;
2877 20         35 my $tem2 = abs ($tem5);
2878 20 100       44 $tem2 > 1 and $tem5 = $tem2 / $tem5;
2879 20         28 $eo1 += $tem5;
2880             }
2881 7 50       21 $self->{debug} and warn <
2882             Debug sgp - solve equation of Kepler
2883             U = $u
2884             EO1 = $eo1
2885             SINEO1 = $sineo1
2886             COSEO1 = $coseo1
2887             eod
2888              
2889             #* Short period preliminary quantities.
2890              
2891 7         21 my $ecose = $axnsl * $coseo1 + $aynsl * $sineo1;
2892 7         12 my $esine = $axnsl * $sineo1 - $aynsl * $coseo1;
2893 7         14 my $el2 = $axnsl * $axnsl + $aynsl * $aynsl;
2894             $self->{debug}
2895 7 50       23 and warn "Debug - OID $oid sgp effective eccentricity $el2\n";
2896 7 100       629 $el2 > 1 and croak "Error - OID $oid Sgp effective eccentricity > 1";
2897 5         8 my $pl = $a * (1 - $el2);
2898 5         9 my $pl2 = $pl * $pl;
2899 5         9 my $r = $a * (1 - $ecose);
2900 5         7 my $rdot = SGP_XKE * sqrt ($a) / $r * $esine;
2901 5         6 my $rvdot = SGP_XKE * sqrt ($pl) / $r;
2902 5         17 my $temp = $esine / (1 + sqrt (1 - $el2));
2903 5         9 my $sinu = $a / $r * ($sineo1 - $aynsl - $axnsl * $temp);
2904 5         12 my $cosu = $a / $r * ($coseo1 - $axnsl + $aynsl * $temp);
2905 5         16 my $su = _actan ($sinu, $cosu);
2906 5 50       14 $self->{debug} and warn <
2907             Debug sgp - short period preliminary quantities
2908             PL2 = $pl2
2909             R = $r
2910             RDOT = $rdot
2911             RVDOT = $rvdot
2912             SINU = $sinu
2913             COSU = $cosu
2914             SU = $su
2915             eod
2916              
2917             #* Update for short periodics.
2918              
2919 5         8 my $sin2u = ($cosu + $cosu) * $sinu;
2920 5         11 my $cos2u = 1 - 2 * $sinu * $sinu;
2921 5         10 my $rk = $r + $parm->{d10} / $pl * $cos2u;
2922 5         9 my $uk = $su - $parm->{d20} / $pl2 * $sin2u;
2923 5         9 my $xnodek = $xnodes + $parm->{d30} * $sin2u / $pl2;
2924 5         9 my $xinck = $self->{inclination} + $parm->{d40} / $pl2 * $cos2u;
2925              
2926             #* Orientation vectors.
2927              
2928 5         9 my $sinuk = sin ($uk);
2929 5         6 my $cosuk = cos ($uk);
2930 5         10 my $sinnok = sin ($xnodek);
2931 5         6 my $cosnok = cos ($xnodek);
2932 5         9 my $sinik = sin ($xinck);
2933 5         13 my $cosik = cos ($xinck);
2934 5         13 my $xmx = - $sinnok * $cosik;
2935 5         6 my $xmy = $cosnok * $cosik;
2936 5         7 my $ux = $xmx * $sinuk + $cosnok * $cosuk;
2937 5         9 my $uy = $xmy * $sinuk + $sinnok * $cosuk;
2938 5         6 my $uz = $sinik * $sinuk;
2939 5         8 my $vx = $xmx * $cosuk - $cosnok * $sinuk;
2940 5         8 my $vy = $xmy * $cosuk - $sinnok * $sinuk;
2941 5         7 my $vz = $sinik * $cosuk;
2942              
2943             #* Position and velocity.
2944              
2945 5         7 my $x = $rk * $ux;
2946 5         7 my $y = $rk * $uy;
2947 5         11 my $z = $rk * $uz;
2948 5         8 my $xdot = $rdot * $ux;
2949 5         9 my $ydot = $rdot * $uy;
2950 5         8 my $zdot = $rdot * $uz;
2951 5         7 $xdot = $rvdot * $vx + $xdot;
2952 5         10 $ydot = $rvdot * $vy + $ydot;
2953 5         6 $zdot = $rvdot * $vz + $zdot;
2954              
2955 5         15 return _convert_out($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
2956             }
2957              
2958             =item $tle = $tle->sgp4($time)
2959              
2960             This method calculates the position of the body described by the TLE
2961             object at the given time, using the SGP4 model. The universal time of
2962             the object is set to $time, and the 'equinox_dynamical' attribute is set
2963             to the current value of the 'epoch_dynamical' attribute.
2964              
2965             The result is the original object reference. See the L
2966             heading above for how to retrieve the coordinates you just calculated.
2967              
2968             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
2969             model can be used only for near-earth orbits.
2970              
2971             =cut
2972              
2973             sub sgp4 {
2974 7     7 1 25 my ($self, $time) = @_;
2975 7         17 my $oid = $self->get('id');
2976 7         26 $self->{model_error} = undef;
2977 7         20 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
2978              
2979             #>>> Rather than use a separate indicator argument to trigger
2980             #>>> initialization of the model, we use the Orcish maneuver to
2981             #>>> retrieve the results of initialization, performing the
2982             #>>> calculations if needed. -- TRW
2983              
2984 7   66     34 my $parm = $self->{&TLE_INIT}{TLE_sgp4} ||= do {
2985 2 50       7 $self->is_deep and croak <
2986             Error - The SGP4 model is not valid for deep space objects.
2987             Use the SDP4, SDP4R or SDP8 models instead.
2988             EOD
2989              
2990             #* Recover original mean motion (XNODP) and semimajor axis (AODP)
2991             #* from input elements.
2992              
2993 2         14 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
2994 2         7 my $cosi0 = cos ($self->{inclination});
2995 2         5 my $theta2 = $cosi0 * $cosi0;
2996 2         7 my $x3thm1 = 3 * $theta2 - 1;
2997 2         12 my $eosq = $self->{eccentricity} * $self->{eccentricity};
2998 2         6 my $beta02 = 1 - $eosq;
2999 2         7 my $beta0 = sqrt ($beta02);
3000 2         7 my $del1 = 1.5 * SGP_CK2 * $x3thm1 / ($a1 * $a1 * $beta0 * $beta02);
3001 2         7 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD + $del1 * (1 + 134
3002             / 81 * $del1)));
3003 2         5 my $del0 = 1.5 * SGP_CK2 * $x3thm1 / ($a0 * $a0 * $beta0 * $beta02);
3004 2         7 my $xnodp = $self->{meanmotion} / (1 + $del0);
3005 2         5 my $aodp = $a0 / (1 - $del0);
3006              
3007             #* Initialization
3008              
3009             #* For perigee less than 220 kilometers, the ISIMP flag is set and
3010             #* the equations are truncated to linear variation in sqrt(A) and
3011             #* quadratic variation in mean anomaly. Also, the C3 term, the
3012             #* delta omega term, and the delta M term are dropped.
3013              
3014             #>>> Note that the original code sets ISIMP to 1 or 0, but we just
3015             #>>> set $isimp to true or false. - TRW
3016              
3017 2         9 my $isimp = ($aodp * (1 - $self->{eccentricity}) / SGP_AE) <
3018             (220 / SGP_XKMPER + SGP_AE);
3019              
3020             #* For perigee below 156 KM, the values of
3021             #* S and QOMS2T are altered.
3022              
3023 2         4 my $s4 = SGP_S;
3024 2         3 my $qoms24 = SGP_QOMS2T;
3025 2         7 my $perige = ($aodp * (1 - $self->{eccentricity}) - SGP_AE) *
3026             SGP_XKMPER;
3027 2 50       8 unless ($perige >= 156) {
3028 0 0       0 $s4 = $perige > 98 ? $perige - 78 : 20;
3029 0         0 $qoms24 = ((120 - $s4) * SGP_AE / SGP_XKMPER) ** 4;
3030 0         0 $s4 = $s4 / SGP_XKMPER + SGP_AE;
3031             }
3032 2         10 my $pinvsq = 1 / ($aodp * $aodp * $beta02 * $beta02);
3033 2         5 my $tsi = 1 / ($aodp - $s4);
3034 2         7 my $eta = $aodp * $self->{eccentricity} * $tsi;
3035 2         3 my $etasq = $eta * $eta;
3036 2         4 my $eeta = $self->{eccentricity} * $eta;
3037 2         6 my $psisq = abs (1 - $etasq);
3038 2         4 my $coef = $qoms24 * $tsi ** 4;
3039 2         7 my $coef1 = $coef / $psisq ** 3.5;
3040 2         12 my $c2 = $coef1 * $xnodp * ($aodp * (1 + 1.5 * $etasq + $eeta *
3041             (4 + $etasq)) + .75 * SGP_CK2 * $tsi / $psisq * $x3thm1
3042             * (8 + 3 * $etasq * (8 + $etasq)));
3043 2         4 my $c1 = $self->{bstardrag} * $c2;
3044 2         6 my $sini0 = sin ($self->{inclination});
3045 2         5 my $a3ovk2 = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
3046             my $c3 = $coef * $tsi * $a3ovk2 * $xnodp * SGP_AE * $sini0 /
3047 2         6 $self->{eccentricity};
3048 2         5 my $x1mth2 = 1 - $theta2;
3049             my $c4 = 2 * $xnodp * $coef1 * $aodp * $beta02 * ($eta * (2 + .5
3050             * $etasq) + $self->{eccentricity} * (.5 + 2 * $etasq) -
3051             2 * SGP_CK2 * $tsi / ($aodp * $psisq) * (-3 * $x3thm1 * (1 -
3052             2 * $eeta + $etasq * (1.5 - .5 * $eeta)) + .75 *
3053             $x1mth2 * (2 * $etasq - $eeta * (1 + $etasq)) * cos (2 *
3054 2         22 $self->{argumentofperigee})));
3055 2         6 my $c5 = 2 * $coef1 * $aodp * $beta02 * (1 + 2.75 * ($etasq +
3056             $eeta) + $eeta * $etasq);
3057 2         4 my $theta4 = $theta2 * $theta2;
3058 2         4 my $temp1 = 3 * SGP_CK2 * $pinvsq * $xnodp;
3059 2         15 my $temp2 = $temp1 * SGP_CK2 * $pinvsq;
3060 2         8 my $temp3 = 1.25 * SGP_CK4 * $pinvsq * $pinvsq * $xnodp;
3061 2         11 my $xmdot = $xnodp + .5 * $temp1 * $beta0 * $x3thm1 + .0625 *
3062             $temp2 * $beta0 * (13 - 78 * $theta2 + 137 * $theta4);
3063 2         5 my $x1m5th = 1 - 5 * $theta2;
3064 2         20 my $omgdot = -.5 * $temp1 * $x1m5th + .0625 * $temp2 * (7 - 114
3065             * $theta2 + 395 * $theta4) + $temp3 * (3 - 36 * $theta2 + 49
3066             * $theta4);
3067 2         5 my $xhdot1 = - $temp1 * $cosi0;
3068 2         11 my $xnodot = $xhdot1 + (.5 * $temp2 * (4 - 19 * $theta2) + 2 *
3069             $temp3 * (3 - 7 * $theta2)) * $cosi0;
3070             my $omgcof = $self->{bstardrag} * $c3 * cos
3071 2         6 ($self->{argumentofperigee});
3072 2         7 my $xmcof = - SGP_TOTHRD * $coef * $self->{bstardrag} * SGP_AE / $eeta;
3073 2         5 my $xnodcf = 3.5 * $beta02 * $xhdot1 * $c1;
3074 2         4 my $t2cof = 1.5 * $c1;
3075 2         19 my $xlcof = .125 * $a3ovk2 * $sini0 * (3 + 5 * $cosi0) / (1 + $cosi0);
3076 2         5 my $aycof = .25 * $a3ovk2 * $sini0;
3077 2         9 my $delmo = (1 + $eta * cos ($self->{meananomaly})) ** 3;
3078 2         6 my $sinmo = sin ($self->{meananomaly});
3079 2         8 my $x7thm1 = 7 * $theta2 - 1;
3080 2         6 my ($d2, $d3, $d4, $t3cof, $t4cof, $t5cof);
3081 2 50       22 $isimp or do {
3082 0         0 my $c1sq = $c1 * $c1;
3083 0         0 $d2 = 4 * $aodp * $tsi * $c1sq;
3084 0         0 my $temp = $d2 * $tsi * $c1 / 3;
3085 0         0 $d3 = (17 * $aodp + $s4) * $temp;
3086 0         0 $d4 = .5 * $temp * $aodp * $tsi * (221 * $aodp + 31 * $s4) * $c1;
3087 0         0 $t3cof = $d2 + 2 * $c1sq;
3088 0         0 $t4cof = .25 * (3 * $d3 * $c1 * (12 * $d2 + 10 * $c1sq));
3089 0         0 $t5cof = .2 * (3 * $d4 + 12 * $c1 * $d3 + 6 * $d2 * $d2 + 15
3090             * $c1sq * ( 2 * $d2 + $c1sq));
3091             };
3092 2 50       10 $self->{debug} and print <
3093             Debug SGP4 - Initialize
3094             AODP = $aodp
3095             AYCOF = $aycof
3096             C1 = $c1
3097             C4 = $c4
3098             C5 = $c5
3099             COSIO = $cosi0
3100 0 0       0 D2 = @{[defined $d2 ? $d2 : 'undef']}
3101 0 0       0 D3 = @{[defined $d3 ? $d3 : 'undef']}
3102 0 0       0 D4 = @{[defined $d4 ? $d4 : 'undef']}
3103             DELMO = $delmo
3104             ETA = $eta
3105             ISIMP = $isimp
3106             OMGCOF = $omgcof
3107             OMGDOT = $omgdot
3108             SINIO = $sini0
3109             SINMO = $sinmo
3110 0 0       0 T2COF = @{[defined $t2cof ? $t2cof : 'undef']}
3111 0 0       0 T3COF = @{[defined $t3cof ? $t3cof : 'undef']}
3112 0 0       0 T4COF = @{[defined $t4cof ? $t4cof : 'undef']}
3113 0 0       0 T5COF = @{[defined $t5cof ? $t5cof : 'undef']}
3114             X1MTH2 = $x1mth2
3115             X3THM1 = $x3thm1
3116             X7THM1 = $x7thm1
3117             XLCOF = $xlcof
3118             XMCOF = $xmcof
3119             XMDOT = $xmdot
3120             XNODCF = $xnodcf
3121             XNODOT = $xnodot
3122             XNODP = $xnodp
3123             eod
3124             {
3125 2         46 aodp => $aodp,
3126             aycof => $aycof,
3127             c1 => $c1,
3128             c4 => $c4,
3129             c5 => $c5,
3130             cosi0 => $cosi0,
3131             d2 => $d2,
3132             d3 => $d3,
3133             d4 => $d4,
3134             delmo => $delmo,
3135             eta => $eta,
3136             isimp => $isimp,
3137             omgcof => $omgcof,
3138             omgdot => $omgdot,
3139             sini0 => $sini0,
3140             sinmo => $sinmo,
3141             t2cof => $t2cof,
3142             t3cof => $t3cof,
3143             t4cof => $t4cof,
3144             t5cof => $t5cof,
3145             x1mth2 => $x1mth2,
3146             x3thm1 => $x3thm1,
3147             x7thm1 => $x7thm1,
3148             xlcof => $xlcof,
3149             xmcof => $xmcof,
3150             xmdot => $xmdot,
3151             xnodcf => $xnodcf,
3152             xnodot => $xnodot,
3153             xnodp => $xnodp,
3154             };
3155             };
3156              
3157             #* Update for secular gravity and atmospheric drag.
3158              
3159 7         17 my $xmdf = $self->{meananomaly} + $parm->{xmdot} * $tsince;
3160 7         14 my $omgadf = $self->{argumentofperigee} + $parm->{omgdot} * $tsince;
3161 7         20 my $xnoddf = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
3162 7         9 my $omega = $omgadf;
3163 7         11 my $xmp = $xmdf;
3164 7         11 my $tsq = $tsince * $tsince;
3165 7         14 my $xnode = $xnoddf + $parm->{xnodcf} * $tsq;
3166 7         15 my $tempa = 1 - $parm->{c1} * $tsince;
3167 7         14 my $tempe = $self->{bstardrag} * $parm->{c4} * $tsince;
3168 7         12 my $templ = $parm->{t2cof} * $tsq;
3169 7 50       15 $parm->{isimp} or do {
3170 0         0 my $delomg = $parm->{omgcof} * $tsince;
3171             my $delm = $parm->{xmcof} * ((1 + $parm->{eta} * cos($xmdf)) **
3172 0         0 3 - $parm->{delmo});
3173 0         0 my $temp = $delomg + $delm;
3174 0         0 $xmp = $xmdf + $temp;
3175 0         0 $omega = $omgadf - $temp;
3176 0         0 my $tcube = $tsq * $tsince;
3177 0         0 my $tfour = $tsince * $tcube;
3178             $tempa = $tempa - $parm->{d2} * $tsq - $parm->{d3} * $tcube -
3179 0         0 $parm->{d4} * $tfour;
3180             $tempe = $tempe + $self->{bstardrag} * $parm->{c5} * (sin($xmp)
3181 0         0 - $parm->{sinmo});
3182             $templ = $templ + $parm->{t3cof} * $tcube + $tfour *
3183 0         0 ($parm->{t4cof} + $tsince * $parm->{t5cof});
3184             };
3185 7         21 my $a = $parm->{aodp} * $tempa ** 2;
3186 7         18 my $e = $self->{eccentricity} - $tempe;
3187 7         26 my $xl = $xmp + $omega + $xnode + $parm->{xnodp} * $templ;
3188             $self->{debug}
3189 7 50       19 and warn "Debug - OID $oid sgp4 effective eccentricity $e\n";
3190 7 100 66     44 croak < 1 || $e < -1;
3191             Error - OID $oid Sgp4 effective eccentricity > 1
3192 2         6 Epoch = @{[scalar gmtime $self->get ('epoch')]} GMT
3193             \$self->{bstardrag} = $self->{bstardrag}
3194             \$parm->{c4} = $parm->{c4}
3195             \$tsince = $tsince
3196             \$tempe = \$self->{bstardrag} * \$parm->{c4} * \$tsince
3197             \$tempe = $tempe
3198             \$self->{eccentricity} = $self->{eccentricity}
3199             \$e = \$self->{eccentricity} - \$tempe
3200             \$e = $e
3201             Either this object represents a bad set of elements, or you are
3202             using it beyond its "best by" date ("expiry date" in some dialects
3203             of English).
3204             eod
3205 5         10 my $beta = sqrt(1 - $e * $e);
3206 5 50       24 $self->{debug} and print <
3207             Debug SGP4 - Before xn,
3208 0         0 XKE = @{[SGP_XKE]}
3209             A = $a
3210             TEMPA = $tempa
3211             AODP = $parm->{aodp}
3212             eod
3213 5         19 my $xn = SGP_XKE / $a ** 1.5;
3214              
3215             #* Long period periodics
3216              
3217 5         14 my $axn = $e * cos($omega);
3218 5         11 my $temp = 1 / ($a * $beta * $beta);
3219 5         8 my $xll = $temp * $parm->{xlcof} * $axn;
3220 5         7 my $aynl = $temp * $parm->{aycof};
3221 5         8 my $xlt = $xl + $xll;
3222 5         9 my $ayn = $e * sin($omega) + $aynl;
3223              
3224             #* Solve Kepler's equation.
3225              
3226 5         13 my $capu = mod2pi($xlt - $xnode);
3227 5         8 my $temp2 = $capu;
3228 5         33 my ($temp3, $temp4, $temp5, $temp6, $sinepw, $cosepw);
3229 5         19 for (my $i = 0; $i < 10; $i++) {
3230 10         22 $sinepw = sin($temp2);
3231 10         14 $cosepw = cos($temp2);
3232 10         15 $temp3 = $axn * $sinepw;
3233 10         14 $temp4 = $ayn * $cosepw;
3234 10         12 $temp5 = $axn * $cosepw;
3235 10         13 $temp6 = $ayn * $sinepw;
3236 10         20 my $epw = ($capu - $temp4 + $temp3 - $temp2) / (1 - $temp5 -
3237             $temp6) + $temp2;
3238 10 100       23 abs ($epw - $temp2) <= SGP_E6A and last;
3239 5         14 $temp2 = $epw;
3240             }
3241              
3242             #* Short period preliminary quantities.
3243              
3244 5         6 my $ecose = $temp5 + $temp6;
3245 5         8 my $esine = $temp3 - $temp4;
3246 5         9 my $elsq = $axn * $axn + $ayn * $ayn;
3247 5         8 $temp = 1 - $elsq;
3248 5         8 my $pl = $a * $temp;
3249 5         7 my $r = $a * (1 - $ecose);
3250 5         10 my $temp1 = 1 / $r;
3251 5         8 my $rdot = SGP_XKE * sqrt($a) * $esine * $temp1;
3252 5         9 my $rfdot = SGP_XKE * sqrt($pl) * $temp1;
3253 5         5 $temp2 = $a * $temp1;
3254 5         6 my $betal = sqrt($temp);
3255 5         16 $temp3 = 1 / (1 + $betal);
3256 5         8 my $cosu = $temp2 * ($cosepw - $axn + $ayn * $esine * $temp3);
3257 5         10 my $sinu = $temp2 * ($sinepw - $ayn - $axn * $esine * $temp3);
3258 5         11 my $u = _actan($sinu,$cosu);
3259 5         10 my $sin2u = 2 * $sinu * $cosu;
3260 5         8 my $cos2u = 2 * $cosu * $cosu - 1;
3261 5         8 $temp = 1 / $pl;
3262 5         7 $temp1 = SGP_CK2 * $temp;
3263 5         7 $temp2 = $temp1 * $temp;
3264              
3265             #* Update for short periodics
3266              
3267             my $rk = $r * (1 - 1.5 * $temp2 * $betal * $parm->{x3thm1}) + .5 *
3268 5         13 $temp1 * $parm->{x1mth2} * $cos2u;
3269 5         10 my $uk = $u - .25 * $temp2 * $parm->{x7thm1} * $sin2u;
3270 5         9 my $xnodek = $xnode + 1.5 * $temp2 * $parm->{cosi0} * $sin2u;
3271             my $xinck = $self->{inclination} + 1.5 * $temp2 * $parm->{cosi0} *
3272 5         10 $parm->{sini0} * $cos2u;
3273 5         11 my $rdotk = $rdot - $xn * $temp1 * $parm->{x1mth2} * $sin2u;
3274             my $rfdotk = $rfdot + $xn * $temp1 * ($parm->{x1mth2} * $cos2u + 1.5
3275 5         11 * $parm->{x3thm1});
3276              
3277             #* Orientation vectors
3278              
3279 5         8 my $sinuk = sin ($uk);
3280 5         9 my $cosuk = cos ($uk);
3281 5         6 my $sinik = sin ($xinck);
3282 5         7 my $cosik = cos ($xinck);
3283 5         9 my $sinnok = sin ($xnodek);
3284 5         6 my $cosnok = cos ($xnodek);
3285 5         10 my $xmx = - $sinnok * $cosik;
3286 5         6 my $xmy = $cosnok * $cosik;
3287 5         7 my $ux = $xmx * $sinuk + $cosnok * $cosuk;
3288 5         9 my $uy = $xmy * $sinuk + $sinnok * $cosuk;
3289 5         7 my $uz = $sinik * $sinuk;
3290 5         10 my $vx = $xmx * $cosuk - $cosnok * $sinuk;
3291 5         6 my $vy = $xmy * $cosuk - $sinnok * $sinuk;
3292 5         8 my $vz = $sinik * $cosuk;
3293              
3294             #* Position and velocity
3295              
3296 5         9 my $x = $rk * $ux;
3297 5         6 my $y = $rk * $uy;
3298 5         9 my $z = $rk * $uz;
3299 5         7 my $xdot = $rdotk * $ux + $rfdotk * $vx;
3300 5         8 my $ydot = $rdotk * $uy + $rfdotk * $vy;
3301 5         8 my $zdot = $rdotk * $uz + $rfdotk * $vz;
3302              
3303 5         18 return _convert_out($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
3304             }
3305              
3306             =item $tle = $tle->sdp4($time)
3307              
3308             This method calculates the position of the body described by the TLE
3309             object at the given time, using the SDP4 model. The universal time of
3310             the object is set to $time, and the 'equinox_dynamical' attribute is set
3311             to the current value of the 'epoch_dynamical' attribute.
3312              
3313             The result is the original object reference. You need to call one of
3314             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
3315             retrieve the position you just calculated.
3316              
3317             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
3318             model can be used only for deep-space orbits.
3319              
3320             =cut
3321              
3322             sub sdp4 {
3323 7     7 1 18 my ($self, $time) = @_;
3324 7         19 my $oid = $self->get('id');
3325 7         22 $self->{model_error} = undef;
3326 7         24 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
3327              
3328             #>>> Rather than use a separate indicator argument to trigger
3329             #>>> initialization of the model, we use the Orcish maneuver to
3330             #>>> retrieve the results of initialization, performing the
3331             #>>> calculations if needed. -- TRW
3332              
3333 7   66     36 my $parm = $self->{&TLE_INIT}{TLE_sdp4} ||= do {
3334 2 50       9 $self->is_deep or croak <
3335             Error - The SDP4 model is not valid for near-earth objects.
3336             Use the SGP, SGP4, SGP4R, or SGP8 models instead.
3337             EOD
3338              
3339             #* Recover original mean motion (XNODP) and semimajor axis (AODP)
3340             #* from input elements.
3341              
3342 2         10 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
3343 2         6 my $cosi0 = cos ($self->{inclination});
3344 2         6 my $theta2 = $cosi0 * $cosi0;
3345 2         5 my $x3thm1 = 3 * $theta2 - 1;
3346 2         5 my $eosq = $self->{eccentricity} * $self->{eccentricity};
3347 2         6 my $beta02 = 1 - $eosq;
3348 2         5 my $beta0 = sqrt ($beta02);
3349 2         9 my $del1 = 1.5 * SGP_CK2 * $x3thm1 / ($a1 * $a1 * $beta0 * $beta02);
3350 2         8 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD + $del1 * (1 + 134
3351             / 81 * $del1)));
3352 2         6 my $del0 = 1.5 * SGP_CK2 * $x3thm1 / ($a0 * $a0 * $beta0 * $beta02);
3353 2         6 my $xnodp = $self->{meanmotion} / (1 + $del0);
3354             # no problem here - we know this because AODP is returned.
3355 2         5 my $aodp = $a0 / (1 - $del0);
3356              
3357             #* Initialization
3358              
3359             #* For perigee below 156 KM, the values of
3360             #* S and QOMS2T are altered
3361              
3362 2         5 my $s4 = SGP_S;
3363 2         4 my $qoms24 = SGP_QOMS2T;
3364 2         7 my $perige = ($aodp * (1 - $self->{eccentricity}) - SGP_AE) *
3365             SGP_XKMPER;
3366 2 50       8 unless ($perige >= 156) {
3367 2 50       8 $s4 = $perige > 98 ? $perige - 78 : 20;
3368 2         7 $qoms24 = ((120 - $s4) * SGP_AE / SGP_XKMPER) ** 4;
3369 2         8 $s4 = $s4 / SGP_XKMPER + SGP_AE;
3370             }
3371 2         4 my $pinvsq = 1 / ($aodp * $aodp * $beta02 * $beta02);
3372 2         6 my $sing = sin ($self->{argumentofperigee});
3373 2         5 my $cosg = cos ($self->{argumentofperigee});
3374 2         5 my $tsi = 1 / ($aodp - $s4);
3375 2         18 my $eta = $aodp * $self->{eccentricity} * $tsi;
3376 2         5 my $etasq = $eta * $eta;
3377 2         6 my $eeta = $self->{eccentricity} * $eta;
3378 2         5 my $psisq = abs (1 - $etasq);
3379 2         7 my $coef = $qoms24 * $tsi ** 4;
3380 2         8 my $coef1 = $coef / $psisq ** 3.5;
3381 2         13 my $c2 = $coef1 * $xnodp * ($aodp * (1 + 1.5 * $etasq + $eeta *
3382             (4 + $etasq)) + .75 * SGP_CK2 * $tsi / $psisq * $x3thm1 *
3383             (8 + 3 * $etasq * (8 + $etasq)));
3384             # minor problem here
3385 2         5 my $c1 = $self->{bstardrag} * $c2;
3386 2         6 my $sini0 = sin ($self->{inclination});
3387 2         4 my $a3ovk2 = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
3388 2         5 my $x1mth2 = 1 - $theta2;
3389             my $c4 = 2 * $xnodp * $coef1 * $aodp * $beta02 * ($eta * (2 + .5 *
3390             $etasq) + $self->{eccentricity} * (.5 + 2 * $etasq) -
3391             2 * SGP_CK2 * $tsi / ($aodp * $psisq) * ( - 3 * $x3thm1 *
3392             (1 - 2 * $eeta + $etasq * (1.5 - .5 * $eeta)) + .75 * $x1mth2 *
3393             (2 * $etasq - $eeta * (1 + $etasq)) *
3394 2         17 cos (2 * $self->{argumentofperigee})));
3395 2         5 my $theta4 = $theta2 * $theta2;
3396 2         6 my $temp1 = 3 * SGP_CK2 * $pinvsq * $xnodp;
3397 2         4 my $temp2 = $temp1 * SGP_CK2 * $pinvsq;
3398 2         5 my $temp3 = 1.25 * SGP_CK4 * $pinvsq * $pinvsq * $xnodp;
3399 2         8 my $xmdot = $xnodp + .5 * $temp1 * $beta0 * $x3thm1 +
3400             .0625 * $temp2 * $beta0 * (13 - 78 * $theta2 + 137 * $theta4);
3401 2         5 my $x1m5th = 1 - 5 * $theta2;
3402 2         11 my $omgdot = - .5 * $temp1 * $x1m5th +
3403             .0625 * $temp2 * (7 - 114 * $theta2 + 395 * $theta4) +
3404             $temp3 * (3 - 36 * $theta2 + 49 * $theta4);
3405 2         4 my $xhdot1 = - $temp1 * $cosi0;
3406 2         16 my $xnodot = $xhdot1 + (.5 * $temp2 * (4 - 19 * $theta2) +
3407             2 * $temp3 * (3 - 7 * $theta2)) * $cosi0;
3408             # problem here (inherited from C1 problem?)
3409 2         6 my $xnodcf = 3.5 * $beta02 * $xhdot1 * $c1;
3410             # problem here (inherited from C1 problem?)
3411 2         6 my $t2cof = 1.5 * $c1;
3412 2         9 my $xlcof = .125 * $a3ovk2 * $sini0 * (3 + 5 * $cosi0) / (1 + $cosi0);
3413 2         14 my $aycof = .25 * $a3ovk2 * $sini0;
3414 2         7 my $x7thm1 = 7 * $theta2 - 1;
3415 2         15 $self->{&TLE_INIT}{TLE_deep} = {$self->_dpinit ($eosq, $sini0, $cosi0, $beta0,
3416             $aodp, $theta2, $sing, $cosg, $beta02, $xmdot, $omgdot,
3417             $xnodot, $xnodp)};
3418              
3419 2 50       20 $self->{debug} and print <
3420             Debug SDP4 - Initialize
3421             AODP = $aodp
3422             AYCOF = $aycof
3423             C1 = $c1 << 2.45532e-06 in test_sgp-c-lib
3424             c2 = $c2 << 0.000171569 in test_sgp-c-lib
3425             C4 = $c4
3426             COSIO = $cosi0
3427             ETA = $eta
3428             OMGDOT = $omgdot
3429             s4 = $s4
3430             SINIO = $sini0
3431 0 0       0 T2COF = @{[defined $t2cof ? $t2cof : 'undef']} << 3.68298e-06 in test_sgp-c-lib
3432             X1MTH2 = $x1mth2
3433             X3THM1 = $x3thm1
3434             X7THM1 = $x7thm1
3435             XLCOF = $xlcof
3436             XMDOT = $xmdot
3437             XNODCF = $xnodcf << -1.40764e-11 in test_sgp-c-lib
3438             XNODOT = $xnodot
3439             XNODP = $xnodp
3440             eod
3441             {
3442 2         40 aodp => $aodp,
3443             aycof => $aycof,
3444             c1 => $c1,
3445             c4 => $c4,
3446             ### c5 => $c5,
3447             cosi0 => $cosi0,
3448             ### d2 => $d2,
3449             ### d3 => $d3,
3450             ### d4 => $d4,
3451             ### delmo => $delmo,
3452             eta => $eta,
3453             ### isimp => $isimp,
3454             ### omgcof => $omgcof,
3455             omgdot => $omgdot,
3456             sini0 => $sini0,
3457             ### sinmo => $sinmo,
3458             t2cof => $t2cof,
3459             ### t3cof => $t3cof,
3460             ### t4cof => $t4cof,
3461             ### t5cof => $t5cof,
3462             x1mth2 => $x1mth2,
3463             x3thm1 => $x3thm1,
3464             x7thm1 => $x7thm1,
3465             xlcof => $xlcof,
3466             ### xmcof => $xmcof,
3467             xmdot => $xmdot,
3468             xnodcf => $xnodcf,
3469             xnodot => $xnodot,
3470             xnodp => $xnodp,
3471             };
3472             };
3473             #>>>trw my $dpsp = $self->{&TLE_INIT}{TLE_deep};
3474              
3475             #* UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG
3476              
3477 7         23 my $xmdf = $self->{meananomaly} + $parm->{xmdot} * $tsince;
3478 7         14 my $omgadf = $self->{argumentofperigee} + $parm->{omgdot} * $tsince;
3479 7         13 my $xnoddf = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
3480 7         14 my $tsq = $tsince * $tsince;
3481 7         15 my $xnode = $xnoddf + $parm->{xnodcf} * $tsq;
3482 7         13 my $tempa = 1 - $parm->{c1} * $tsince;
3483 7         15 my $tempe = $self->{bstardrag} * $parm->{c4} * $tsince;
3484 7         12 my $templ = $parm->{t2cof} * $tsq;
3485 7         14 my $xn = $parm->{xnodp};
3486 7         17 my ($em, $xinc); # Hope this is right.
3487 7         35 $self->_dpsec (\$xmdf, \$omgadf, \$xnode, \$em, \$xinc, \$xn, $tsince);
3488 7         31 my $a = (SGP_XKE / $xn) ** SGP_TOTHRD * $tempa ** 2;
3489 7         13 my $e = $em - $tempe;
3490 7         14 my $xmam = $xmdf + $parm->{xnodp} * $templ;
3491 7         25 $self->_dpper (\$e, \$xinc, \$omgadf, \$xnode, \$xmam, $tsince);
3492 7         15 my $xl = $xmam + $omgadf + $xnode;
3493             $self->{debug}
3494 7 50       17 and warn "Debug - OID $oid sdp4 effective eccentricity $e\n";
3495 7 100 66     455 ($e > 1 || $e < -1)
3496             and croak "Error - OID $oid Sdp4 effective eccentricity > 1";
3497 5         11 my $beta = sqrt (1 - $e * $e);
3498 5         19 $xn = SGP_XKE / $a ** 1.5;
3499              
3500             #* LONG PERIOD PERIODICS
3501              
3502 5         12 my $axn = $e * cos ($omgadf);
3503 5         10 my $temp = 1 / ($a * $beta * $beta);
3504 5         8 my $xll = $temp * $parm->{xlcof} * $axn;
3505 5         9 my $aynl = $temp * $parm->{aycof};
3506 5         8 my $xlt = $xl + $xll;
3507 5         10 my $ayn = $e * sin ($omgadf) + $aynl;
3508              
3509             #* SOLVE KEPLERS EQUATION
3510              
3511 5         16 my $capu = mod2pi ($xlt - $xnode);
3512 5         10 my $temp2 = $capu;
3513 5         16 my ($epw, $sinepw, $cosepw, $temp3, $temp4, $temp5, $temp6);
3514 5         15 for (my $i = 0; $i < 10; $i++) {
3515 23         31 $sinepw = sin ($temp2);
3516 23         37 $cosepw = cos ($temp2);
3517 23         30 $temp3 = $axn * $sinepw;
3518 23         27 $temp4 = $ayn * $cosepw;
3519 23         30 $temp5 = $axn * $cosepw;
3520 23         25 $temp6 = $ayn * $sinepw;
3521 23         42 $epw = ($capu - $temp4 + $temp3 - $temp2) / (1 - $temp5 -
3522             $temp6) + $temp2;
3523 23 100       45 last if (abs ($epw - $temp2) <= SGP_E6A);
3524 18         33 $temp2 = $epw;
3525             }
3526              
3527             #* SHORT PERIOD PRELIMINARY QUANTITIES
3528              
3529 5         7 my $ecose = $temp5 + $temp6;
3530 5         27 my $esine = $temp3 - $temp4;
3531 5         9 my $elsq = $axn * $axn + $ayn * $ayn;
3532 5         7 $temp = 1 - $elsq;
3533 5         7 my $pl = $a * $temp;
3534 5         8 my $r = $a * (1 - $ecose);
3535 5         9 my $temp1 = 1 / $r;
3536 5         9 my $rdot = SGP_XKE * sqrt ($a) * $esine * $temp1;
3537 5         7 my $rfdot = SGP_XKE * sqrt ($pl) * $temp1;
3538 5         9 $temp2 = $a * $temp1;
3539 5         7 my $betal = sqrt ($temp);
3540 5         11 $temp3 = 1 / (1 + $betal);
3541 5         8 my $cosu = $temp2 * ($cosepw - $axn + $ayn * $esine * $temp3);
3542 5         9 my $sinu = $temp2 * ($sinepw - $ayn - $axn * $esine * $temp3);
3543 5         11 my $u = _actan ($sinu,$cosu);
3544 5         10 my $sin2u = 2 * $sinu * $cosu;
3545 5         8 my $cos2u = 2 * $cosu * $cosu - 1;
3546 5         9 $temp = 1 / $pl;
3547 5         7 $temp1 = SGP_CK2 * $temp;
3548 5         5 $temp2 = $temp1 * $temp;
3549              
3550             #* UPDATE FOR SHORT PERIODICS
3551              
3552             my $rk = $r * (1 - 1.5 * $temp2 * $betal * $parm->{x3thm1}) + .5 *
3553 5         14 $temp1 * $parm->{x1mth2} * $cos2u;
3554 5         10 my $uk = $u - .25 * $temp2 * $parm->{x7thm1} * $sin2u;
3555 5         15 my $xnodek = $xnode + 1.5 * $temp2 * $parm->{cosi0} * $sin2u;
3556             my $xinck = $xinc + 1.5 * $temp2 * $parm->{cosi0} * $parm->{sini0} *
3557 5         18 $cos2u;
3558 5         9 my $rdotk = $rdot - $xn * $temp1 * $parm->{x1mth2} * $sin2u;
3559             my $rfdotk = $rfdot + $xn * $temp1 * ($parm->{x1mth2} * $cos2u + 1.5
3560 5         11 * $parm->{x3thm1});
3561              
3562             #* ORIENTATION VECTORS
3563              
3564 5         9 my $sinuk = sin ($uk);
3565 5         6 my $cosuk = cos ($uk);
3566 5         9 my $sinik = sin ($xinck);
3567 5         8 my $cosik = cos ($xinck);
3568 5         9 my $sinnok = sin ($xnodek);
3569 5         6 my $cosnok = cos ($xnodek);
3570 5         8 my $xmx = - $sinnok * $cosik;
3571 5         9 my $xmy = $cosnok * $cosik;
3572 5         9 my $ux = $xmx * $sinuk + $cosnok * $cosuk;
3573 5         11 my $uy = $xmy * $sinuk + $sinnok * $cosuk;
3574 5         6 my $uz = $sinik * $sinuk;
3575 5         9 my $vx = $xmx * $cosuk - $cosnok * $sinuk;
3576 5         6 my $vy = $xmy * $cosuk - $sinnok * $sinuk;
3577 5         8 my $vz = $sinik * $cosuk;
3578              
3579             #* POSITION AND VELOCITY
3580              
3581 5         9 my $x = $rk * $ux;
3582 5         6 my $y = $rk * $uy;
3583 5         7 my $z = $rk * $uz;
3584 5         9 my $xdot = $rdotk * $ux + $rfdotk * $vx;
3585 5         6 my $ydot = $rdotk * $uy + $rfdotk * $vy;
3586 5         8 my $zdot = $rdotk * $uz + $rfdotk * $vz;
3587              
3588 5         17 return _convert_out($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
3589             }
3590              
3591             =item $tle = $tle->sgp8($time)
3592              
3593             This method calculates the position of the body described by the TLE
3594             object at the given time, using the SGP8 model. The universal time of
3595             the object is set to $time, and the 'equinox_dynamical' attribute is set
3596             to the current value of the 'epoch_dynamical' attribute.
3597              
3598             The result is the original object reference. You need to call one of
3599             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
3600             retrieve the position you just calculated.
3601              
3602             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
3603             model can be used only for near-earth orbits.
3604              
3605             =cut
3606              
3607             sub sgp8 {
3608 7     7 1 18 my ($self, $time) = @_;
3609 7         18 my $oid = $self->get('id');
3610 7         30 $self->{model_error} = undef;
3611 7         22 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
3612              
3613             #>>> Rather than use a separate indicator argument to trigger
3614             #>>> initialization of the model, we use the Orcish maneuver to
3615             #>>> retrieve the results of initialization, performing the
3616             #>>> calculations if needed. -- TRW
3617              
3618 7   66     37 my $parm = $self->{&TLE_INIT}{TLE_sgp8} ||= do {
3619 2 50       8 $self->is_deep and croak <
3620             Error - The SGP8 model is not valid for deep space objects.
3621             Use the SDP4, SGP4R, or SDP8 models instead.
3622             EOD
3623              
3624             #* RECOVER ORIGINAL MEAN MOTION (XNODP) AND SEMIMAJOR AXIS (AODP)
3625             #* FROM INPUT ELEMENTS --------- CALCULATE BALLISTIC COEFFICIENT
3626             #* (B TERM) FROM INPUT B* DRAG TERM
3627              
3628 2         14 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
3629 2         7 my $cosi = cos ($self->{inclination});
3630 2         5 my $theta2 = $cosi * $cosi;
3631 2         9 my $tthmun = 3 * $theta2 - 1;
3632 2         11 my $eosq = $self->{eccentricity} * $self->{eccentricity};
3633 2         7 my $beta02 = 1 - $eosq;
3634 2         8 my $beta0 = sqrt ($beta02);
3635 2         8 my $del1 = 1.5 * SGP_CK2 * $tthmun / ($a1 * $a1 * $beta0 * $beta02);
3636 2         10 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD +
3637             $del1 * (1 + 134 / 81 * $del1)));
3638 2         6 my $del0 = 1.5 * SGP_CK2 * $tthmun / ($a0 * $a0 * $beta0 * $beta02);
3639 2         7 my $aodp = $a0 / (1 - $del0);
3640 2         4 my $xnodp = $self->{meanmotion} / (1 + $del0);
3641 2         7 my $b = 2 * $self->{bstardrag} / SGP_RHO;
3642              
3643             #* INITIALIZATION
3644              
3645 2         6 my $isimp = 0;
3646 2         5 my $po = $aodp * $beta02;
3647 2         5 my $pom2 = 1 / ($po * $po);
3648 2         6 my $sini = sin ($self->{inclination});
3649 2         7 my $sing = sin ($self->{argumentofperigee});
3650 2         7 my $cosg = cos ($self->{argumentofperigee});
3651 2         6 my $temp = .5 * $self->{inclination};
3652 2         6 my $sinio2 = sin ($temp);
3653 2         6 my $cosio2 = cos ($temp);
3654 2         4 my $theta4 = $theta2 ** 2;
3655 2         6 my $unm5th = 1 - 5 * $theta2;
3656 2         6 my $unmth2 = 1 - $theta2;
3657 2         5 my $a3cof = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
3658 2         10 my $pardt1 = 3 * SGP_CK2 * $pom2 * $xnodp;
3659 2         4 my $pardt2 = $pardt1 * SGP_CK2 * $pom2;
3660 2         9 my $pardt4 = 1.25 * SGP_CK4 * $pom2 * $pom2 * $xnodp;
3661 2         4 my $xmdt1 = .5 * $pardt1 * $beta0 * $tthmun;
3662 2         4 my $xgdt1 = - .5 * $pardt1 * $unm5th;
3663 2         5 my $xhdt1 = - $pardt1 * $cosi;
3664 2         9 my $xlldot = $xnodp + $xmdt1 + .0625 * $pardt2 * $beta0 *
3665             (13 - 78 * $theta2 + 137 * $theta4);
3666 2         20 my $omgdt = $xgdt1 + .0625 * $pardt2 * (7 - 114 * $theta2 +
3667             395 * $theta4) + $pardt4 * (3 - 36 * $theta2 + 49 * $theta4);
3668 2         12 my $xnodot = $xhdt1 + (.5 * $pardt2 * (4 - 19 * $theta2) +
3669             2 * $pardt4 * (3 - 7 * $theta2)) * $cosi;
3670 2         6 my $tsi = 1 / ($po - SGP_S);
3671 2         4 my $eta = $self->{eccentricity} * SGP_S * $tsi;
3672 2         4 my $eta2 = $eta ** 2;
3673 2         6 my $psim2 = abs (1 / (1 - $eta2));
3674 2         4 my $alpha2 = 1 + $eosq;
3675 2         12 my $eeta = $self->{eccentricity} * $eta;
3676 2         10 my $cos2g = 2 * $cosg ** 2 - 1;
3677 2         10 my $d5 = $tsi * $psim2;
3678 2         8 my $d1 = $d5 / $po;
3679 2         7 my $d2 = 12 + $eta2 * (36 + 4.5 * $eta2);
3680 2         4 my $d3 = $eta2 * (15 + 2.5 * $eta2);
3681 2         7 my $d4 = $eta * (5 + 3.75 * $eta2);
3682 2         3 my $b1 = SGP_CK2 * $tthmun;
3683 2         4 my $b2 = - SGP_CK2 * $unmth2;
3684 2         4 my $b3 = $a3cof * $sini;
3685 2         14 my $c0 = .5 * $b * SGP_RHO * SGP_QOMS2T * $xnodp * $aodp *
3686             $tsi ** 4 * $psim2 ** 3.5 / sqrt ($alpha2);
3687 2         7 my $c1 = 1.5 * $xnodp * $alpha2 ** 2 * $c0;
3688 2         4 my $c4 = $d1 * $d3 * $b2;
3689 2         4 my $c5 = $d5 * $d4 * $b3;
3690 2         15 my $xndt = $c1 * ( (2 + $eta2 * (3 + 34 * $eosq) +
3691             5 * $eeta * (4 + $eta2) + 8.5 * $eosq) + $d1 * $d2 * $b1 +
3692             $c4 * $cos2g + $c5 * $sing);
3693 2         4 my $xndtn = $xndt / $xnodp;
3694              
3695             #* IF DRAG IS VERY SMALL, THE ISIMP FLAG IS SET AND THE
3696             #* EQUATIONS ARE TRUNCATED TO LINEAR VARIATION IN MEAN
3697             #* MOTION AND QUADRATIC VARIATION IN MEAN ANOMALY
3698              
3699             #>>> Note that the simplified version of the code has been swapped
3700             #>>> above the full version to preserve the sense of the comment.
3701              
3702 2         6 my ($ed, $edot, $gamma, $pp, $ovgpp, $qq, $xnd);
3703 2 50       10 if (abs ($xndtn * SGP_XMNPDA) < 2.16e-3) {
3704 2         3 $isimp = 1;
3705 2         20 $edot = - SGP_TOTHRD * $xndtn * (1 - $self->{eccentricity});
3706             } else {
3707 0         0 my $d6 = $eta * (30 + 22.5 * $eta2);
3708 0         0 my $d7 = $eta * (5 + 12.5 * $eta2);
3709 0         0 my $d8 = 1 + $eta2 * (6.75 + $eta2);
3710 0         0 my $c8 = $d1 * $d7 * $b2;
3711 0         0 my $c9 = $d5 * $d8 * $b3;
3712             $edot = - $c0 * ($eta * (4 + $eta2 +
3713             $eosq * (15.5 + 7 * $eta2)) +
3714 0         0 $self->{eccentricity} * (5 + 15 * $eta2) +
3715             $d1 * $d6 * $b1 + $c8 * $cos2g + $c9 * $sing);
3716 0         0 my $d20 = .5 * SGP_TOTHRD * $xndtn;
3717 0         0 my $aldtal = $self->{eccentricity} * $edot / $alpha2;
3718             my $tsdtts = 2 * $aodp * $tsi * ($d20 * $beta02 +
3719 0         0 $self->{eccentricity} * $edot);
3720 0         0 my $etdt = ($edot + $self->{eccentricity} * $tsdtts)
3721             * $tsi * SGP_S;
3722 0         0 my $psdtps = - $eta * $etdt * $psim2;
3723 0         0 my $sin2g = 2 * $sing * $cosg;
3724 0         0 my $c0dtc0 = $d20 + 4 * $tsdtts - $aldtal - 7 * $psdtps;
3725 0         0 my $c1dtc1 = $xndtn + 4 * $aldtal + $c0dtc0;
3726             my $d9 = $eta * (6 + 68 * $eosq) +
3727 0         0 $self->{eccentricity} * (20 + 15 * $eta2);
3728             my $d10 = 5 * $eta * (4 + $eta2) +
3729 0         0 $self->{eccentricity} * (17 + 68 * $eta2);
3730 0         0 my $d11 = $eta * (72 + 18 * $eta2);
3731 0         0 my $d12 = $eta * (30 + 10 * $eta2);
3732 0         0 my $d13 = 5 + 11.25 * $eta2;
3733 0         0 my $d14 = $tsdtts - 2 * $psdtps;
3734 0         0 my $d15 = 2 * ($d20 + $self->{eccentricity} * $edot / $beta02);
3735 0         0 my $d1dt = $d1 * ($d14 + $d15);
3736 0         0 my $d2dt = $etdt * $d11;
3737 0         0 my $d3dt = $etdt * $d12;
3738 0         0 my $d4dt = $etdt * $d13;
3739 0         0 my $d5dt = $d5 * $d14;
3740 0         0 my $c4dt = $b2 * ($d1dt * $d3 + $d1 * $d3dt);
3741 0         0 my $c5dt = $b3 * ($d5dt * $d4 + $d5 * $d4dt);
3742 0         0 my $d16 = $d9 * $etdt + $d10 * $edot +
3743             $b1 * ($d1dt * $d2 + $d1 * $d2dt) + $c4dt * $cos2g +
3744             $c5dt * $sing +
3745             $xgdt1 * ($c5 * $cosg - 2 * $c4 * $sin2g);
3746 0         0 my $xnddt = $c1dtc1 * $xndt + $c1 * $d16;
3747 0         0 my $eddot = $c0dtc0 * $edot -
3748             $c0 * ((4 + 3 * $eta2 + 30 * $eeta +
3749             $eosq * (15.5 + 21 * $eta2)) * $etdt +
3750             (5 + 15 * $eta2 + $eeta * (31 + 14 * $eta2)) * $edot +
3751             $b1 * ($d1dt * $d6 + $d1 * $etdt * (30 + 67.5 *
3752             $eta2)) + $b2 * ($d1dt * $d7 +
3753             $d1 * $etdt * (5 + 37.5 * $eta2)) * $cos2g +
3754             $b3 * ($d5dt * $d8 + $d5 * $etdt * $eta * (13.5 +
3755             4 * $eta2)) * $sing +
3756             $xgdt1 * ($c9 * $cosg - 2 * $c8 * $sin2g));
3757 0         0 my $d25 = $edot ** 2;
3758 0         0 my $d17 = $xnddt / $xnodp - $xndtn ** 2;
3759             my $tsddts = 2 * $tsdtts * ($tsdtts - $d20) + $aodp * $tsi *
3760             (SGP_TOTHRD * $beta02 * $d17 - 4 * $d20 *
3761             $self->{eccentricity} * $edot + 2 *
3762 0         0 ($d25 + $self->{eccentricity} * $eddot));
3763 0         0 my $etddt = ($eddot + 2 * $edot * $tsdtts) * $tsi * SGP_S +
3764             $tsddts * $eta;
3765 0         0 my $d18 = $tsddts - $tsdtts ** 2;
3766 0         0 my $d19 = - $psdtps ** 2 / $eta2 - $eta * $etddt * $psim2 -
3767             $psdtps ** 2;
3768 0         0 my $d23 = $etdt * $etdt;
3769             my $d1ddt = $d1dt * ($d14 + $d15) + $d1 * ($d18 - 2 * $d19 +
3770             SGP_TOTHRD * $d17 + 2 * ($alpha2 * $d25 / $beta02 +
3771 0         0 $self->{eccentricity} * $eddot) / $beta02);
3772             my $xntrdt = $xndt * (2 * SGP_TOTHRD * $d17 + 3 * ($d25 +
3773             $self->{eccentricity} * $eddot) / $alpha2 -
3774             6 * $aldtal ** 2 + 4 * $d18 - 7 * $d19 ) +
3775             $c1dtc1 * $xnddt + $c1 * ($c1dtc1 * $d16 + $d9 * $etddt +
3776             $d10 * $eddot + $d23 * (6 + 30 * $eeta + 68 * $eosq) +
3777             $etdt * $edot * (40 + 30 * $eta2 + 272 * $eeta) +
3778             $d25 * (17 + 68 * $eta2) + $b1 * ($d1ddt * $d2 +
3779             2 * $d1dt * $d2dt + $d1 * ($etddt * $d11 +
3780             $d23 * (72 + 54 * $eta2))) + $b2 * ($d1ddt * $d3 +
3781             2 * $d1dt * $d3dt + $d1 * ($etddt * $d12 +
3782             $d23 * (30 + 30 * $eta2))) * $cos2g +
3783             $b3 * (($d5dt * $d14 + $d5 * ($d18 - 2 * $d19)) * $d4 +
3784             2 * $d4dt * $d5dt + $d5 * ($etddt * $d13 +
3785             22.5 * $eta * $d23)) * $sing + $xgdt1 * ((7 * $d20 +
3786 0         0 4 * $self->{eccentricity} * $edot / $beta02) *
3787             ($c5 * $cosg - 2 * $c4 * $sin2g) + ( (2 * $c5dt * $cosg -
3788             4 * $c4dt * $sin2g) - $xgdt1 * ($c5 * $sing +
3789             4 * $c4 * $cos2g))));
3790 0         0 my $tmnddt = $xnddt * 1.e9;
3791 0         0 my $temp = $tmnddt ** 2 - $xndt * 1.e18 * $xntrdt;
3792 0         0 $pp = ($temp + $tmnddt ** 2) / $temp;
3793 0         0 $gamma = - $xntrdt / ($xnddt * ($pp - 2.));
3794 0         0 $xnd = $xndt / ($pp * $gamma);
3795 0         0 $qq = 1 - $eddot / ($edot * $gamma);
3796 0         0 $ed = $edot / ($qq * $gamma);
3797 0         0 $ovgpp = 1 / ($gamma * ($pp + 1.));
3798             }
3799 2 50       14 $self->{debug} and print <
3800             Debug SGP8 - Initialize
3801 0 0       0 A3COF = @{[defined $a3cof ? $a3cof : 'undef']}
3802 0 0       0 COSI = @{[defined $cosi ? $cosi : 'undef']}
3803 0 0       0 COSIO2 = @{[defined $cosio2 ? $cosio2 : 'undef']}
3804 0 0       0 ED = @{[defined $ed ? $ed : 'undef']}
3805 0 0       0 EDOT = @{[defined $edot ? $edot : 'undef']}
3806 0 0       0 GAMMA = @{[defined $gamma ? $gamma : 'undef']}
3807 0 0       0 ISIMP = @{[defined $isimp ? $isimp : 'undef']}
3808 0 0       0 OMGDT = @{[defined $omgdt ? $omgdt : 'undef']}
3809 0 0       0 OVGPP = @{[defined $ovgpp ? $ovgpp : 'undef']}
3810 0 0       0 PP = @{[defined $pp ? $pp : 'undef']}
3811 0 0       0 QQ = @{[defined $qq ? $qq : 'undef']}
3812 0 0       0 SINI = @{[defined $sini ? $sini : 'undef']}
3813 0 0       0 SINIO2 = @{[defined $sinio2 ? $sinio2 : 'undef']}
3814 0 0       0 THETA2 = @{[defined $theta2 ? $theta2 : 'undef']}
3815 0 0       0 TTHMUN = @{[defined $tthmun ? $tthmun : 'undef']}
3816 0 0       0 UNM5TH = @{[defined $unm5th ? $unm5th : 'undef']}
3817 0 0       0 UNMTH2 = @{[defined $unmth2 ? $unmth2 : 'undef']}
3818 0 0       0 XGDT1 = @{[defined $xgdt1 ? $xgdt1 : 'undef']}
3819 0 0       0 XHDT1 = @{[defined $xhdt1 ? $xhdt1 : 'undef']}
3820 0 0       0 XLLDOT = @{[defined $xlldot ? $xlldot : 'undef']}
3821 0 0       0 XMDT1 = @{[defined $xmdt1 ? $xmdt1 : 'undef']}
3822 0 0       0 XND = @{[defined $xnd ? $xnd : 'undef']}
3823 0 0       0 XNDT = @{[defined $xndt ? $xndt : 'undef']}
3824 0 0       0 XNODOT = @{[defined $xnodot ? $xnodot : 'undef']}
3825 0 0       0 XNODP = @{[defined $xnodp ? $xnodp : 'undef']}
3826             eod
3827             {
3828 2         55 a3cof => $a3cof,
3829             cosi => $cosi,
3830             cosio2 => $cosio2,
3831             ed => $ed,
3832             edot => $edot,
3833             gamma => $gamma,
3834             isimp => $isimp,
3835             omgdt => $omgdt,
3836             ovgpp => $ovgpp,
3837             pp => $pp,
3838             qq => $qq,
3839             sini => $sini,
3840             sinio2 => $sinio2,
3841             theta2 => $theta2,
3842             tthmun => $tthmun,
3843             unm5th => $unm5th,
3844             unmth2 => $unmth2,
3845             xgdt1 => $xgdt1,
3846             xhdt1 => $xhdt1,
3847             xlldot => $xlldot,
3848             xmdt1 => $xmdt1,
3849             xnd => $xnd,
3850             xndt => $xndt,
3851             xnodot => $xnodot,
3852             xnodp => $xnodp,
3853             };
3854             };
3855              
3856             #* UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG
3857              
3858 7         48 my $xmam = mod2pi ($self->{meananomaly} + $parm->{xlldot} * $tsince);
3859 7         18 my $omgasm = $self->{argumentofperigee} + $parm->{omgdt} * $tsince;
3860 7         17 my $xnodes = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
3861              
3862             #>>> The simplified and full logic have been swapped for clarity.
3863              
3864 7         12 my ($xn, $em, $z1);
3865 7 50       24 if ($parm->{isimp}) {
3866 7         20 $xn = $parm->{xnodp} + $parm->{xndt} * $tsince;
3867 7         14 $em = $self->{eccentricity} + $parm->{edot} * $tsince;
3868 7         13 $z1 = .5 * $parm->{xndt} * $tsince * $tsince;
3869             } else {
3870 0         0 my $temp = 1 - $parm->{gamma} * $tsince;
3871 0         0 my $temp1 = $temp ** $parm->{pp};
3872 0         0 $xn = $parm->{xnodp} + $parm->{xnd} * (1 - $temp1);
3873 0         0 $em = $self->{eccentricity} + $parm->{ed} * (1 - $temp ** $parm->{qq});
3874 0         0 $z1 = $parm->{xnd} * ($tsince + $parm->{ovgpp} * ($temp * $temp1 - 1.));
3875             }
3876 7         20 my $z7 = 3.5 * SGP_TOTHRD * $z1 / $parm->{xnodp};
3877 7         19 $xmam = mod2pi ($xmam + $z1 + $z7 * $parm->{xmdt1});
3878 7         16 $omgasm = $omgasm + $z7 * $parm->{xgdt1};
3879 7         14 $xnodes = $xnodes + $z7 * $parm->{xhdt1};
3880              
3881             #* SOLVE KEPLERS EQUATION
3882              
3883 7         26 my $zc2 = $xmam + $em * sin ($xmam) * (1 + $em * cos ($xmam));
3884 7         15 my ($cose, $sine, $zc5);
3885 7         20 for (my $i = 0; $i < 10; $i++) {
3886 25         36 $sine = sin ($zc2);
3887 25         34 $cose = cos ($zc2);
3888 25         41 $zc5 = 1 / (1 - $em * $cose);
3889 25         54 my $cape = ($xmam + $em * $sine - $zc2) * $zc5 + $zc2;
3890 25 100       54 last if (abs ($cape - $zc2) <= SGP_E6A);
3891 20         34 $zc2 = $cape;
3892             }
3893              
3894             #* SHORT PERIOD PRELIMINARY QUANTITIES
3895              
3896 7         38 my $am = (SGP_XKE / $xn) ** SGP_TOTHRD;
3897 7         13 my $beta2m = 1 - $em * $em;
3898             $self->{debug}
3899 7 50       18 and warn "Debug - OID $oid sgp8 effective eccentricity $em\n";
3900 7 100       429 $beta2m < 0
3901             and croak "Error - OID $oid Sgp8 effective eccentricity > 1";
3902 5         8 my $sinos = sin ($omgasm);
3903 5         8 my $cosos = cos ($omgasm);
3904 5         9 my $axnm = $em * $cosos;
3905 5         8 my $aynm = $em * $sinos;
3906 5         7 my $pm = $am * $beta2m;
3907 5         9 my $g1 = 1 / $pm;
3908 5         7 my $g2 = .5 * SGP_CK2 * $g1;
3909 5         9 my $g3 = $g2 * $g1;
3910 5         18 my $beta = sqrt ($beta2m);
3911 5         16 my $g4 = .25 * $parm->{a3cof} * $parm->{sini};
3912 5         11 my $g5 = .25 * $parm->{a3cof} * $g1;
3913 5         8 my $snf = $beta * $sine * $zc5;
3914 5         8 my $csf = ($cose - $em) * $zc5;
3915 5         17 my $fm = _actan ($snf,$csf);
3916 5         12 my $snfg = $snf * $cosos + $csf * $sinos;
3917 5         8 my $csfg = $csf * $cosos - $snf * $sinos;
3918 5         8 my $sn2f2g = 2 * $snfg * $csfg;
3919 5         13 my $cs2f2g = 2 * $csfg ** 2 - 1;
3920 5         7 my $ecosf = $em * $csf;
3921 5         10 my $g10 = $fm - $xmam + $em * $snf;
3922 5         10 my $rm = $pm / (1 + $ecosf);
3923 5         6 my $aovr = $am / $rm;
3924 5         7 my $g13 = $xn * $aovr;
3925 5         9 my $g14 = - $g13 * $aovr;
3926 5         14 my $dr = $g2 * ($parm->{unmth2} * $cs2f2g - 3 * $parm->{tthmun}) -
3927             $g4 * $snfg;
3928 5         9 my $diwc = 3 * $g3 * $parm->{sini} * $cs2f2g - $g5 * $aynm;
3929 5         9 my $di = $diwc * $parm->{cosi};
3930              
3931             #* UPDATE FOR SHORT PERIOD PERIODICS
3932              
3933             my $sni2du = $parm->{sinio2} * ($g3 * (.5 * (1 - 7 * $parm->{theta2}) *
3934             $sn2f2g - 3 * $parm->{unm5th} * $g10) - $g5 * $parm->{sini} *
3935             $csfg * (2 + $ecosf)) - .5 * $g5 * $parm->{theta2} * $axnm /
3936 5         19 $parm->{cosio2};
3937             my $xlamb = $fm + $omgasm + $xnodes + $g3 * (.5 * (1 + 6 *
3938             $parm->{cosi} - 7 * $parm->{theta2}) * $sn2f2g - 3 *
3939             ($parm->{unm5th} + 2 * $parm->{cosi}) * $g10) +
3940             $g5 * $parm->{sini} * ($parm->{cosi} * $axnm /
3941 5         21 (1 + $parm->{cosi}) - (2 + $ecosf) * $csfg);
3942             my $y4 = $parm->{sinio2} * $snfg + $csfg * $sni2du +
3943 5         10 .5 * $snfg * $parm->{cosio2} * $di;
3944             my $y5 = $parm->{sinio2} * $csfg - $snfg * $sni2du +
3945 5         12 .5 * $csfg * $parm->{cosio2} * $di;
3946 5         7 my $r = $rm + $dr;
3947             my $rdot = $xn * $am * $em * $snf / $beta + $g14 *
3948 5         13 (2 * $g2 * $parm->{unmth2} * $sn2f2g + $g4 * $csfg);
3949             my $rvdot = $xn * $am ** 2 * $beta / $rm + $g14 * $dr +
3950 5         12 $am * $g13 * $parm->{sini} * $diwc;
3951              
3952             #* ORIENTATION VECTORS
3953              
3954 5         9 my $snlamb = sin ($xlamb);
3955 5         9 my $cslamb = cos ($xlamb);
3956 5         10 my $temp = 2 * ($y5 * $snlamb - $y4 * $cslamb);
3957 5         8 my $ux = $y4 * $temp + $cslamb;
3958 5         9 my $vx = $y5 * $temp - $snlamb;
3959 5         39 $temp = 2 * ($y5 * $cslamb + $y4 * $snlamb);
3960 5         18 my $uy = - $y4 * $temp + $snlamb;
3961 5         8 my $vy = - $y5 * $temp + $cslamb;
3962 5         24 $temp = 2 * sqrt (1 - $y4 * $y4 - $y5 * $y5);
3963 5         12 my $uz = $y4 * $temp;
3964 5         8 my $vz = $y5 * $temp;
3965              
3966             #* POSITION AND VELOCITY
3967              
3968 5         7 my $x = $r * $ux;
3969 5         10 my $y = $r * $uy;
3970 5         9 my $z = $r * $uz;
3971 5         8 my $xdot = $rdot * $ux + $rvdot * $vx;
3972 5         8 my $ydot = $rdot * $uy + $rvdot * $vy;
3973 5         7 my $zdot = $rdot * $uz + $rvdot * $vz;
3974              
3975 5         11 return _convert_out ($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
3976             }
3977              
3978             =item $tle = $tle->sdp8($time)
3979              
3980             This method calculates the position of the body described by the TLE
3981             object at the given time, using the SDP8 model. The universal time of
3982             the object is set to $time, and the 'equinox_dynamical' attribute is set
3983             to the current value of the 'epoch_dynamical' attribute.
3984              
3985             The result is the original object reference. You need to call one of
3986             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
3987             retrieve the position you just calculated.
3988              
3989             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
3990             model can be used only for near-earth orbits.
3991              
3992             =cut
3993              
3994             sub sdp8 {
3995 7     7 1 19 my ($self, $time) = @_;
3996 7         18 my $oid = $self->get('id');
3997 7         18 $self->{model_error} = undef;
3998 7         21 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
3999              
4000             #>>> Rather than use a separate indicator argument to trigger
4001             #>>> initialization of the model, we use the Orcish maneuver to
4002             #>>> retrieve the results of initialization, performing the
4003             #>>> calculations if needed. -- TRW
4004              
4005 7   66     35 my $parm = $self->{&TLE_INIT}{TLE_sdp8} ||= do {
4006 2 50       8 $self->is_deep or croak <
4007             Error - The SDP8 model is not valid for near-earth objects.
4008             Use the SGP, SGP4, SGP4R, or SGP8 models instead.
4009             EOD
4010              
4011             #* RECOVER ORIGINAL MEAN MOTION (XNODP) AND SEMIMAJOR AXIS (AODP)
4012             #* FROM INPUT ELEMENTS --------- CALCULATE BALLISTIC COEFFICIENT
4013             #* (B TERM) FROM INPUT B* DRAG TERM
4014              
4015 2         12 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
4016 2         7 my $cosi = cos ($self->{inclination});
4017 2         5 my $theta2 = $cosi * $cosi;
4018 2         8 my $tthmun = 3 * $theta2 - 1;
4019 2         5 my $eosq = $self->{eccentricity} * $self->{eccentricity};
4020 2         6 my $beta02 = 1 - $eosq;
4021 2         4 my $beta0 = sqrt ($beta02);
4022 2         8 my $del1 = 1.5 * SGP_CK2 * $tthmun / ($a1 * $a1 * $beta0 * $beta02);
4023 2         7 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD + $del1 * (1 + 134
4024             / 81 * $del1)));
4025 2         6 my $del0 = 1.5 * SGP_CK2 * $tthmun / ($a0 * $a0 * $beta0 * $beta02);
4026 2         5 my $aodp = $a0 / (1 - $del0);
4027 2         5 my $xnodp = $self->{meanmotion} / (1 + $del0);
4028 2         6 my $b = 2 * $self->{bstardrag} / SGP_RHO;
4029              
4030             #* INITIALIZATION
4031              
4032 2         4 my $po = $aodp * $beta02;
4033 2         4 my $pom2 = 1 / ($po * $po);
4034 2         5 my $sini = sin ($self->{inclination});
4035 2         6 my $sing = sin ($self->{argumentofperigee});
4036 2         5 my $cosg = cos ($self->{argumentofperigee});
4037 2         5 my $temp = .5 * $self->{inclination};
4038 2         5 my $sinio2 = sin ($temp);
4039 2         5 my $cosio2 = cos ($temp);
4040 2         5 my $theta4 = $theta2 ** 2;
4041 2         6 my $unm5th = 1 - 5 * $theta2;
4042 2         6 my $unmth2 = 1 - $theta2;
4043 2         3 my $a3cof = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
4044 2         5 my $pardt1 = 3 * SGP_CK2 * $pom2 * $xnodp;
4045 2         5 my $pardt2 = $pardt1 * SGP_CK2 * $pom2;
4046 2         5 my $pardt4 = 1.25 * SGP_CK4 * $pom2 * $pom2 * $xnodp;
4047 2         5 my $xmdt1 = .5 * $pardt1 * $beta0 * $tthmun;
4048 2         5 my $xgdt1 = - .5 * $pardt1 * $unm5th;
4049 2         5 my $xhdt1 = - $pardt1 * $cosi;
4050 2         7 my $xlldot = $xnodp + $xmdt1 + .0625 * $pardt2 * $beta0 * (13 -
4051             78 * $theta2 + 137 * $theta4);
4052 2         9 my $omgdt = $xgdt1 + .0625 * $pardt2 * (7 - 114 * $theta2 + 395
4053             * $theta4) + $pardt4 * (3 - 36 * $theta2 + 49 * $theta4);
4054 2         21 my $xnodot = $xhdt1 + (.5 * $pardt2 * (4 - 19 * $theta2) + 2 *
4055             $pardt4 * (3 - 7 * $theta2)) * $cosi;
4056 2         7 my $tsi = 1 / ($po - SGP_S);
4057 2         7 my $eta = $self->{eccentricity} * SGP_S * $tsi;
4058 2         4 my $eta2 = $eta ** 2;
4059 2         7 my $psim2 = abs (1 / (1 - $eta2));
4060 2         5 my $alpha2 = 1 + $eosq;
4061 2         4 my $eeta = $self->{eccentricity} * $eta;
4062 2         8 my $cos2g = 2 * $cosg ** 2 - 1;
4063 2         4 my $d5 = $tsi * $psim2;
4064 2         6 my $d1 = $d5 / $po;
4065 2         7 my $d2 = 12 + $eta2 * (36 + 4.5 * $eta2);
4066 2         4 my $d3 = $eta2 * (15 + 2.5 * $eta2);
4067 2         5 my $d4 = $eta * (5 + 3.75 * $eta2);
4068 2         2 my $b1 = SGP_CK2 * $tthmun;
4069 2         5 my $b2 = - SGP_CK2 * $unmth2;
4070 2         5 my $b3 = $a3cof * $sini;
4071 2         12 my $c0 = .5 * $b * SGP_RHO * SGP_QOMS2T * $xnodp * $aodp *
4072             $tsi ** 4 * $psim2 ** 3.5 / sqrt ($alpha2);
4073 2         5 my $c1 = 1.5 * $xnodp * $alpha2 ** 2 * $c0;
4074 2         4 my $c4 = $d1 * $d3 * $b2;
4075 2         9 my $c5 = $d5 * $d4 * $b3;
4076 2         12 my $xndt = $c1 * ( (2 + $eta2 * (3 + 34 * $eosq) +
4077             5 * $eeta * (4 + $eta2) + 8.5 * $eosq) + $d1 * $d2 * $b1 +
4078             $c4 * $cos2g + $c5 * $sing);
4079 2         4 my $xndtn = $xndt / $xnodp;
4080 2         6 my $edot = - SGP_TOTHRD * $xndtn * (1 - $self->{eccentricity});
4081 2         9 $self->{&TLE_INIT}{TLE_deep} = {$self->_dpinit ($eosq, $sini,
4082             $cosi, $beta0, $aodp, $theta2, $sing, $cosg, $beta02,
4083             $xlldot, $omgdt, $xnodot, $xnodp)};
4084             {
4085 2         41 a3cof => $a3cof,
4086             cosi => $cosi,
4087             cosio2 => $cosio2,
4088             ### ed => $ed,
4089             edot => $edot,
4090             ### gamma => $gamma,
4091             ### isimp => $isimp,
4092             omgdt => $omgdt,
4093             ### ovgpp => $ovgpp,
4094             ### pp => $pp,
4095             ### qq => $qq,
4096             sini => $sini,
4097             sinio2 => $sinio2,
4098             theta2 => $theta2,
4099             tthmun => $tthmun,
4100             unm5th => $unm5th,
4101             unmth2 => $unmth2,
4102             xgdt1 => $xgdt1,
4103             xhdt1 => $xhdt1,
4104             xlldot => $xlldot,
4105             xmdt1 => $xmdt1,
4106             ### xnd => $xnd,
4107             xndt => $xndt,
4108             xnodot => $xnodot,
4109             xnodp => $xnodp,
4110             };
4111             };
4112             #>>>trw my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4113              
4114             #* UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG
4115              
4116 7         19 my $z1 = .5 * $parm->{xndt} * $tsince * $tsince;
4117 7         15 my $z7 = 3.5 * SGP_TOTHRD * $z1 / $parm->{xnodp};
4118 7         17 my $xmamdf = $self->{meananomaly} + $parm->{xlldot} * $tsince;
4119             my $omgasm = $self->{argumentofperigee} + $parm->{omgdt} * $tsince +
4120 7         16 $z7 * $parm->{xgdt1};
4121             my $xnodes = $self->{ascendingnode} + $parm->{xnodot} * $tsince +
4122 7         19 $z7 * $parm->{xhdt1};
4123 7         10 my $xn = $parm->{xnodp};
4124 7         13 my ($em, $xinc);
4125 7         34 $self->_dpsec (\$xmamdf, \$omgasm, \$xnodes, \$em, \$xinc, \$xn, $tsince);
4126 7         16 $xn = $xn + $parm->{xndt} * $tsince;
4127 7         17 $em = $em + $parm->{edot} * $tsince;
4128 7         15 my $xmam = $xmamdf + $z1 + $z7 * $parm->{xmdt1};
4129 7         21 $self->_dpper (\$em, \$xinc, \$omgasm, \$xnodes, \$xmam, $tsince);
4130 7         32 $xmam = mod2pi ($xmam);
4131              
4132             #* SOLVE KEPLERS EQUATION
4133              
4134 7         21 my $zc2 = $xmam + $em * sin ($xmam) * (1 + $em * cos ($xmam));
4135 7         18 my ($cose, $sine, $zc5);
4136 7         22 for (my $i = 0; $i < 10; $i++) {
4137 38         56 $sine = sin ($zc2);
4138 38         51 $cose = cos ($zc2);
4139 38         54 $zc5 = 1 / (1 - $em * $cose);
4140 38         60 my $cape = ($xmam + $em * $sine - $zc2) * $zc5 + $zc2;
4141 38 100       77 last if (abs ($cape - $zc2) <= SGP_E6A);
4142 33         70 $zc2 = $cape;
4143             }
4144              
4145             #* SHORT PERIOD PRELIMINARY QUANTITIES
4146              
4147 7         39 my $am = (SGP_XKE / $xn) ** SGP_TOTHRD;
4148 7         18 my $beta2m = 1 - $em * $em;
4149             $self->{debug}
4150 7 50       19 and warn "Debug - OID $oid sdp8 effective eccentricity $em\n";
4151 7 100       439 $beta2m < 0
4152             and croak "Error - OID $oid Sdp8 effective eccentricity > 1";
4153 5         10 my $sinos = sin ($omgasm);
4154 5         7 my $cosos = cos ($omgasm);
4155 5         10 my $axnm = $em * $cosos;
4156 5         6 my $aynm = $em * $sinos;
4157 5         9 my $pm = $am * $beta2m;
4158 5         9 my $g1 = 1 / $pm;
4159 5         8 my $g2 = .5 * SGP_CK2 * $g1;
4160 5         7 my $g3 = $g2 * $g1;
4161 5         7 my $beta = sqrt ($beta2m);
4162 5         9 my $g4 = .25 * $parm->{a3cof} * $parm->{sini};
4163 5         7 my $g5 = .25 * $parm->{a3cof} * $g1;
4164 5         7 my $snf = $beta * $sine * $zc5;
4165 5         10 my $csf = ($cose - $em) * $zc5;
4166 5         11 my $fm = _actan ($snf,$csf);
4167 5         11 my $snfg = $snf * $cosos + $csf * $sinos;
4168 5         8 my $csfg = $csf * $cosos - $snf * $sinos;
4169 5         8 my $sn2f2g = 2 * $snfg * $csfg;
4170 5         9 my $cs2f2g = 2 * $csfg ** 2 - 1;
4171 5         8 my $ecosf = $em * $csf;
4172 5         14 my $g10 = $fm - $xmam + $em * $snf;
4173 5         8 my $rm = $pm / (1 + $ecosf);
4174 5         6 my $aovr = $am / $rm;
4175 5         14 my $g13 = $xn * $aovr;
4176 5         10 my $g14 = - $g13 * $aovr;
4177 5         11 my $dr = $g2 * ($parm->{unmth2} * $cs2f2g - 3 * $parm->{tthmun}) -
4178             $g4 * $snfg;
4179 5         9 my $diwc = 3 * $g3 * $parm->{sini} * $cs2f2g - $g5 * $aynm;
4180 5         9 my $di = $diwc * $parm->{cosi};
4181 5         9 my $sini2 = sin (.5 * $xinc);
4182              
4183             #* UPDATE FOR SHORT PERIOD PERIODICS
4184              
4185             my $sni2du = $parm->{sinio2} * ($g3 * (.5 * (1 - 7 * $parm->{theta2}) *
4186             $sn2f2g - 3 * $parm->{unm5th} * $g10) - $g5 * $parm->{sini} *
4187             $csfg * (2 + $ecosf)) - .5 * $g5 * $parm->{theta2} * $axnm /
4188 5         33 $parm->{cosio2};
4189             my $xlamb = $fm + $omgasm + $xnodes + $g3 * (.5 * (1 +
4190             6 * $parm->{cosi} - 7 * $parm->{theta2}) * $sn2f2g -
4191             3 * ($parm->{unm5th} + 2 * $parm->{cosi}) * $g10) +
4192             $g5 * $parm->{sini} * ($parm->{cosi} * $axnm /
4193 5         22 (1 + $parm->{cosi}) - (2 + $ecosf) * $csfg);
4194             my $y4 = $sini2 * $snfg + $csfg * $sni2du +
4195 5         11 .5 * $snfg * $parm->{cosio2} * $di;
4196             my $y5 = $sini2 * $csfg - $snfg * $sni2du +
4197 5         12 .5 * $csfg * $parm->{cosio2} * $di;
4198 5         11 my $r = $rm + $dr;
4199             my $rdot = $xn * $am * $em * $snf / $beta +
4200 5         11 $g14 * (2 * $g2 * $parm->{unmth2} * $sn2f2g + $g4 * $csfg);
4201             my $rvdot = $xn * $am ** 2 * $beta / $rm + $g14 * $dr +
4202 5         12 $am * $g13 * $parm->{sini} * $diwc;
4203              
4204             #* ORIENTATION VECTORS
4205              
4206 5         17 my $snlamb = sin ($xlamb);
4207 5         9 my $cslamb = cos ($xlamb);
4208 5         9 my $temp = 2 * ($y5 * $snlamb - $y4 * $cslamb);
4209 5         8 my $ux = $y4 * $temp + $cslamb;
4210 5         9 my $vx = $y5 * $temp - $snlamb;
4211 5         8 $temp = 2 * ($y5 * $cslamb + $y4 * $snlamb);
4212 5         8 my $uy = - $y4 * $temp + $snlamb;
4213 5         8 my $vy = - $y5 * $temp + $cslamb;
4214 5         11 $temp = 2 * sqrt (1 - $y4 * $y4 - $y5 * $y5);
4215 5         6 my $uz = $y4 * $temp;
4216 5         12 my $vz = $y5 * $temp;
4217              
4218             #* POSITION AND VELOCITY
4219              
4220 5         11 my $x = $r * $ux;
4221 5         5 my $y = $r * $uy;
4222 5         7 my $z = $r * $uz;
4223 5         15 my $xdot = $rdot * $ux + $rvdot * $vx;
4224 5         9 my $ydot = $rdot * $uy + $rvdot * $vy;
4225 5         13 my $zdot = $rdot * $uz + $rvdot * $vz;
4226              
4227 5         11 return _convert_out ($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
4228             }
4229              
4230             =item $self->time_set();
4231              
4232             This method sets the coordinates of the object to whatever is
4233             computed by the model specified by the model attribute. The
4234             'equinox_dynamical' attribute is set to the current value of the
4235             'epoch_dynamical' attribute.
4236              
4237             Although there is no reason this method can not be called directly, it
4238             exists to take advantage of the hook in the B
4239             object, to allow the position of the body to be computed when the
4240             time of the object is set.
4241              
4242             =cut
4243              
4244             sub time_set {
4245 18318     18318 1 31684 my $self = shift;
4246 18318 50       45005 my $model = $self->{model} or return;
4247 18318         38852 $self->$model ($self->universal);
4248 18304         34764 return;
4249             }
4250              
4251             #######################################################################
4252              
4253             # The deep-space routines
4254              
4255 16     16   169 use constant DS_ZNS => 1.19459E-5;
  16         61  
  16         1072  
4256 16     16   117 use constant DS_C1SS => 2.9864797E-6;
  16         68  
  16         1185  
4257 16     16   106 use constant DS_ZES => .01675;
  16         38  
  16         805  
4258 16     16   98 use constant DS_ZNL => 1.5835218E-4;
  16         49  
  16         942  
4259 16     16   124 use constant DS_C1L => 4.7968065E-7;
  16         44  
  16         902  
4260 16     16   104 use constant DS_ZEL => .05490;
  16         29  
  16         819  
4261 16     16   101 use constant DS_ZCOSIS => .91744867;
  16         71  
  16         966  
4262 16     16   99 use constant DS_ZSINIS => .39785416;
  16         36  
  16         826  
4263 16     16   107 use constant DS_ZSINGS => -.98088458;
  16         35  
  16         923  
4264 16     16   115 use constant DS_ZCOSGS => .1945905;
  16         35  
  16         809  
4265 16     16   105 use constant DS_ZCOSHS => 1.0;
  16         57  
  16         1064  
4266 16     16   119 use constant DS_ZSINHS => 0.0;
  16         45  
  16         1045  
4267 16     16   137 use constant DS_Q22 => 1.7891679E-6;
  16         51  
  16         803  
4268 16     16   99 use constant DS_Q31 => 2.1460748E-6;
  16         31  
  16         826  
4269 16     16   464 use constant DS_Q33 => 2.2123015E-7;
  16         40  
  16         812  
4270 16     16   501 use constant DS_G22 => 5.7686396;
  16         36  
  16         806  
4271 16     16   407 use constant DS_G32 => 0.95240898;
  16         56  
  16         952  
4272 16     16   98 use constant DS_G44 => 1.8014998;
  16         33  
  16         813  
4273 16     16   108 use constant DS_G52 => 1.0508330;
  16         37  
  16         803  
4274 16     16   107 use constant DS_G54 => 4.4108898;
  16         34  
  16         765  
4275 16     16   117 use constant DS_ROOT22 => 1.7891679E-6;
  16         65  
  16         829  
4276 16     16   131 use constant DS_ROOT32 => 3.7393792E-7;
  16         30  
  16         872  
4277 16     16   102 use constant DS_ROOT44 => 7.3636953E-9;
  16         29  
  16         827  
4278 16     16   89 use constant DS_ROOT52 => 1.1428639E-7;
  16         49  
  16         827  
4279 16     16   92 use constant DS_ROOT54 => 2.1765803E-9;
  16         59  
  16         840  
4280 16     16   103 use constant DS_THDT => 4.3752691E-3;
  16         36  
  16         93112  
4281              
4282             # _dpinit
4283             #
4284             # the corresponding FORTRAN IV simply leaves values in variables
4285             # for the use of the other deep-space routines. For the Perl
4286             # translation, we figure out which ones are actually used, and
4287             # return a list of key/value pairs to be added to the pre-
4288             # computed model parameters. -- TRW
4289              
4290             sub _dpinit {
4291 4     4   17 my ($self, $eqsq, $siniq, $cosiq, $rteqsq, $a0, $cosq2, $sinomo,
4292             $cosomo, $bsq, $xlldot, $omgdt, $xnodot, $xnodp) = @_;
4293              
4294 4         19 my $thgr = thetag ($self->{epoch});
4295 4         23 my $eq = $self->{eccentricity};
4296 4         7 my $xnq = $xnodp;
4297 4         9 my $aqnv = 1 / $a0;
4298 4         15 my $xqncl = $self->{inclination};
4299 4         7 my $xmao = $self->{meananomaly};
4300 4         9 my $xpidot = $omgdt + $xnodot;
4301 4         10 my $sinq = sin ($self->{ascendingnode});
4302 4         11 my $cosq = cos ($self->{ascendingnode});
4303              
4304             #* Initialize lunar & solar terms
4305              
4306 4         15 my $day = $self->{ds50} + 18261.5;
4307              
4308             #>>> The original code contained here a comparison of DAY to
4309             #>>> uninitialized variable PREEP, and "optimized out" the
4310             #>>> following if they were equal. This works naturally in
4311             #>>> FORTRAN, which has a different concept of variable scoping.
4312             #>>> Rather than make this work in Perl, I have removed the
4313             #>>> test. As I understand the FORTRAN, it's only used if
4314             #>>> consecutive data sets have exactly the same epoch. Given
4315             #>>> that this is initialization code, the optimization is
4316             #>>> (I hope!) not that important, and given the mess that
4317             #>>> follows, its absence will not (I hope!) be noticable. - TRW
4318              
4319 4         10 my $xnodce = 4.5236020 - 9.2422029E-4 * $day;
4320 4         8 my $stem = sin ($xnodce);
4321 4         7 my $ctem = cos ($xnodce);
4322 4         9 my $zcosil = .91375164 - .03568096 * $ctem;
4323 4         8 my $zsinil = sqrt (1 - $zcosil * $zcosil);
4324 4         10 my $zsinhl = .089683511 * $stem / $zsinil;
4325 4         8 my $zcoshl = sqrt (1 - $zsinhl * $zsinhl);
4326 4         9 my $c = 4.7199672 + .22997150 * $day;
4327 4         7 my $gam = 5.8351514 + .0019443680 * $day;
4328 4         13 my $zmol = mod2pi ($c - $gam);
4329 4         8 my $zx = .39785416 * $stem / $zsinil;
4330 4         10 my $zy = $zcoshl * $ctem + 0.91744867 * $zsinhl * $stem;
4331 4         16 $zx = _actan ($zx, $zy);
4332 4         10 $zx = $gam + $zx - $xnodce;
4333 4         6 my $zcosgl = cos ($zx);
4334 4         10 my $zsingl = sin ($zx);
4335 4         14 my $zmos = mod2pi (6.2565837 + .017201977 * $day);
4336              
4337             #>>> Here endeth the optimization - only it isn't one any more
4338             #>>> since I removed it. - TRW
4339              
4340             #>>> The following loop replaces some spaghetti involving an
4341             #>>> assigned goto which essentially executes the same big chunk
4342             #>>> of obscure code twice: once for the Sun, and once for the Moon.
4343             #>>> The comments "Do Solar terms" and "Do Lunar terms" in the
4344             #>>> original apply to the first and second iterations of the loop,
4345             #>>> respectively. The "my" variables declared just before the "for"
4346             #>>> are those values computed inside the loop that are used outside
4347             #>>> the loop. Accumulators are set to zero. -- TRW
4348              
4349             #>>>trw my $savtsn = 1.0E20;
4350 4         12 my $xnoi = 1 / $xnq;
4351 4         12 my ($sse, $ssi, $ssl, $ssh, $ssg) = (0, 0, 0, 0, 0);
4352 4         11 my ($se2, $ee2, $si2, $xi2, $sl2, $xl2, $sgh2, $xgh2, $sh2, $xh2, $se3,
4353             $e3, $si3, $xi3, $sl3, $xl3, $sgh3, $xgh3, $sh3, $xh3, $sl4, $xl4,
4354             $sgh4, $xgh4);
4355              
4356 4         39 foreach my $inputs (
4357             [DS_ZCOSGS, DS_ZSINGS, DS_ZCOSIS, DS_ZSINIS, $cosq, $sinq,
4358             DS_C1SS, DS_ZNS, DS_ZES, $zmos, 0],
4359             [$zcosgl, $zsingl, $zcosil, $zsinil,
4360             $zcoshl * $cosq + $zsinhl * $sinq,
4361             $sinq * $zcoshl - $cosq * $zsinhl, DS_C1L, DS_ZNL,
4362             DS_ZEL, $zmol, 1],
4363             ) {
4364              
4365             #>>> Pick off the terms specific to the body being covered by this
4366             #>>> iteration. The $lunar flag was not in the original FORTRAN, but
4367             #>>> was added to help convert the assigned GOTOs and associated
4368             #>>> code into a loop. -- TRW
4369              
4370             #>>>trw my ($zcosg, $zsing, $zcosi, $zsini, $zcosh, $zsinh, $cc, $zn, $ze,
4371             #>>>trw $zmo, $lunar) = @$inputs;
4372 8         26 my ($zcosg, $zsing, $zcosi, $zsini, $zcosh, $zsinh, $cc, $zn, $ze,
4373             undef, $lunar) = @$inputs;
4374              
4375             #>>> From here until the next comment of mine is essentialy
4376             #>>> verbatim from the original FORTRAN - or as verbatim as
4377             #>>> is reasonable considering that the following is Perl. -- TRW
4378              
4379 8         12 my $a1 = $zcosg * $zcosh + $zsing * $zcosi * $zsinh;
4380 8         19 my $a3 = - $zsing * $zcosh + $zcosg * $zcosi * $zsinh;
4381 8         16 my $a7 = - $zcosg * $zsinh + $zsing * $zcosi * $zcosh;
4382 8         19 my $a8 = $zsing * $zsini;
4383 8         16 my $a9 = $zsing * $zsinh + $zcosg * $zcosi * $zcosh;
4384 8         12 my $a10 = $zcosg * $zsini;
4385 8         24 my $a2 = $cosiq * $a7 + $siniq * $a8;
4386 8         15 my $a4 = $cosiq * $a9 + $siniq * $a10;
4387 8         14 my $a5 = - $siniq * $a7 + $cosiq * $a8;
4388 8         17 my $a6 = - $siniq * $a9 + $cosiq * $a10;
4389             #C
4390 8         17 my $x1 = $a1 * $cosomo + $a2 * $sinomo;
4391 8         14 my $x2 = $a3 * $cosomo + $a4 * $sinomo;
4392 8         15 my $x3 = - $a1 * $sinomo + $a2 * $cosomo;
4393 8         12 my $x4 = - $a3 * $sinomo + $a4 * $cosomo;
4394 8         12 my $x5 = $a5 * $sinomo;
4395 8         13 my $x6 = $a6 * $sinomo;
4396 8         15 my $x7 = $a5 * $cosomo;
4397 8         11 my $x8 = $a6 * $cosomo;
4398             #C
4399 8         16 my $z31 = 12 * $x1 * $x1 - 3 * $x3 * $x3;
4400 8         14 my $z32 = 24 * $x1 * $x2 - 6 * $x3 * $x4;
4401 8         14 my $z33 = 12 * $x2 * $x2 - 3 * $x4 * $x4;
4402 8         15 my $z1 = 3 * ($a1 * $a1 + $a2 * $a2) + $z31 * $eqsq;
4403 8         13 my $z2 = 6 * ($a1 * $a3 + $a2 * $a4) + $z32 * $eqsq;
4404 8         184 my $z3 = 3 * ($a3 * $a3 + $a4 * $a4) + $z33 * $eqsq;
4405 8         22 my $z11 = - 6 * $a1 * $a5 + $eqsq * ( - 24 * $x1 * $x7 - 6 * $x3 * $x5);
4406 8         28 my $z12 = - 6 * ($a1 * $a6 + $a3 * $a5) + $eqsq *
4407             ( - 24 * ($x2 * $x7 + $x1 * $x8) - 6 * ($x3 * $x6 + $x4 * $x5));
4408 8         20 my $z13 = - 6 * $a3 * $a6 + $eqsq * ( - 24 * $x2 * $x8 - 6 * $x4 * $x6);
4409 8         15 my $z21 = 6 * $a2 * $a5 + $eqsq * (24 * $x1 * $x5 - 6 * $x3 * $x7);
4410 8         19 my $z22 = 6 * ($a4 * $a5 + $a2 * $a6) + $eqsq *
4411             (24 * ($x2 * $x5 + $x1 * $x6) - 6 * ($x4 * $x7 + $x3 * $x8));
4412 8         19 my $z23 = 6 * $a4 * $a6 + $eqsq * (24 * $x2 * $x6 - 6 * $x4 * $x8);
4413 8         12 $z1 = $z1 + $z1 + $bsq * $z31;
4414 8         17 $z2 = $z2 + $z2 + $bsq * $z32;
4415 8         143 $z3 = $z3 + $z3 + $bsq * $z33;
4416 8         18 my $s3 = $cc * $xnoi;
4417 8         13 my $s2 = - .5 * $s3 / $rteqsq;
4418 8         13 my $s4 = $s3 * $rteqsq;
4419 8         12 my $s1 = - 15 * $eq * $s4;
4420 8         14 my $s5 = $x1 * $x3 + $x2 * $x4;
4421 8         13 my $s6 = $x2 * $x3 + $x1 * $x4;
4422 8         17 my $s7 = $x2 * $x4 - $x1 * $x3;
4423 8         16 my $se = $s1 * $zn * $s5;
4424 8         11 my $si = $s2 * $zn * ($z11 + $z13);
4425 8         16 my $sl = - $zn * $s3 * ($z1 + $z3 - 14 - 6 * $eqsq);
4426 8         15 my $sgh = $s4 * $zn * ($z31 + $z33 - 6.);
4427 8 50       23 my $sh = $xqncl < 5.2359877E-2 ? 0 : - $zn * $s2 * ($z21 + $z23);
4428 8         12 $ee2 = 2 * $s1 * $s6;
4429 8         33 $e3 = 2 * $s1 * $s7;
4430 8         14 $xi2 = 2 * $s2 * $z12;
4431 8         21 $xi3 = 2 * $s2 * ($z13 - $z11);
4432 8         21 $xl2 = - 2 * $s3 * $z2;
4433 8         14 $xl3 = - 2 * $s3 * ($z3 - $z1);
4434 8         20 $xl4 = - 2 * $s3 * ( - 21 - 9 * $eqsq) * $ze;
4435 8         14 $xgh2 = 2 * $s4 * $z32;
4436 8         14 $xgh3 = 2 * $s4 * ($z33 - $z31);
4437 8         12 $xgh4 = - 18 * $s4 * $ze;
4438 8         12 $xh2 = - 2 * $s2 * $z22;
4439 8         13 $xh3 = - 2 * $s2 * ($z23 - $z21);
4440              
4441             #>>> The following intermediate values are used outside the loop.
4442             #>>> We save off the Solar values. The Lunar values remain after
4443             #>>> the second iteration, and are used in situ. -- TRW
4444              
4445 8 100       19 unless ($lunar) {
4446 4         7 $se2 = $ee2;
4447 4         7 $si2 = $xi2;
4448 4         6 $sl2 = $xl2;
4449 4         8 $sgh2 = $xgh2;
4450 4         6 $sh2 = $xh2;
4451 4         6 $se3 = $e3;
4452 4         7 $si3 = $xi3;
4453 4         5 $sl3 = $xl3;
4454 4         6 $sgh3 = $xgh3;
4455 4         5 $sh3 = $xh3;
4456 4         8 $sl4 = $xl4;
4457 4         5 $sgh4 = $xgh4;
4458             }
4459              
4460             #>>> Okay, now we accumulate everything that needs accumulating.
4461             #>>> The Lunar calculation is slightly different from the solar
4462             #>>> one, a problem we fix up using the introduced $lunar flag.
4463             #>>> -- TRW
4464              
4465 8         16 $sse = $sse + $se;
4466 8         13 $ssi = $ssi + $si;
4467 8         12 $ssl = $ssl + $sl;
4468 8         18 $ssh = $ssh + $sh / $siniq;
4469 8 100       28 $ssg = $ssg + $sgh - ($lunar ? $cosiq / $siniq * $sh : $cosiq * $ssh);
4470              
4471             }
4472              
4473             #>>> The only substantial modification in the following is the
4474             #>>> swapping of 24-hour and 12-hour calculations for clarity.
4475             #>>> -- TRW
4476              
4477 4         14 my $iresfl = 0;
4478 4         5 my $isynfl = 0;
4479 4         21 my ($bfact, $xlamo);
4480 4         0 my ($d2201, $d2211, $d3210, $d3222, $d4410, $d4422,
4481             $d5220, $d5232, $d5421, $d5433,
4482             $del1, $del2, $del3, $fasx2, $fasx4, $fasx6);
4483              
4484 4 50 33     44 if ($xnq < .0052359877 && $xnq > .0034906585) {
    50 33        
      33        
4485              
4486             #* Synchronous resonance terms initialization.
4487              
4488 0         0 $iresfl = 1;
4489 0         0 $isynfl = 1;
4490 0         0 my $g200 = 1.0 + $eqsq * ( - 2.5 + .8125 * $eqsq);
4491 0         0 my $g310 = 1.0 + 2.0 * $eqsq;
4492 0         0 my $g300 = 1.0 + $eqsq * ( - 6.0 + 6.60937 * $eqsq);
4493 0         0 my $f220 = .75 * (1 + $cosiq) * (1 + $cosiq);
4494 0         0 my $f311 = .9375 * $siniq * $siniq * (1 + 3 * $cosiq) - .75 * (1
4495             + $cosiq);
4496 0         0 my $f330 = 1 + $cosiq;
4497 0         0 $f330 = 1.875 * $f330 * $f330 * $f330;
4498 0         0 $del1 = 3 * $xnq * $xnq * $aqnv * $aqnv;
4499 0         0 $del2 = 2 * $del1 * $f220 * $g200 * DS_Q22;
4500 0         0 $del3 = 3 * $del1 * $f330 * $g300 * DS_Q33 * $aqnv;
4501 0         0 $del1 = $del1 * $f311 * $g310 * DS_Q31 * $aqnv;
4502 0         0 $fasx2 = .13130908;
4503 0         0 $fasx4 = 2.8843198;
4504 0         0 $fasx6 = .37448087;
4505             $xlamo = $xmao + $self->{ascendingnode} +
4506 0         0 $self->{argumentofperigee} - $thgr;
4507 0         0 $bfact = $xlldot + $xpidot - DS_THDT;
4508 0         0 $bfact = $bfact + $ssl + $ssg + $ssh;
4509             } elsif ($xnq < 8.26E-3 || $xnq > 9.24E-3 || $eq < 0.5) {
4510              
4511             #>>> Do nothing. The original code returned from this point,
4512             #>>> leaving atime, step2, stepn, stepp, xfact, xli, and xni
4513             #>>> uninitialized. It's a minor bit of wasted motion to
4514             #>>> compute these when they're not used, but this way the
4515             #>>> method returns from only one point, which makes the
4516             #>>> provision of debug output easier.
4517              
4518             } else {
4519              
4520             #* Geopotential resonance initialization for 12 hour orbits
4521              
4522 0         0 $iresfl = 1;
4523 0         0 my $eoc = $eq * $eqsq;
4524 0         0 my $g201 = - .306 - ($eq - .64) * .440;
4525 0         0 my ($g211, $g310, $g322, $g410, $g422, $g520);
4526 0 0       0 if ($eq <= .65) {
4527 0         0 $g211 = 3.616 - 13.247 * $eq + 16.290 * $eqsq;
4528 0         0 $g310 = - 19.302 + 117.390 * $eq - 228.419 * $eqsq + 156.591
4529             * $eoc;
4530 0         0 $g322 = - 18.9068 + 109.7927 * $eq - 214.6334 * $eqsq +
4531             146.5816 * $eoc;
4532 0         0 $g410 = - 41.122 + 242.694 * $eq - 471.094 * $eqsq + 313.953
4533             * $eoc;
4534 0         0 $g422 = - 146.407 + 841.880 * $eq - 1629.014 * $eqsq +
4535             1083.435 * $eoc;
4536 0         0 $g520 = - 532.114 + 3017.977 * $eq - 5740 * $eqsq + 3708.276
4537             * $eoc;
4538             } else {
4539 0         0 $g211 = - 72.099 + 331.819 * $eq - 508.738 * $eqsq +
4540             266.724 * $eoc;
4541 0         0 $g310 = - 346.844 + 1582.851 * $eq - 2415.925 * $eqsq +
4542             1246.113 * $eoc;
4543 0         0 $g322 = - 342.585 + 1554.908 * $eq - 2366.899 * $eqsq +
4544             1215.972 * $eoc;
4545 0         0 $g410 = - 1052.797 + 4758.686 * $eq - 7193.992 * $eqsq +
4546             3651.957 * $eoc;
4547 0         0 $g422 = - 3581.69 + 16178.11 * $eq - 24462.77 * $eqsq +
4548             12422.52 * $eoc;
4549 0 0       0 $g520 = $eq > .715 ?
4550             -5149.66 + 29936.92 * $eq - 54087.36 * $eqsq + 31324.56 * $eoc :
4551             1464.74 - 4664.75 * $eq + 3763.64 * $eqsq;
4552             }
4553 0         0 my ($g533, $g521, $g532);
4554 0 0       0 if ($eq < .7) {
4555 0         0 $g533 = - 919.2277 + 4988.61 * $eq - 9064.77 * $eqsq +
4556             5542.21 * $eoc;
4557 0         0 $g521 = - 822.71072 + 4568.6173 * $eq - 8491.4146 * $eqsq +
4558             5337.524 * $eoc;
4559 0         0 $g532 = - 853.666 + 4690.25 * $eq - 8624.77 * $eqsq +
4560             5341.4 * $eoc;
4561             } else {
4562 0         0 $g533 = - 37995.78 + 161616.52 * $eq - 229838.2 * $eqsq +
4563             109377.94 * $eoc;
4564 0         0 $g521 = - 51752.104 + 218913.95 * $eq - 309468.16 * $eqsq +
4565             146349.42 * $eoc;
4566 0         0 $g532 = - 40023.88 + 170470.89 * $eq - 242699.48 * $eqsq +
4567             115605.82 * $eoc;
4568             }
4569              
4570 0         0 my $sini2 = $siniq * $siniq;
4571 0         0 my $f220 = .75 * (1 + 2 * $cosiq + $cosq2);
4572 0         0 my $f221 = 1.5 * $sini2;
4573 0         0 my $f321 = 1.875 * $siniq * (1 - 2 * $cosiq - 3 * $cosq2);
4574 0         0 my $f322 = - 1.875 * $siniq * (1 + 2 * $cosiq - 3 * $cosq2);
4575 0         0 my $f441 = 35 * $sini2 * $f220;
4576 0         0 my $f442 = 39.3750 * $sini2 * $sini2;
4577 0         0 my $f522 = 9.84375 * $siniq * ($sini2 * (1 - 2 * $cosiq - 5 * $cosq2) +
4578             .33333333 * ( - 2 + 4 * $cosiq + 6 * $cosq2));
4579 0         0 my $f523 = $siniq * (4.92187512 * $sini2 * ( - 2 - 4 * $cosiq +
4580             10 * $cosq2) + 6.56250012 * (1 + 2 * $cosiq - 3 * $cosq2));
4581 0         0 my $f542 = 29.53125 * $siniq * (2 - 8 * $cosiq + $cosq2 * ( - 12 +
4582             8 * $cosiq + 10 * $cosq2));
4583 0         0 my $f543 = 29.53125 * $siniq * ( - 2 - 8 * $cosiq + $cosq2 * (12 +
4584             8 * $cosiq - 10 * $cosq2));
4585 0         0 my $xno2 = $xnq * $xnq;
4586 0         0 my $ainv2 = $aqnv * $aqnv;
4587 0         0 my $temp1 = 3 * $xno2 * $ainv2;
4588 0         0 my $temp = $temp1 * DS_ROOT22;
4589 0         0 $d2201 = $temp * $f220 * $g201;
4590 0         0 $d2211 = $temp * $f221 * $g211;
4591 0         0 $temp1 = $temp1 * $aqnv;
4592 0         0 $temp = $temp1 * DS_ROOT32;
4593 0         0 $d3210 = $temp * $f321 * $g310;
4594 0         0 $d3222 = $temp * $f322 * $g322;
4595 0         0 $temp1 = $temp1 * $aqnv;
4596 0         0 $temp = 2 * $temp1 * DS_ROOT44;
4597 0         0 $d4410 = $temp * $f441 * $g410;
4598 0         0 $d4422 = $temp * $f442 * $g422;
4599 0         0 $temp1 = $temp1 * $aqnv;
4600 0         0 $temp = $temp1 * DS_ROOT52;
4601 0         0 $d5220 = $temp * $f522 * $g520;
4602 0         0 $d5232 = $temp * $f523 * $g532;
4603 0         0 $temp = 2 * $temp1 * DS_ROOT54;
4604 0         0 $d5421 = $temp * $f542 * $g521;
4605 0         0 $d5433 = $temp * $f543 * $g533;
4606             $xlamo = $xmao + $self->{ascendingnode} + $self->{ascendingnode} -
4607 0         0 $thgr - $thgr;
4608 0         0 $bfact = $xlldot + $xnodot + $xnodot - DS_THDT - DS_THDT;
4609 0         0 $bfact = $bfact + $ssl + $ssh + $ssh;
4610             }
4611              
4612             # $bfact won't be defined unless we're a 12- or 24-hour orbit.
4613 4         15 my $xfact;
4614 4 50       10 defined $bfact and $xfact = $bfact - $xnq;
4615             #C
4616             #C INITIALIZE INTEGRATOR
4617             #C
4618 4         8 my $xli = $xlamo;
4619 4         28 my $xni = $xnq;
4620 4         9 my $atime = 0;
4621 4         7 my $stepp = 720;
4622 4         10 my $stepn = -720;
4623 4         8 my $step2 = 259200;
4624              
4625 4 50       14 $self->{debug} and do {
4626 0         0 local $Data::Dumper::Terse = 1;
4627 0         0 print <
4628             Debug _dpinit -
4629 0 0       0 atime = @{[defined $atime ? $atime : q{undef}]}
4630 0 0       0 cosiq = @{[defined $cosiq ? $cosiq : q{undef}]}
4631 0 0       0 d2201 = @{[defined $d2201 ? $d2201 : q{undef}]}
4632 0 0       0 d2211 = @{[defined $d2211 ? $d2211 : q{undef}]}
4633 0 0       0 d3210 = @{[defined $d3210 ? $d3210 : q{undef}]}
4634 0 0       0 d3222 = @{[defined $d3222 ? $d3222 : q{undef}]}
4635 0 0       0 d4410 = @{[defined $d4410 ? $d4410 : q{undef}]}
4636 0 0       0 d4422 = @{[defined $d4422 ? $d4422 : q{undef}]}
4637 0 0       0 d5220 = @{[defined $d5220 ? $d5220 : q{undef}]}
4638 0 0       0 d5232 = @{[defined $d5232 ? $d5232 : q{undef}]}
4639 0 0       0 d5421 = @{[defined $d5421 ? $d5421 : q{undef}]}
4640 0 0       0 d5433 = @{[defined $d5433 ? $d5433 : q{undef}]}
4641 0 0       0 del1 = @{[defined $del1 ? $del1 : q{undef}]}
4642 0 0       0 del2 = @{[defined $del2 ? $del2 : q{undef}]}
4643 0 0       0 del3 = @{[defined $del3 ? $del3 : q{undef}]}
4644 0 0       0 e3 = @{[defined $e3 ? $e3 : q{undef}]}
4645 0 0       0 ee2 = @{[defined $ee2 ? $ee2 : q{undef}]}
4646 0 0       0 fasx2 = @{[defined $fasx2 ? $fasx2 : q{undef}]}
4647 0 0       0 fasx4 = @{[defined $fasx4 ? $fasx4 : q{undef}]}
4648 0 0       0 fasx6 = @{[defined $fasx6 ? $fasx6 : q{undef}]}
4649 0 0       0 iresfl = @{[defined $iresfl ? $iresfl : q{undef}]}
4650 0 0       0 isynfl = @{[defined $isynfl ? $isynfl : q{undef}]}
4651 0 0       0 omgdt = @{[defined $omgdt ? $omgdt : q{undef}]}
4652 0 0       0 se2 = @{[defined $se2 ? $se2 : q{undef}]}
4653 0 0       0 se3 = @{[defined $se3 ? $se3 : q{undef}]}
4654 0 0       0 sgh2 = @{[defined $sgh2 ? $sgh2 : q{undef}]}
4655 0 0       0 sgh3 = @{[defined $sgh3 ? $sgh3 : q{undef}]}
4656 0 0       0 sgh4 = @{[defined $sgh4 ? $sgh4 : q{undef}]}
4657 0 0       0 sh2 = @{[defined $sh2 ? $sh2 : q{undef}]}
4658 0 0       0 sh3 = @{[defined $sh3 ? $sh3 : q{undef}]}
4659 0 0       0 si2 = @{[defined $si2 ? $si2 : q{undef}]}
4660 0 0       0 si3 = @{[defined $si3 ? $si3 : q{undef}]}
4661 0 0       0 siniq = @{[defined $siniq ? $siniq : q{undef}]}
4662 0 0       0 sl2 = @{[defined $sl2 ? $sl2 : q{undef}]}
4663 0 0       0 sl3 = @{[defined $sl3 ? $sl3 : q{undef}]}
4664 0 0       0 sl4 = @{[defined $sl4 ? $sl4 : q{undef}]}
4665 0 0       0 sse = @{[defined $sse ? $sse : q{undef}]}
4666 0 0       0 ssg = @{[defined $ssg ? $ssg : q{undef}]} << 9.4652e-09 in test_sgp-c-lib
4667 0 0       0 ssh = @{[defined $ssh ? $ssh : q{undef}]}
4668 0 0       0 ssi = @{[defined $ssi ? $ssi : q{undef}]}
4669 0 0       0 ssl = @{[defined $ssl ? $ssl : q{undef}]}
4670 0 0       0 step2 = @{[defined $step2 ? $step2 : q{undef}]}
4671 0 0       0 stepn = @{[defined $stepn ? $stepn : q{undef}]}
4672 0 0       0 stepp = @{[defined $stepp ? $stepp : q{undef}]}
4673 0 0       0 thgr = @{[defined $thgr ? $thgr : q{undef}]} << 1.26513 in test_sgp-c-lib
4674 0 0       0 xfact = @{[defined $xfact ? $xfact : q{undef}]}
4675 0 0       0 xgh2 = @{[defined $xgh2 ? $xgh2 : q{undef}]}
4676 0 0       0 xgh3 = @{[defined $xgh3 ? $xgh3 : q{undef}]}
4677 0 0       0 xgh4 = @{[defined $xgh4 ? $xgh4 : q{undef}]}
4678 0 0       0 xh2 = @{[defined $xh2 ? $xh2 : q{undef}]}
4679 0 0       0 xh3 = @{[defined $xh3 ? $xh3 : q{undef}]}
4680 0 0       0 xi2 = @{[defined $xi2 ? $xi2 : q{undef}]}
4681 0 0       0 xi3 = @{[defined $xi3 ? $xi3 : q{undef}]}
4682 0 0       0 xl2 = @{[defined $xl2 ? $xl2 : q{undef}]}
4683 0 0       0 xl3 = @{[defined $xl3 ? $xl3 : q{undef}]}
4684 0 0       0 xl4 = @{[defined $xl4 ? $xl4 : q{undef}]}
4685 0 0       0 xlamo = @{[defined $xlamo ? $xlamo : q{undef}]}
4686 0 0       0 xli = @{[defined $xli ? $xli : q{undef}]}
4687 0 0       0 xni = @{[defined $xni ? $xni : q{undef}]}
4688 0 0       0 xnq = @{[defined $xnq ? $xnq : q{undef}]}
4689 0 0       0 zmol = @{[defined $zmol ? $zmol : q{undef}]}
4690 0 0       0 zmos = @{[defined $zmos ? $zmos : q{undef}]}
4691             eod
4692             };
4693              
4694             return (
4695 4         198 atime => $atime,
4696             cosiq => $cosiq,
4697             d2201 => $d2201,
4698             d2211 => $d2211,
4699             d3210 => $d3210,
4700             d3222 => $d3222,
4701             d4410 => $d4410,
4702             d4422 => $d4422,
4703             d5220 => $d5220,
4704             d5232 => $d5232,
4705             d5421 => $d5421,
4706             d5433 => $d5433,
4707             del1 => $del1,
4708             del2 => $del2,
4709             del3 => $del3,
4710             e3 => $e3,
4711             ee2 => $ee2,
4712             fasx2 => $fasx2,
4713             fasx4 => $fasx4,
4714             fasx6 => $fasx6,
4715             iresfl => $iresfl,
4716             isynfl => $isynfl,
4717             omgdt => $omgdt,
4718             se2 => $se2,
4719             se3 => $se3,
4720             sgh2 => $sgh2,
4721             sgh3 => $sgh3,
4722             sgh4 => $sgh4,
4723             sh2 => $sh2,
4724             sh3 => $sh3,
4725             si2 => $si2,
4726             si3 => $si3,
4727             siniq => $siniq,
4728             sl2 => $sl2,
4729             sl3 => $sl3,
4730             sl4 => $sl4,
4731             sse => $sse,
4732             ssg => $ssg,
4733             ssh => $ssh,
4734             ssi => $ssi,
4735             ssl => $ssl,
4736             step2 => $step2,
4737             stepn => $stepn,
4738             stepp => $stepp,
4739             thgr => $thgr,
4740             xfact => $xfact,
4741             xgh2 => $xgh2,
4742             xgh3 => $xgh3,
4743             xgh4 => $xgh4,
4744             xh2 => $xh2,
4745             xh3 => $xh3,
4746             xi2 => $xi2,
4747             xi3 => $xi3,
4748             xl2 => $xl2,
4749             xl3 => $xl3,
4750             xl4 => $xl4,
4751             xlamo => $xlamo,
4752             xli => $xli,
4753             xni => $xni,
4754             xnq => $xnq,
4755             zmol => $zmol,
4756             zmos => $zmos,
4757             );
4758             }
4759              
4760             # _dpsec
4761              
4762             # Compute deep space secular effects.
4763              
4764             # The corresponding FORTRAN was a goodly plate of spaghetti, with
4765             # a couple chunks of code being executed via assigned GOTOs. Not
4766             # only that, but most of the arguments get modified, and
4767             # therefore need to be passed by reference. So the corresponding
4768             # PERL may not end up corresponding very closely.
4769              
4770             # In fact, at this point in the code the only argument that is
4771             # NOT modified is T.
4772              
4773             sub _dpsec {
4774 14     14   33 my ($self, @args) = @_;
4775 14         38 my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4776 14         32 my ($xll, $omgasm, $xnodes, $em, $xinc, $xn, $t) = @args;
4777 14         19 my @orig;
4778             $self->{debug}
4779 0 0       0 and @orig = map {defined $_ ? $_ : 'undef'}
4780 14 0       33 map { SCALAR_REF eq ref $_ ? $$_ : $_} @args;
  0 50       0  
4781              
4782             #* ENTRANCE FOR DEEP SPACE SECULAR EFFECTS
4783              
4784 14         28 $$xll = $$xll + $dpsp->{ssl} * $t;
4785 14         25 $$omgasm = $$omgasm + $dpsp->{ssg} * $t;
4786 14         21 $$xnodes = $$xnodes + $dpsp->{ssh} * $t;
4787 14         25 $$em = $self->{eccentricity} + $dpsp->{sse} * $t;
4788 14 100       41 ($$xinc = $self->{inclination} + $dpsp->{ssi} * $t) < 0 and do {
4789 4         6 $$xinc = - $$xinc;
4790 4         7 $$xnodes = $$xnodes + SGP_PI;
4791 4         7 $$omgasm = $$omgasm - SGP_PI;
4792             };
4793              
4794 14 50       27 $dpsp->{iresfl} and do {
4795              
4796 0         0 my ($delt);
4797 0         0 while (1) {
4798             (!$dpsp->{atime} || $t >= 0 && $dpsp->{atime} < 0 ||
4799 0 0 0     0 $t < 0 && $dpsp->{atime} >= 0) and do {
      0        
      0        
      0        
4800              
4801             #C
4802             #C EPOCH RESTART
4803             #C
4804              
4805 0 0       0 $delt = $t >= 0 ? $dpsp->{stepp} : $dpsp->{stepn};
4806 0         0 $dpsp->{atime} = 0;
4807 0         0 $dpsp->{xni} = $dpsp->{xnq};
4808 0         0 $dpsp->{xli} = $dpsp->{xlamo};
4809 0         0 last;
4810             };
4811 0 0       0 abs ($t) >= abs ($dpsp->{atime}) and do {
4812 0 0       0 $delt = $t > 0 ? $dpsp->{stepp} : $dpsp->{stepn};
4813 0         0 last;
4814             };
4815 0 0       0 $delt = $t > 0 ? $dpsp->{stepn} : $dpsp->{stepp};
4816 0         0 $self->_dps_dot ($delt); # Calc. dot terms and integrate.
4817             }
4818              
4819 0         0 while (abs ($t - $dpsp->{atime}) >= $dpsp->{stepp}) {
4820 0         0 $self->_dps_dot ($delt); # Calc. dot terms and integrate.
4821             }
4822 0         0 my $ft = $t - $dpsp->{atime};
4823 0         0 my ($xldot, $xndot, $xnddt) = $self->_dps_dot (); # Calc. dot terms.
4824 0         0 $$xn = $dpsp->{xni} + $xndot * $ft + $xnddt * $ft * $ft * 0.5;
4825 0         0 my $xl = $dpsp->{xli} + $xldot * $ft + $xndot * $ft * $ft * 0.5;
4826 0         0 my $temp = - $$xnodes + $dpsp->{thgr} + $t * DS_THDT;
4827 0 0       0 $$xll = $dpsp->{isynfl} ? $xl - $$omgasm + $temp : $xl + $temp + $temp;
4828             };
4829              
4830 14 50       32 $self->{debug} and print <
4831             Debug _dpsec -
4832             xll : $orig[0] -> $$xll
4833             omgasm : $orig[1] -> $$omgasm
4834             xnodes : $orig[2] -> $$xnodes
4835             em : $orig[3] -> $$em
4836             xinc : $orig[4] -> $$xinc
4837             xn : $orig[5] -> $$xn
4838             t : $t
4839             eod
4840 14         33 return;
4841             }
4842              
4843             # _dps_dot
4844              
4845             # Calculate the dot terms for the secular effects.
4846              
4847             # In the original FORTRAN, this was a chunk of code followed
4848             # by an assigned GOTO. But here it has transmogrified into a
4849             # method. If an argument is passed, it is taken to be the delta
4850             # for an iteration of the integration step, which is done. It
4851             # returns xldot, xndot, and xnddt
4852              
4853             sub _dps_dot {
4854 0     0   0 my ($self, $delt) = @_;
4855 0         0 my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4856              
4857             #C
4858             #C DOT TERMS CALCULATED
4859             #C
4860              
4861             # We get here from either:
4862             # - an explicit GOTO below line 130;
4863             # - an explicit GOTO below line 160, which is reached from below 110 or 125.
4864             # This is the only reference to line 152.
4865             # XNDOT, XNDDT, and XLDOT come out of this.
4866             #150:
4867 0         0 my ($xndot, $xnddt);
4868 0 0       0 if ($dpsp->{isynfl}) {
4869             $xndot = $dpsp->{del1} * sin ($dpsp->{xli} - $dpsp->{fasx2}) +
4870             $dpsp->{del2} * sin (2 * ($dpsp->{xli} - $dpsp->{fasx4})) +
4871 0         0 $dpsp->{del3} * sin (3 * ($dpsp->{xli} - $dpsp->{fasx6}));
4872             $xnddt = $dpsp->{del1} * cos ($dpsp->{xli} - $dpsp->{fasx2}) +
4873             2 * $dpsp->{del2} * cos (2 * ($dpsp->{xli} - $dpsp->{fasx4})) +
4874 0         0 3 * $dpsp->{del3} * cos (3 * ($dpsp->{xli} - $dpsp->{fasx6}));
4875             } else {
4876             my $xomi = $self->{argumentofperigee} +
4877 0         0 $dpsp->{omgdt} * $dpsp->{atime};
4878 0         0 my $x2omi = $xomi + $xomi;
4879 0         0 my $x2li = $dpsp->{xli} + $dpsp->{xli};
4880             $xndot = $dpsp->{d2201} * sin ($x2omi + $dpsp->{xli} - DS_G22) +
4881             $dpsp->{d2211} * sin ($dpsp->{xli} - DS_G22) +
4882             $dpsp->{d3210} * sin ($xomi + $dpsp->{xli} - DS_G32) +
4883             $dpsp->{d3222} * sin ( - $xomi + $dpsp->{xli} - DS_G32) +
4884             $dpsp->{d4410} * sin ($x2omi + $x2li - DS_G44) +
4885             $dpsp->{d4422} * sin ($x2li - DS_G44) +
4886             $dpsp->{d5220} * sin ($xomi + $dpsp->{xli} - DS_G52) +
4887             $dpsp->{d5232} * sin ( - $xomi + $dpsp->{xli} - DS_G52) +
4888             $dpsp->{d5421} * sin ($xomi + $x2li - DS_G54) +
4889 0         0 $dpsp->{d5433} * sin ( - $xomi + $x2li - DS_G54);
4890             $xnddt = $dpsp->{d2201} * cos ($x2omi + $dpsp->{xli} - DS_G22) +
4891             $dpsp->{d2211} * cos ($dpsp->{xli} - DS_G22) +
4892             $dpsp->{d3210} * cos ($xomi + $dpsp->{xli} - DS_G32) +
4893             $dpsp->{d3222} * cos ( - $xomi + $dpsp->{xli} - DS_G32) +
4894             $dpsp->{d5220} * cos ($xomi + $dpsp->{xli} - DS_G52) +
4895             $dpsp->{d5232} * cos ( - $xomi + $dpsp->{xli} - DS_G52) +
4896             2 * ($dpsp->{d4410} * cos ($x2omi + $x2li - DS_G44) +
4897             $dpsp->{d4422} * cos ($x2li - DS_G44) +
4898             $dpsp->{d5421} * cos ($xomi + $x2li - DS_G54) +
4899 0         0 $dpsp->{d5433} * cos ( - $xomi + $x2li - DS_G54));
4900             }
4901 0         0 my $xldot = $dpsp->{xni} + $dpsp->{xfact};
4902 0         0 $xnddt = $xnddt * $xldot;
4903              
4904             #C
4905             #C INTEGRATOR
4906             #C
4907              
4908 0 0       0 defined $delt and do {
4909 0         0 $dpsp->{xli} = $dpsp->{xli} + $xldot * $delt + $xndot * $dpsp->{step2};
4910 0         0 $dpsp->{xni} = $dpsp->{xni} + $xndot * $delt + $xnddt * $dpsp->{step2};
4911 0         0 $dpsp->{atime} = $dpsp->{atime} + $delt;
4912             };
4913              
4914 0         0 return ($xldot, $xndot, $xnddt);
4915             }
4916              
4917             # _dpper
4918              
4919             # Calculate solar/lunar periodics.
4920              
4921             # Note that T must also be passed.
4922              
4923             # Note also that EM, XINC, OMGASM, XNODES, and XLL must be passed
4924             # by reference, since they get modified. Sigh.
4925              
4926             sub _dpper {
4927 14     14   33 my ($self, @args) = @_;
4928 14         38 my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4929 14         40 my ($em, $xinc, $omgasm, $xnodes, $xll, $t) = @args;
4930 14         27 my @orig;
4931             $self->{debug}
4932 0 0       0 and @orig = map {defined $_ ? $_ : 'undef'}
4933 14 0       33 map { SCALAR_REF eq ref $_ ? $$_ : $_} @args;
  0 50       0  
4934              
4935             #C
4936             #C ENTRANCES FOR LUNAR-SOLAR PERIODICS
4937             #C
4938             #C
4939             #ENTRY DPPER(EM,XINC,OMGASM,XNODES,XLL)
4940              
4941 14         29 my $sinis = sin ($$xinc);
4942 14         28 my $cosis = cos ($$xinc);
4943              
4944             # The following is an optimization that
4945             # skips a bunch of calculations if the
4946             # current time is within 30 (minutes) of
4947             # the previous.
4948             # This is the only reference to line 210
4949              
4950 14 100 100     68 unless (defined $dpsp->{savtsn} && abs ($dpsp->{savtsn} - $t) < 30) {
4951 12         26 $dpsp->{savtsn} = $t;
4952 12         24 my $zm = $dpsp->{zmos} + DS_ZNS * $t;
4953 12         26 my $zf = $zm + 2 * DS_ZES * sin ($zm);
4954 12         18 my $sinzf = sin ($zf);
4955 12         22 my $f2 = .5 * $sinzf * $sinzf - .25;
4956 12         23 my $f3 = - .5 * $sinzf * cos ($zf);
4957 12         21 my $ses = $dpsp->{se2} * $f2 + $dpsp->{se3} * $f3;
4958 12         23 my $sis = $dpsp->{si2} * $f2 + $dpsp->{si3} * $f3;
4959             my $sls = $dpsp->{sl2} * $f2 + $dpsp->{sl3} * $f3 +
4960 12         26 $dpsp->{sl4} * $sinzf;
4961             $dpsp->{sghs} = $dpsp->{sgh2} * $f2 + $dpsp->{sgh3} * $f3 +
4962 12         37 $dpsp->{sgh4} * $sinzf;
4963 12         25 $dpsp->{shs} = $dpsp->{sh2} * $f2 + $dpsp->{sh3} * $f3;
4964 12         20 $zm = $dpsp->{zmol} + DS_ZNL * $t;
4965 12         21 $zf = $zm + 2 * DS_ZEL * sin ($zm);
4966 12         19 $sinzf = sin ($zf);
4967 12         20 $f2 = .5 * $sinzf * $sinzf - .25;
4968 12         17 $f3 = - .5 * $sinzf * cos ($zf);
4969 12         24 my $sel = $dpsp->{ee2} * $f2 + $dpsp->{e3} * $f3;
4970 12         30 my $sil = $dpsp->{xi2} * $f2 + $dpsp->{xi3} * $f3;
4971 12         28 my $sll = $dpsp->{xl2} * $f2 + $dpsp->{xl3} * $f3 + $dpsp->{xl4} * $sinzf;
4972 12         23 $dpsp->{sghl} = $dpsp->{xgh2} * $f2 + $dpsp->{xgh3} * $f3 + $dpsp->{xgh4} * $sinzf;
4973 12         32 $dpsp->{shl} = $dpsp->{xh2} * $f2 + $dpsp->{xh3} * $f3;
4974 12         19 $dpsp->{pe} = $ses + $sel;
4975 12         27 $dpsp->{pinc} = $sis + $sil;
4976 12         25 $dpsp->{pl} = $sls + $sll;
4977             }
4978              
4979 14         26 my $pgh = $dpsp->{sghs} + $dpsp->{sghl};
4980 14         22 my $ph = $dpsp->{shs} + $dpsp->{shl};
4981 14         32 $$xinc = $$xinc + $dpsp->{pinc};
4982 14         28 $$em = $$em + $dpsp->{pe};
4983              
4984 14 50       38 if ($self->{inclination} >= .2) {
4985              
4986             #C
4987             #C APPLY PERIODICS DIRECTLY
4988             #C
4989             #218:
4990              
4991 14         23 my $ph = $ph / $dpsp->{siniq};
4992 14         27 my $pgh = $pgh - $dpsp->{cosiq} * $ph;
4993 14         19 $$omgasm = $$omgasm + $pgh;
4994 14         34 $$xnodes = $$xnodes + $ph;
4995 14         23 $$xll = $$xll + $dpsp->{pl};
4996             } else {
4997              
4998             #C
4999             #C APPLY PERIODICS WITH LYDDANE MODIFICATION
5000             #C
5001             #220:
5002 0         0 my $sinok = sin ($$xnodes);
5003 0         0 my $cosok = cos ($$xnodes);
5004 0         0 my $alfdp = $sinis * $sinok;
5005 0         0 my $betdp = $sinis * $cosok;
5006 0         0 my $dalf = $ph * $cosok + $dpsp->{pinc} * $cosis * $sinok;
5007 0         0 my $dbet = - $ph * $sinok + $dpsp->{pinc} * $cosis * $cosok;
5008 0         0 $alfdp = $alfdp + $dalf;
5009 0         0 $betdp = $betdp + $dbet;
5010 0         0 my $xls = $$xll + $$omgasm + $cosis * $$xnodes;
5011 0         0 my $dls = $dpsp->{pl} + $pgh - $dpsp->{pinc} * $$xnodes * $sinis;
5012 0         0 $xls = $xls + $dls;
5013 0         0 $$xnodes = _actan ($alfdp,$betdp);
5014 0         0 $$xll = $$xll + $dpsp->{pl};
5015 0         0 $$omgasm = $xls - $$xll - cos ($$xinc) * $$xnodes;
5016             }
5017              
5018 14 50       32 $self->{debug} and print <
5019             Debug _dpper -
5020             em : $orig[0] -> $$em
5021             xinc : $orig[1] -> $$xinc
5022             omgasm : $orig[2] -> $$omgasm
5023             xnodes : $orig[3] -> $$xnodes
5024             xll : $orig[4] -> $$xll
5025             t : $t
5026             eod
5027              
5028 14         31 return;
5029             }
5030              
5031             #######################################################################
5032              
5033             # All "Revisiting Spacetrack Report #3" code
5034              
5035             =item $tle = $tle->sgp4r($time)
5036              
5037             This method calculates the position of the body described by the TLE
5038             object at the given time, using the revised SGP4 model. The universal
5039             time of the object is set to $time, and the 'equinox_dynamical'
5040             attribute is set to the current value of the 'epoch_dynamical'
5041             attribute.
5042              
5043             The result is the original object reference. See the L
5044             heading above for how to retrieve the coordinates you just calculated.
5045              
5046             The algorithm for this model comes from "Revisiting Spacetrack Report
5047             Number 3" (see L). That report
5048             considers the algorithm to be a correction and extension of SGP4
5049             (merging it with SDP4), and simply calls the algorithm SGP4. I have
5050             appended the "r" (for 'revised' or 'revisited', take your pick) because
5051             I have preserved the original algorithm as well.
5052              
5053             B that this algorithm depends on the setting of the
5054             'gravconst_r' attribute. The default setting of that attribute in this
5055             module is 84, but the test data that comes with "Revisiting Spacetrack
5056             Report #3" uses 72.
5057              
5058             This algorithm is also (currently) the only one that returns a useful
5059             value in the model_error attribute, as follows:
5060              
5061             0 = success
5062             1 = mean eccentricity < 0 or > 1, or a < .95
5063             2 = mean motion < 0.0
5064             3 = instantaneous eccentricity < 0 or > 1
5065             4 = semi-latus rectum < 0
5066             5 = epoch elements are sub-orbital
5067             6 = satellite has decayed
5068              
5069             These errors are dualvars if your Scalar::Util supports these. That is,
5070             they are interpreted as numbers in numeric context and the
5071             corresponding string in string context. The string is generally the
5072             explanation, except for 0, which is '' in string context. If your
5073             Scalar::Util does not support dualvar, the numeric value is returned.
5074              
5075             Currently, errors 1 through 4 cause an explicit exception to be thrown
5076             after setting the model_error attribute. Exceptions will also be thrown
5077             if the TLE eccentricity is negative or greater than one, or the TLE mean
5078             motion is negative.
5079              
5080             Errors 5 and 6 look more like informational errors to me. Error 5
5081             indicates that the perigee is less than the radius of the earth. This
5082             could very well happen if the TLE represents a coasting arc of a
5083             spacecraft being launched or preparing for re-entry. Error 6 means the
5084             actual computed position was underground. Maybe this should be an
5085             exception, though I have never needed this kind of exception previously.
5086              
5087             B that this first release of the 'Revisiting Spacetrack Report #3'
5088             functionality should be considered alpha code. That is to say, I may
5089             need to change the way it behaves, especially in the matter of what is
5090             an exception and what is not.
5091              
5092             =cut
5093              
5094             # What follows (down to, but not including, the 'end sgp4unit.for'
5095             # comment) is the Fortran code from sgp4unit.for, translated into
5096             # Perl by the custom for2pl script, with conversion specification
5097             # sgp4unit.spec. No hand-edits have been applied. The preferred
5098             # way to modify this code is to enhance for2pl (which is _not_
5099             # included in the CPAN kit) or to modify sgp4unit.for (ditto),
5100             # since that way further modifications can be easily incorporated
5101             # into this module.
5102             #
5103             # Comments in the included file are those from the original
5104             # Fortran unless preceded by '>>>>trw'. The latter are comments
5105             # introduced by the conversion program to remove unwanted Fortran.
5106             #
5107             # IMPLEMENTATION NOTES:
5108             #
5109             # The original Space Track Report Number 3 code used a custom
5110             # function called FMOD2P to reduce an angle to the range 0 <=
5111             # angle < 2*PI. This is translated to Astro::Coord::ECI::Utils
5112             # function mod2pi. But the Revisiting Spacetrack Report #3 code
5113             # used the Fortran intrinsic function DMOD, which produces
5114             # negative results for a negative divisor. So instead of using
5115             # mod2pi, sgp4r() and related code use the POSIX fmod function,
5116             # which has the same behaviour.
5117             #
5118             # Similarly, the original code used a custom function ACTAN to
5119             # produce an arc in the range 0 <= arc < 2*PI from its two
5120             # arguments and the single-argument ATAN intrinsic. The
5121             # translation into Perl ended up with an _actan function at that
5122             # point. But the revised code simply uses atan2.
5123             #
5124             # The included file processed from sgp4unit.for begins here.
5125              
5126 16     16   141 use constant SGP4R_ERROR_0 => dualvar (0, ''); # guaranteed false
  16         39  
  16         1042  
5127 16         1130 use constant SGP4R_ERROR_MEAN_ECCEN =>
5128 16     16   98 'Sgp4r 1: Mean eccentricity < 0 or > 1, or a < .95';
  16         53  
5129 16     16   113 use constant SGP4R_ERROR_1 => dualvar (1, SGP4R_ERROR_MEAN_ECCEN);
  16         39  
  16         915  
5130 16         1131 use constant SGP4R_ERROR_MEAN_MOTION =>
5131 16     16   116 'Sgp4r 2: Mean motion < 0.0';
  16         50  
5132 16     16   113 use constant SGP4R_ERROR_2 => dualvar (2, SGP4R_ERROR_MEAN_MOTION);
  16         33  
  16         985  
5133 16         967 use constant SGP4R_ERROR_INST_ECCEN =>
5134 16     16   95 'Sgp4r 3: Instantaneous eccentricity < 0 or > 1';
  16         35  
5135 16     16   112 use constant SGP4R_ERROR_3 => dualvar (3, SGP4R_ERROR_INST_ECCEN);
  16         32  
  16         1049  
5136 16         985 use constant SGP4R_ERROR_LATUSRECTUM =>
5137 16     16   109 'Sgp4r 4: Semi-latus rectum < 0';
  16         75  
5138 16     16   104 use constant SGP4R_ERROR_4 => dualvar (4, SGP4R_ERROR_LATUSRECTUM);
  16         46  
  16         1096  
5139 16         1155 use constant SGP4R_ERROR_5 => dualvar (5,
5140 16     16   121 'Sgp4r 5: Epoch elements are sub-orbital');
  16         38  
5141 16         240113 use constant SGP4R_ERROR_6 => dualvar (6,
5142 16     16   123 'Sgp4r 6: Satellite has decayed');
  16         30  
5143              
5144             #* -------------------------------------------------------------------
5145             #*
5146             #* sgp4unit.for
5147             #*
5148             #* this file contains the sgp4 procedures for analytical propagation
5149             #* of a satellite. the code was originally released in the 1980 and 1986
5150             #* spacetrack papers. a detailed discussion of the theory and history
5151             #* may be found in the 2006 aiaa paper by vallado, crawford, hujsak,
5152             #* and kelso.
5153             #*
5154             #* companion code for
5155             #* fundamentals of astrodynamics and applications
5156             #* 2007
5157             #* by david vallado
5158             #*
5159             #* (w) 719-573-2600, email dvallado@agi.com
5160             #*
5161             #* current :
5162             #* 2 apr 07 david vallado
5163             #* misc fixes for constants
5164             #* changes :
5165             #* 14 aug 06 david vallado
5166             #* chg lyddane choice back to strn3, constants,
5167             #* separate debug and writes, misc doc
5168             #* 26 jul 05 david vallado
5169             #* fixes for paper
5170             #* note that each fix is preceded by a
5171             #* comment with "sgp4fix" and an explanation of
5172             #* what was changed
5173             #* 10 aug 04 david vallado
5174             #* 2nd printing baseline working
5175             #* 14 may 01 david vallado
5176             #* 2nd edition baseline
5177             #* 80 norad
5178             #* original baseline
5179             #*
5180             #* *****************************************************************
5181             #* Files :
5182             #* Unit 14 - sgp4test.dbg debug output file
5183              
5184             #* -----------------------------------------------------------------------------
5185             #*
5186             #* SUBROUTINE DPPER
5187             #*
5188             #* This Subroutine provides deep space long period periodic contributions
5189             #* to the mean elements. by design, these periodics are zero at epoch.
5190             #* this used to be dscom which included initialization, but it's really a
5191             #* recurring function.
5192             #*
5193             #* author : david vallado 719-573-2600 28 jun 2005
5194             #*
5195             #* inputs :
5196             #* e3 -
5197             #* ee2 -
5198             #* peo -
5199             #* pgho -
5200             #* pho -
5201             #* pinco -
5202             #* plo -
5203             #* se2 , se3 , Sgh2, Sgh3, Sgh4, Sh2, Sh3, Si2, Si3, Sl2, Sl3, Sl4 -
5204             #* t -
5205             #* xh2, xh3, xi2, xi3, xl2, xl3, xl4 -
5206             #* zmol -
5207             #* zmos -
5208             #* ep - eccentricity 0.0 - 1.0
5209             #* inclo - inclination - needed for lyddane modification
5210             #* nodep - right ascension of ascending node
5211             #* argpp - argument of perigee
5212             #* mp - mean anomaly
5213             #*
5214             #* outputs :
5215             #* ep - eccentricity 0.0 - 1.0
5216             #* inclp - inclination
5217             #* nodep - right ascension of ascending node
5218             #* argpp - argument of perigee
5219             #* mp - mean anomaly
5220             #*
5221             #* locals :
5222             #* alfdp -
5223             #* betdp -
5224             #* cosip , sinip , cosop , sinop ,
5225             #* dalf -
5226             #* dbet -
5227             #* dls -
5228             #* f2, f3 -
5229             #* pe -
5230             #* pgh -
5231             #* ph -
5232             #* pinc -
5233             #* pl -
5234             #* sel , ses , sghl , sghs , shl , shs , sil , sinzf , sis ,
5235             #* sll , sls
5236             #* xls -
5237             #* xnoh -
5238             #* zf -
5239             #* zm -
5240             #*
5241             #* coupling :
5242             #* none.
5243             #*
5244             #* references :
5245             #* hoots, roehrich, norad spacetrack report #3 1980
5246             #* hoots, norad spacetrack report #6 1986
5247             #* hoots, schumacher and glover 2004
5248             #* vallado, crawford, hujsak, kelso 2006
5249             #*------------------------------------------------------------------------------
5250              
5251             sub _r_dpper {
5252 418     418   924 my ($self, $t, $eccp, $inclp, $nodep, $argpp, $mp) = @_;
5253             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
5254 418 50       1263 or confess "Programming error - Sgp4r not initialized";
5255              
5256             #* -------------------------- Local Variables --------------------------
5257 418         1128 my ($alfdp, $betdp, $cosip, $cosop, $dalf, $dbet, $dls, $f2, $f3,
5258             $pe, $pgh, $ph, $pinc, $pl, $sel, $ses, $sghl, $sghs, $shl,
5259             $shs, $sil, $sinip, $sinop, $sinzf, $sis, $sll, $sls, $xls,
5260             $xnoh, $zf, $zm);
5261 418         0 my ($zel, $zes, $znl, $zns);
5262             #>>>>trw INCLUDE 'ASTMATH.CMN'
5263              
5264             #* ----------------------------- Constants -----------------------------
5265 418         566 $zes= 0.01675;
5266 418         543 $zel= 0.0549;
5267 418         553 $zns= 1.19459e-05;
5268              
5269 418         561 $znl= 0.00015835218;
5270             #* ------------------- CALCULATE TIME VARYING PERIODICS ----------------
5271              
5272 418         855 $zm= $parm->{zmos}+ $zns*$t;
5273 418 100       958 if ($parm->{init}) {
5274             $zm= $parm->{zmos}
5275 23         69 }
5276 418         823 $zf= $zm+ 2*$zes*sin($zm);
5277 418         784 $sinzf= sin($zf);
5278 418         593 $f2= 0.5*$sinzf*$sinzf- 0.25;
5279 418         678 $f3= -0.5*$sinzf*cos($zf);
5280 418         674 $ses= $parm->{se2}*$f2+ $parm->{se3}*$f3;
5281 418         774 $sis= $parm->{si2}*$f2+ $parm->{si3}*$f3;
5282 418         910 $sls= $parm->{sl2}*$f2+ $parm->{sl3}*$f3+ $parm->{sl4}*$sinzf;
5283 418         826 $sghs= $parm->{sgh2}*$f2+ $parm->{sgh3}*$f3+ $parm->{sgh4}*$sinzf;
5284 418         618 $shs= $parm->{sh2}*$f2+ $parm->{sh3}*$f3;
5285              
5286 418         637 $zm= $parm->{zmol}+ $znl*$t;
5287 418 100       825 if ($parm->{init}) {
5288             $zm= $parm->{zmol}
5289 23         38 }
5290 418         680 $zf= $zm+ 2*$zel*sin($zm);
5291 418         594 $sinzf= sin($zf);
5292 418         585 $f2= 0.5*$sinzf*$sinzf- 0.25;
5293 418         659 $f3= -0.5*$sinzf*cos($zf);
5294 418         703 $sel= $parm->{ee2}*$f2+ $parm->{e3}*$f3;
5295 418         659 $sil= $parm->{xi2}*$f2+ $parm->{xi3}*$f3;
5296 418         677 $sll= $parm->{xl2}*$f2+ $parm->{xl3}*$f3+ $parm->{xl4}*$sinzf;
5297 418         731 $sghl= $parm->{xgh2}*$f2+ $parm->{xgh3}*$f3+ $parm->{xgh4}*$sinzf;
5298 418         581 $shl= $parm->{xh2}*$f2+ $parm->{xh3}*$f3;
5299 418         677 $pe= $ses+ $sel;
5300 418         514 $pinc= $sis+ $sil;
5301 418         622 $pl= $sls+ $sll;
5302 418         711 $pgh= $sghs+ $sghl;
5303              
5304 418         546 $ph= $shs+ $shl;
5305 418 100       835 if ( ! $parm->{init}) {
5306 395         629 $pe= $pe- $parm->{peo};
5307 395         539 $pinc= $pinc- $parm->{pinco};
5308 395         544 $pl= $pl- $parm->{plo};
5309 395         582 $pgh= $pgh- $parm->{pgho};
5310 395         557 $ph= $ph- $parm->{pho};
5311 395         658 $$inclp= $$inclp+ $pinc;
5312 395         550 $$eccp= $$eccp+ $pe;
5313 395         556 $sinip= sin($$inclp);
5314              
5315 395         573 $cosip= cos($$inclp);
5316             #* ------------------------- APPLY PERIODICS DIRECTLY ------------------
5317             #c sgp4fix for lyddane choice
5318             #c strn3 used original inclination - this is technically feasible
5319             #c gsfc used perturbed inclination - also technically feasible
5320             #c probably best to readjust the 0.2 limit value and limit discontinuity
5321             #c 0.2 rad = 11.45916 deg
5322             #c use next line for original strn3 approach and original inclination
5323             #c IF (inclo.ge.0.2D0) THEN
5324             #c use next line for gsfc version and perturbed inclination
5325              
5326 395 100       798 if ($$inclp >= 0.2) {
5327 232         359 $ph= $ph/$sinip;
5328 232         368 $pgh= $pgh- $cosip*$ph;
5329 232         401 $$argpp= $$argpp+ $pgh;
5330 232         346 $$nodep= $$nodep+ $ph;
5331 232         375 $$mp= $$mp+ $pl;
5332              
5333             } else {
5334             #* ----------------- APPLY PERIODICS WITH LYDDANE MODIFICATION ---------
5335 163         251 $sinop= sin($$nodep);
5336 163         253 $cosop= cos($$nodep);
5337 163         224 $alfdp= $sinip*$sinop;
5338 163         235 $betdp= $sinip*$cosop;
5339 163         258 $dalf= $ph*$cosop+ $pinc*$cosip*$sinop;
5340 163         305 $dbet= -$ph*$sinop+ $pinc*$cosip*$cosop;
5341 163         222 $alfdp= $alfdp+ $dalf;
5342 163         234 $betdp= $betdp+ $dbet;
5343 163         410 $$nodep= fmod($$nodep, &SGP_TWOPI);
5344 163         314 $xls= $$mp+ $$argpp+ $cosip*$$nodep;
5345 163         240 $dls= $pl+ $pgh- $pinc*$$nodep*$sinip;
5346 163         245 $xls= $xls+ $dls;
5347 163         210 $xnoh= $$nodep;
5348 163         367 $$nodep= atan2($alfdp, $betdp);
5349 163 100       451 if (abs($xnoh-$$nodep) > &SGP_PI) {
5350 57 50       169 if ($$nodep < $xnoh) {
5351 57         117 $$nodep= $$nodep+&SGP_TWOPI;
5352             } else {
5353 0         0 $$nodep= $$nodep-&SGP_TWOPI;
5354             }
5355             }
5356 163         257 $$mp= $$mp+ $pl;
5357 163         314 $$argpp= $xls- $$mp- $cosip*$$nodep;
5358             }
5359              
5360             }
5361             #c INCLUDE 'debug1.for'
5362              
5363 418         821 return;
5364             }
5365              
5366             #* -----------------------------------------------------------------------------
5367             #*
5368             #* SUBROUTINE DSCOM
5369             #*
5370             #* This Subroutine provides deep space common items used by both the secular
5371             #* and periodics subroutines. input is provided as shown. this routine
5372             #* used to be called dpper, but the functions inside weren't well organized.
5373             #*
5374             #* author : david vallado 719-573-2600 28 jun 2005
5375             #*
5376             #* inputs :
5377             #* epoch -
5378             #* ep - eccentricity
5379             #* argpp - argument of perigee
5380             #* tc -
5381             #* inclp - inclination
5382             #* nodep - right ascension of ascending node
5383             #* np - mean motion
5384             #*
5385             #* outputs :
5386             #* sinim , cosim , sinomm , cosomm , snodm , cnodm
5387             #* day -
5388             #* e3 -
5389             #* ee2 -
5390             #* em - eccentricity
5391             #* emsq - eccentricity squared
5392             #* gam -
5393             #* peo -
5394             #* pgho -
5395             #* pho -
5396             #* pinco -
5397             #* plo -
5398             #* rtemsq -
5399             #* se2, se3 -
5400             #* sgh2, sgh3, sgh4 -
5401             #* sh2, sh3, si2, si3, sl2, sl3, sl4 -
5402             #* s1, s2, s3, s4, s5, s6, s7 -
5403             #* ss1, ss2, ss3, ss4, ss5, ss6, ss7, sz1, sz2, sz3 -
5404             #* sz11, sz12, sz13, sz21, sz22, sz23, sz31, sz32, sz33 -
5405             #* xgh2, xgh3, xgh4, xh2, xh3, xi2, xi3, xl2, xl3, xl4 -
5406             #* nm - mean motion
5407             #* z1, z2, z3, z11, z12, z13, z21, z22, z23, z31, z32, z33 -
5408             #* zmol -
5409             #* zmos -
5410             #*
5411             #* locals :
5412             #* a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 -
5413             #* betasq -
5414             #* cc -
5415             #* ctem, stem -
5416             #* x1, x2, x3, x4, x5, x6, x7, x8 -
5417             #* xnodce -
5418             #* xnoi -
5419             #* zcosg , zsing , zcosgl , zsingl , zcosh , zsinh , zcoshl , zsinhl ,
5420             #* zcosi , zsini , zcosil , zsinil ,
5421             #* zx -
5422             #* zy -
5423             #*
5424             #* coupling :
5425             #* none.
5426             #*
5427             #* references :
5428             #* hoots, roehrich, norad spacetrack report #3 1980
5429             #* hoots, norad spacetrack report #6 1986
5430             #* hoots, schumacher and glover 2004
5431             #* vallado, crawford, hujsak, kelso 2006
5432             #*------------------------------------------------------------------------------
5433              
5434             sub _r_dscom {
5435 23     23   62 my ($self, $tc) = @_;
5436             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
5437 23 50       112 or confess "Programming error - Sgp4r not initialized";
5438             my $init = $parm->{init}
5439 23 50       59 or confess "Programming error - Sgp4r initialization not in progress";
5440              
5441             #* -------------------------- Local Variables --------------------------
5442 23         101 my ($c1ss, $c1l, $zcosis, $zsinis, $zsings, $zcosgs, $zes, $zel);
5443              
5444 23         0 my ($a1, $a2, $a3, $a4, $a5, $a6, $a7, $a8, $a9, $a10, $betasq, $cc,
5445             $ctem, $stem, $x1, $x2, $x3, $x4, $x5, $x6, $x7, $x8, $xnodce,
5446             $xnoi, $zcosg, $zcosgl, $zcosh, $zcoshl, $zcosi, $zcosil,
5447             $zsing, $zsingl, $zsinh, $zsinhl, $zsini, $zsinil, $zx, $zy);
5448             #>>>>trw INCLUDE 'ASTMATH.CMN'
5449              
5450             #* ------------------------------ Constants ----------------------------
5451 23         35 $zes= 0.01675;
5452 23         45 $zel= 0.0549;
5453 23         37 $c1ss= 2.9864797e-06;
5454 23         35 $c1l= 4.7968065e-07;
5455 23         49 $zsinis= 0.39785416;
5456 23         40 $zcosis= 0.91744867;
5457 23         46 $zcosgs= 0.1945905;
5458              
5459 23         34 $zsings= -0.98088458;
5460             #* ----------------- DEEP SPACE PERIODICS INITIALIZATION ---------------
5461 23         45 $init->{xn}= $parm->{meanmotion};
5462 23         65 $init->{eccm}= $parm->{eccentricity};
5463 23         102 $init->{snodm}= sin($parm->{ascendingnode});
5464 23         63 $init->{cnodm}= cos($parm->{ascendingnode});
5465 23         69 $init->{sinomm}= sin($parm->{argumentofperigee});
5466 23         64 $init->{cosomm}= cos($parm->{argumentofperigee});
5467 23         57 $init->{sinim}= sin($parm->{inclination});
5468 23         64 $init->{cosim}= cos($parm->{inclination});
5469 23         53 $init->{emsq}= $init->{eccm}*$init->{eccm};
5470 23         45 $betasq= 1-$init->{emsq};
5471              
5472 23         53 $init->{rtemsq}= sqrt($betasq);
5473             #* --------------------- INITIALIZE LUNAR SOLAR TERMS ------------------
5474 23         49 $parm->{peo}= 0;
5475 23         47 $parm->{pinco}= 0;
5476 23         50 $parm->{plo}= 0;
5477 23         56 $parm->{pgho}= 0;
5478 23         44 $parm->{pho}= 0;
5479 23         79 $init->{day}= $self->{ds50}+ 18261.5 + $tc/1440;
5480 23         115 $xnodce= fmod(4.523602 - 0.00092422029*$init->{day}, &SGP_TWOPI);
5481 23         55 $stem= sin($xnodce);
5482 23         39 $ctem= cos($xnodce);
5483 23         55 $zcosil= 0.91375164 - 0.03568096*$ctem;
5484 23         51 $zsinil= sqrt(1 - $zcosil*$zcosil);
5485 23         38 $zsinhl= 0.089683511*$stem/ $zsinil;
5486 23         41 $zcoshl= sqrt(1 - $zsinhl*$zsinhl);
5487 23         47 $init->{gam}= 5.8351514 + 0.001944368*$init->{day};
5488 23         38 $zx= 0.39785416*$stem/$zsinil;
5489 23         35 $zy= $zcoshl*$ctem+ 0.91744867*$zsinhl*$stem;
5490 23         75 $zx= atan2($zx, $zy);
5491 23         48 $zx= $init->{gam}+ $zx- $xnodce;
5492 23         37 $zcosgl= cos($zx);
5493              
5494 23         55 $zsingl= sin($zx);
5495             #* ---------------------------- DO SOLAR TERMS -------------------------
5496 23         41 $zcosg= $zcosgs;
5497 23         48 $zsing= $zsings;
5498 23         39 $zcosi= $zcosis;
5499 23         53 $zsini= $zsinis;
5500 23         41 $zcosh= $init->{cnodm};
5501 23         45 $zsinh= $init->{snodm};
5502 23         34 $cc= $c1ss;
5503              
5504 23         46 $xnoi= 1 / $init->{xn};
5505 23         60 foreach my $lsflg (1 .. 2) {
5506 46         83 $a1= $zcosg*$zcosh+ $zsing*$zcosi*$zsinh;
5507 46         80 $a3= -$zsing*$zcosh+ $zcosg*$zcosi*$zsinh;
5508 46         82 $a7= -$zcosg*$zsinh+ $zsing*$zcosi*$zcosh;
5509 46         66 $a8= $zsing*$zsini;
5510 46         75 $a9= $zsing*$zsinh+ $zcosg*$zcosi*$zcosh;
5511 46         69 $a10= $zcosg*$zsini;
5512 46         126 $a2= $init->{cosim}*$a7+ $init->{sinim}*$a8;
5513 46         90 $a4= $init->{cosim}*$a9+ $init->{sinim}*$a10;
5514 46         94 $a5= -$init->{sinim}*$a7+ $init->{cosim}*$a8;
5515              
5516 46         87 $a6= -$init->{sinim}*$a9+ $init->{cosim}*$a10;
5517 46         86 $x1= $a1*$init->{cosomm}+ $a2*$init->{sinomm};
5518 46         68 $x2= $a3*$init->{cosomm}+ $a4*$init->{sinomm};
5519 46         83 $x3= -$a1*$init->{sinomm}+ $a2*$init->{cosomm};
5520 46         70 $x4= -$a3*$init->{sinomm}+ $a4*$init->{cosomm};
5521 46         79 $x5= $a5*$init->{sinomm};
5522 46         65 $x6= $a6*$init->{sinomm};
5523 46         60 $x7= $a5*$init->{cosomm};
5524              
5525 46         67 $x8= $a6*$init->{cosomm};
5526 46         114 $init->{z31}= 12*$x1*$x1- 3*$x3*$x3;
5527 46         82 $init->{z32}= 24*$x1*$x2- 6*$x3*$x4;
5528 46         112 $init->{z33}= 12*$x2*$x2- 3*$x4*$x4;
5529             $init->{z1}= 3* ($a1*$a1+ $a2*$a2) +
5530 46         114 $init->{z31}*$init->{emsq};
5531             $init->{z2}= 6* ($a1*$a3+ $a2*$a4) +
5532 46         113 $init->{z32}*$init->{emsq};
5533             $init->{z3}= 3* ($a3*$a3+ $a4*$a4) +
5534 46         118 $init->{z33}*$init->{emsq};
5535             $init->{z11}= -6*$a1*$a5+ $init->{emsq}*
5536 46         163 (-24*$x1*$x7-6*$x3*$x5);
5537             $init->{z12}= -6* ($a1*$a6+ $a3*$a5) + $init->{emsq}* (
5538 46         183 -24*($x2*$x7+$x1*$x8) - 6*($x3*$x6+$x4*$x5) );
5539 46         136 $init->{z13}= -6*$a3*$a6+ $init->{emsq}*(-24*$x2*$x8-
5540             6*$x4*$x6);
5541 46         120 $init->{z21}= 6*$a2*$a5+ $init->{emsq}*(24*$x1*$x5-6*$x3*$x7);
5542             $init->{z22}= 6* ($a4*$a5+ $a2*$a6) + $init->{emsq}* (
5543 46         120 24*($x2*$x5+$x1*$x6) - 6*($x4*$x7+$x3*$x8) );
5544 46         123 $init->{z23}= 6*$a4*$a6+ $init->{emsq}*(24*$x2*$x6- 6*$x4*$x8);
5545 46         88 $init->{z1}= $init->{z1}+ $init->{z1}+ $betasq*$init->{z31};
5546 46         106 $init->{z2}= $init->{z2}+ $init->{z2}+ $betasq*$init->{z32};
5547 46         86 $init->{z3}= $init->{z3}+ $init->{z3}+ $betasq*$init->{z33};
5548 46         78 $init->{s3}= $cc*$xnoi;
5549 46         126 $init->{s2}= -0.5*$init->{s3}/ $init->{rtemsq};
5550 46         88 $init->{s4}= $init->{s3}*$init->{rtemsq};
5551 46         94 $init->{s1}= -15*$init->{eccm}*$init->{s4};
5552 46         89 $init->{s5}= $x1*$x3+ $x2*$x4;
5553 46         103 $init->{s6}= $x2*$x3+ $x1*$x4;
5554              
5555 46         105 $init->{s7}= $x2*$x4- $x1*$x3;
5556             #* ------------------------------ DO LUNAR TERMS -----------------------
5557 46 100       132 if ($lsflg == 1) {
5558 23         46 $init->{ss1}= $init->{s1};
5559 23         48 $init->{ss2}= $init->{s2};
5560 23         59 $init->{ss3}= $init->{s3};
5561 23         64 $init->{ss4}= $init->{s4};
5562 23         53 $init->{ss5}= $init->{s5};
5563 23         72 $init->{ss6}= $init->{s6};
5564 23         43 $init->{ss7}= $init->{s7};
5565 23         72 $init->{sz1}= $init->{z1};
5566 23         41 $init->{sz2}= $init->{z2};
5567 23         43 $init->{sz3}= $init->{z3};
5568 23         55 $init->{sz11}= $init->{z11};
5569 23         60 $init->{sz12}= $init->{z12};
5570 23         58 $init->{sz13}= $init->{z13};
5571 23         50 $init->{sz21}= $init->{z21};
5572 23         50 $init->{sz22}= $init->{z22};
5573 23         47 $init->{sz23}= $init->{z23};
5574 23         42 $init->{sz31}= $init->{z31};
5575 23         63 $init->{sz32}= $init->{z32};
5576 23         111 $init->{sz33}= $init->{z33};
5577 23         41 $zcosg= $zcosgl;
5578 23         38 $zsing= $zsingl;
5579 23         38 $zcosi= $zcosil;
5580 23         37 $zsini= $zsinil;
5581 23         57 $zcosh= $zcoshl*$init->{cnodm}+$zsinhl*$init->{snodm};
5582 23         42 $zsinh= $init->{snodm}*$zcoshl-$init->{cnodm}*$zsinhl;
5583 23         55 $cc= $c1l;
5584             }
5585              
5586             }
5587             $parm->{zmol}= fmod(4.7199672 + 0.2299715*$init->{day}-$init->{gam},
5588 23         165 &SGP_TWOPI);
5589              
5590             $parm->{zmos}= fmod(6.2565837 + 0.017201977*$init->{day},
5591 23         109 &SGP_TWOPI);
5592             #* ---------------------------- DO SOLAR TERMS -------------------------
5593 23         87 $parm->{se2}= 2*$init->{ss1}*$init->{ss6};
5594 23         65 $parm->{se3}= 2*$init->{ss1}*$init->{ss7};
5595 23         67 $parm->{si2}= 2*$init->{ss2}*$init->{sz12};
5596 23         71 $parm->{si3}= 2*$init->{ss2}*($init->{sz13}-$init->{sz11});
5597 23         76 $parm->{sl2}= -2*$init->{ss3}*$init->{sz2};
5598 23         46 $parm->{sl3}= -2*$init->{ss3}*($init->{sz3}-$init->{sz1});
5599 23         66 $parm->{sl4}= -2*$init->{ss3}*(-21-9*$init->{emsq})*$zes;
5600 23         55 $parm->{sgh2}= 2*$init->{ss4}*$init->{sz32};
5601 23         55 $parm->{sgh3}= 2*$init->{ss4}*($init->{sz33}-$init->{sz31});
5602 23         58 $parm->{sgh4}= -18*$init->{ss4}*$zes;
5603 23         63 $parm->{sh2}= -2*$init->{ss2}*$init->{sz22};
5604              
5605 23         60 $parm->{sh3}= -2*$init->{ss2}*($init->{sz23}-$init->{sz21});
5606             #* ---------------------------- DO LUNAR TERMS -------------------------
5607 23         58 $parm->{ee2}= 2*$init->{s1}*$init->{s6};
5608 23         66 $parm->{e3}= 2*$init->{s1}*$init->{s7};
5609 23         67 $parm->{xi2}= 2*$init->{s2}*$init->{z12};
5610 23         60 $parm->{xi3}= 2*$init->{s2}*($init->{z13}-$init->{z11});
5611 23         49 $parm->{xl2}= -2*$init->{s3}*$init->{z2};
5612 23         57 $parm->{xl3}= -2*$init->{s3}*($init->{z3}-$init->{z1});
5613 23         57 $parm->{xl4}= -2*$init->{s3}*(-21-9*$init->{emsq})*$zel;
5614 23         50 $parm->{xgh2}= 2*$init->{s4}*$init->{z32};
5615 23         123 $parm->{xgh3}= 2*$init->{s4}*($init->{z33}-$init->{z31});
5616 23         52 $parm->{xgh4}= -18*$init->{s4}*$zel;
5617 23         90 $parm->{xh2}= -2*$init->{s2}*$init->{z22};
5618              
5619 23         60 $parm->{xh3}= -2*$init->{s2}*($init->{z23}-$init->{z21});
5620             #c INCLUDE 'debug2.for'
5621              
5622 23         56 return;
5623             }
5624              
5625             #* -----------------------------------------------------------------------------
5626             #*
5627             #* SUBROUTINE DSINIT
5628             #*
5629             #* This Subroutine provides Deep Space contributions to Mean Motion Dot due
5630             #* to geopotential resonance with half day and one day orbits.
5631             #*
5632             #* Inputs :
5633             #* Cosim, Sinim-
5634             #* Emsq - Eccentricity squared
5635             #* Argpo - Argument of Perigee
5636             #* S1, S2, S3, S4, S5 -
5637             #* Ss1, Ss2, Ss3, Ss4, Ss5 -
5638             #* Sz1, Sz3, Sz11, Sz13, Sz21, Sz23, Sz31, Sz33 -
5639             #* T - Time
5640             #* Tc -
5641             #* GSTo - Greenwich sidereal time rad
5642             #* Mo - Mean Anomaly
5643             #* MDot - Mean Anomaly dot (rate)
5644             #* No - Mean Motion
5645             #* nodeo - right ascension of ascending node
5646             #* nodeDot - right ascension of ascending node dot (rate)
5647             #* XPIDOT -
5648             #* Z1, Z3, Z11, Z13, Z21, Z23, Z31, Z33 -
5649             #* Eccm - Eccentricity
5650             #* Argpm - Argument of perigee
5651             #* Inclm - Inclination
5652             #* Mm - Mean Anomaly
5653             #* Xn - Mean Motion
5654             #* nodem - right ascension of ascending node
5655             #*
5656             #* Outputs :
5657             #* Eccm - Eccentricity
5658             #* Argpm - Argument of perigee
5659             #* Inclm - Inclination
5660             #* Mm - Mean Anomaly
5661             #* Xn - Mean motion
5662             #* nodem - right ascension of ascending node
5663             #* IRez - Resonance flags 0-none, 1-One day, 2-Half day
5664             #* Atime -
5665             #* D2201, D2211, D3210, D3222, D4410, D4422, D5220, D5232, D5421, D5433 -
5666             #* Dedt -
5667             #* Didt -
5668             #* DMDT -
5669             #* DNDT -
5670             #* DNODT -
5671             #* DOMDT -
5672             #* Del1, Del2, Del3 -
5673             #* Ses , Sghl , Sghs , Sgs , Shl , Shs , Sis , Sls
5674             #* THETA -
5675             #* Xfact -
5676             #* Xlamo -
5677             #* Xli -
5678             #* Xni
5679             #*
5680             #* Locals :
5681             #* ainv2 -
5682             #* aonv -
5683             #* cosisq -
5684             #* eoc -
5685             #* f220, f221, f311, f321, f322, f330, f441, f442, f522, f523, f542, f543 -
5686             #* g200, g201, g211, g300, g310, g322, g410, g422, g520, g521, g532, g533 -
5687             #* sini2 -
5688             #* temp, temp1 -
5689             #* Theta -
5690             #* xno2 -
5691             #*
5692             #* Coupling :
5693             #* getgravconst-
5694             #*
5695             #* references :
5696             #* hoots, roehrich, norad spacetrack report #3 1980
5697             #* hoots, norad spacetrack report #6 1986
5698             #* hoots, schumacher and glover 2004
5699             #* vallado, crawford, hujsak, kelso 2006
5700             #*------------------------------------------------------------------------------
5701              
5702             sub _r_dsinit {
5703 23     23   71 my ($self, $t, $tc) = @_;
5704             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
5705 23 50       96 or confess "Programming error - Sgp4r not initialized";
5706             my $init = $parm->{init}
5707 23 50       191 or confess "Programming error - Sgp4r initialization not in progress";
5708              
5709             #* -------------------------- Local Variables --------------------------
5710 23         130 my ($ainv2, $aonv, $cosisq, $eoc, $f220, $f221, $f311, $f321, $f322,
5711             $f330, $f441, $f442, $f522, $f523, $f542, $f543, $g200, $g201,
5712             $g211, $g300, $g310, $g322, $g410, $g422, $g520, $g521, $g532,
5713             $g533, $ses, $sgs, $sghl, $sghs, $shs, $shl, $sis, $sini2, $sls,
5714             $temp, $temp1, $theta, $xno2);
5715              
5716 23         0 my ($q22, $q31, $q33, $root22, $root44, $root54, $rptim, $root32,
5717             $root52, $znl, $zns, $emo, $emsqo);
5718             #>>>>trw INCLUDE 'ASTMATH.CMN'
5719              
5720 23         34 $q22= 1.7891679e-06;
5721 23         42 $q31= 2.1460748e-06;
5722 23         39 $q33= 2.2123015e-07;
5723 23         45 $root22= 1.7891679e-06;
5724 23         31 $root44= 7.3636953e-09;
5725 23         46 $root54= 2.1765803e-09;
5726 23         36 $rptim= 0.0043752690880113;
5727 23         33 $root32= 3.7393792e-07;
5728 23         47 $root52= 1.1428639e-07;
5729             #>>>>trw X2o3 = 2.0D0 / 3.0D0
5730 23         31 $znl= 0.00015835218;
5731              
5732 23         31 $zns= 1.19459e-05;
5733              
5734             #>>>>trw CALL getgravconst( whichconst, tumin, mu, radiusearthkm, xke, j2, j3, j4, j3oj2 )
5735             #* ------------------------ DEEP SPACE INITIALIZATION ------------------
5736 23         39 $parm->{irez}= 0;
5737 23 100 100     106 if (($init->{xn} < 0.0052359877) && ($init->{xn} > 0.0034906585)) {
5738 6         31 $parm->{irez}= 1;
5739             }
5740 23 100 100     155 if (($init->{xn} >= 0.00826) && ($init->{xn} <= 0.00924) &&
      100        
5741             ($init->{eccm} >= 0.5)) {
5742 5         11 $parm->{irez}= 2;
5743              
5744             }
5745             #* ---------------------------- DO SOLAR TERMS -------------------------
5746 23         48 $ses= $init->{ss1}*$zns*$init->{ss5};
5747 23         79 $sis= $init->{ss2}*$zns*($init->{sz11}+ $init->{sz13});
5748             $sls= -$zns*$init->{ss3}*($init->{sz1}+ $init->{sz3}- 14 -
5749 23         77 6*$init->{emsq});
5750 23         56 $sghs= $init->{ss4}*$zns*($init->{sz31}+ $init->{sz33}- 6);
5751 23         56 $shs= -$zns*$init->{ss2}*($init->{sz21}+ $init->{sz23});
5752             #c sgp4fix for 180 deg incl
5753 23 100 66     139 if (($init->{inclm} < 0.052359877) || ($init->{inclm} >
5754             &SGP_PI-0.052359877)) {
5755 3         6 $shs= 0;
5756             }
5757 23 50       73 if ($init->{sinim} != 0) {
5758 23         47 $shs= $shs/$init->{sinim};
5759             }
5760              
5761 23         41 $sgs= $sghs- $init->{cosim}*$shs;
5762             #* ----------------------------- DO LUNAR TERMS ------------------------
5763 23         66 $parm->{dedt}= $ses+ $init->{s1}*$znl*$init->{s5};
5764 23         73 $parm->{didt}= $sis+ $init->{s2}*$znl*($init->{z11}+ $init->{z13});
5765             $parm->{dmdt}= $sls- $znl*$init->{s3}*($init->{z1}+ $init->{z3}- 14
5766 23         100 - 6*$init->{emsq});
5767 23         52 $sghl= $init->{s4}*$znl*($init->{z31}+ $init->{z33}- 6);
5768 23         50 $shl= -$znl*$init->{s2}*($init->{z21}+ $init->{z23});
5769             #c sgp4fix for 180 deg incl
5770 23 100 66     111 if (($init->{inclm} < 0.052359877) || ($init->{inclm} >
5771             &SGP_PI-0.052359877)) {
5772 3         5 $shl= 0;
5773             }
5774 23         76 $parm->{domdt}= $sgs+$sghl;
5775 23         49 $parm->{dnodt}= $shs;
5776 23 50       99 if ($init->{sinim} != 0) {
5777             $parm->{domdt}=
5778 23         75 $parm->{domdt}-$init->{cosim}/$init->{sinim}*$shl;
5779 23         66 $parm->{dnodt}= $parm->{dnodt}+$shl/$init->{sinim};
5780              
5781             }
5782             #* --------------- CALCULATE DEEP SPACE RESONANCE EFFECTS --------------
5783 23         46 $init->{dndt}= 0;
5784 23         102 $theta= fmod($parm->{gsto}+ $tc*$rptim, &SGP_TWOPI);
5785 23         69 $init->{eccm}= $init->{eccm}+ $parm->{dedt}*$t;
5786 23         60 $init->{emsq}= $init->{eccm}**2;
5787 23         57 $init->{inclm}= $init->{inclm}+ $parm->{didt}*$t;
5788 23         57 $init->{argpm}= $init->{argpm}+ $parm->{domdt}*$t;
5789 23         53 $init->{nodem}= $init->{nodem}+ $parm->{dnodt}*$t;
5790 23         62 $init->{mm}= $init->{mm}+ $parm->{dmdt}*$t;
5791             #c sgp4fix for negative inclinations
5792             #c the following if statement should be commented out
5793             #c IF(Inclm .lt. 0.0D0) THEN
5794             #c Inclm = -Inclm
5795             #c Argpm = Argpm-PI
5796             #c nodem = nodem+PI
5797             #c ENDIF
5798              
5799             #* ------------------ Initialize the resonance terms -------------------
5800 23 100       73 if ($parm->{irez} != 0) {
5801              
5802 11         60 $aonv= ($init->{xn}/$parm->{xke})**&SGP_TOTHRD;
5803             #* -------------- GEOPOTENTIAL RESONANCE FOR 12 HOUR ORBITS ------------
5804 11 100       55 if ($parm->{irez} == 2) {
5805 5         14 $cosisq= $init->{cosim}*$init->{cosim};
5806 5         9 $emo= $init->{eccm};
5807 5         10 $emsqo= $init->{emsq};
5808 5         19 $init->{eccm}= $parm->{eccentricity};
5809 5         12 $init->{emsq}= $init->{eccsq};
5810 5         20 $eoc= $init->{eccm}*$init->{emsq};
5811 5         14 $g201= -0.306-($init->{eccm}-0.64)*0.44;
5812 5 100       15 if ($init->{eccm} <= 0.65) {
5813             $g211= 3.616 - 13.247*$init->{eccm}+
5814 1         4 16.29*$init->{emsq};
5815             $g310= -19.302 + 117.39*$init->{eccm}-
5816 1         5 228.419*$init->{emsq}+ 156.591*$eoc;
5817             $g322= -18.9068+ 109.7927*$init->{eccm}-
5818 1         3 214.6334*$init->{emsq}+ 146.5816*$eoc;
5819             $g410= -41.122 + 242.694*$init->{eccm}-
5820 1         4 471.094*$init->{emsq}+ 313.953*$eoc;
5821             $g422=-146.407 + 841.88*$init->{eccm}-
5822 1         3 1629.014*$init->{emsq}+ 1083.435*$eoc;
5823             $g520=-532.114 + 3017.977*$init->{eccm}-
5824 1         4 5740.032*$init->{emsq}+ 3708.276*$eoc;
5825             } else {
5826             $g211= -72.099 + 331.819*$init->{eccm}-
5827 4         14 508.738*$init->{emsq}+ 266.724*$eoc;
5828             $g310= -346.844 + 1582.851*$init->{eccm}-
5829 4         10 2415.925*$init->{emsq}+ 1246.113*$eoc;
5830             $g322= -342.585 + 1554.908*$init->{eccm}-
5831 4         12 2366.899*$init->{emsq}+ 1215.972*$eoc;
5832             $g410=-1052.797 + 4758.686*$init->{eccm}-
5833 4         7 7193.992*$init->{emsq}+ 3651.957*$eoc;
5834             $g422=-3581.69 + 16178.11*$init->{eccm}-
5835 4         9 24462.77*$init->{emsq}+ 12422.52*$eoc;
5836 4 100       21 if ($init->{eccm} > 0.715) {
5837             $g520=-5149.66 +
5838             29936.92*$init->{eccm}-54087.36*$init->{emsq}+
5839 2         24 31324.56*$eoc;
5840             } else {
5841             $g520= 1464.74 - 4664.75*$init->{eccm}+
5842 2         6 3763.64*$init->{emsq};
5843             }
5844             }
5845 5 100       20 if ($init->{eccm} < 0.7) {
5846             $g533= -919.2277 +
5847             4988.61*$init->{eccm}-9064.77*$init->{emsq}+
5848 2         7 5542.21*$eoc;
5849             $g521= -822.71072 +
5850             4568.6173*$init->{eccm}-8491.4146*$init->{emsq}+
5851 2         7 5337.524*$eoc;
5852             $g532= -853.666 +
5853             4690.25*$init->{eccm}-8624.77*$init->{emsq}+
5854 2         6 5341.4*$eoc;
5855             } else {
5856             $g533=-37995.78 +
5857             161616.52*$init->{eccm}-229838.2*$init->{emsq}+
5858 3         12 109377.94*$eoc;
5859             $g521=-51752.104 +
5860             218913.95*$init->{eccm}-309468.16*$init->{emsq}+
5861 3         21 146349.42*$eoc;
5862             $g532=-40023.88 +
5863             170470.89*$init->{eccm}-242699.48*$init->{emsq}+
5864 3         10 115605.82*$eoc;
5865             }
5866 5         10 $sini2= $init->{sinim}*$init->{sinim};
5867 5         16 $f220= 0.75* (1+2*$init->{cosim}+$cosisq);
5868 5         11 $f221= 1.5*$sini2;
5869             $f321= 1.875*$init->{sinim}*
5870 5         13 (1-2*$init->{cosim}-3*$cosisq);
5871             $f322= -1.875*$init->{sinim}*
5872 5         12 (1+2*$init->{cosim}-3*$cosisq);
5873 5         8 $f441= 35*$sini2*$f220;
5874 5         9 $f442= 39.375*$sini2*$sini2;
5875             $f522= 9.84375*$init->{sinim}* ($sini2*
5876             (1-2*$init->{cosim}- 5*$cosisq)+0.33333333 *
5877 5         17 (-2+4*$init->{cosim}+ 6*$cosisq) );
5878             $f523= $init->{sinim}* (4.92187512*$sini2*
5879             (-2-4*$init->{cosim}+ 10*$cosisq) + 6.56250012*
5880 5         32 (1+2*$init->{cosim}-3*$cosisq));
5881             $f542= 29.53125*$init->{sinim}*
5882             (2-8*$init->{cosim}+$cosisq*
5883 5         16 (-12+8*$init->{cosim}+10*$cosisq) );
5884              
5885             $f543= 29.53125*$init->{sinim}*
5886             (-2-8*$init->{cosim}+$cosisq*
5887 5         17 (12+8*$init->{cosim}-10*$cosisq) );
5888 5         10 $xno2= $init->{xn}* $init->{xn};
5889 5         7 $ainv2= $aonv* $aonv;
5890 5         13 $temp1= 3*$xno2*$ainv2;
5891 5         9 $temp= $temp1*$root22;
5892 5         26 $parm->{d2201}= $temp*$f220*$g201;
5893 5         10 $parm->{d2211}= $temp*$f221*$g211;
5894 5         10 $temp1= $temp1*$aonv;
5895 5         6 $temp= $temp1*$root32;
5896 5         10 $parm->{d3210}= $temp*$f321*$g310;
5897 5         13 $parm->{d3222}= $temp*$f322*$g322;
5898 5         10 $temp1= $temp1*$aonv;
5899 5         7 $temp= 2*$temp1*$root44;
5900 5         13 $parm->{d4410}= $temp*$f441*$g410;
5901 5         10 $parm->{d4422}= $temp*$f442*$g422;
5902 5         9 $temp1= $temp1*$aonv;
5903 5         7 $temp= $temp1*$root52;
5904 5         9 $parm->{d5220}= $temp*$f522*$g520;
5905 5         11 $parm->{d5232}= $temp*$f523*$g532;
5906 5         9 $temp= 2*$temp1*$root54;
5907 5         15 $parm->{d5421}= $temp*$f542*$g521;
5908 5         13 $parm->{d5433}= $temp*$f543*$g533;
5909             $parm->{xlamo}=
5910 5         24 fmod($parm->{meananomaly}+$parm->{ascendingnode}+$parm->{ascendingnode}-$theta-$theta,
5911             &SGP_TWOPI);
5912              
5913             $parm->{xfact}= $parm->{mdot}+ $parm->{dmdt}+ 2 *
5914             ($parm->{nodedot}+$parm->{dnodt}-$rptim) -
5915 5         32 $parm->{meanmotion};
5916 5         19 $init->{eccm}= $emo;
5917 5         9 $init->{emsq}= $emsqo;
5918              
5919             }
5920 11 100       38 if ($parm->{irez} == 1) {
5921             #* -------------------- SYNCHRONOUS RESONANCE TERMS --------------------
5922 6         39 $g200= 1 + $init->{emsq}* (-2.5+0.8125*$init->{emsq});
5923 6         13 $g310= 1 + 2*$init->{emsq};
5924 6         13 $g300= 1 + $init->{emsq}* (-6+6.60937*$init->{emsq});
5925 6         15 $f220= 0.75 * (1+$init->{cosim}) * (1+$init->{cosim});
5926             $f311= 0.9375*$init->{sinim}*$init->{sinim}*
5927 6         19 (1+3*$init->{cosim}) - 0.75*(1+$init->{cosim});
5928 6         12 $f330= 1+$init->{cosim};
5929 6         13 $f330= 1.875*$f330*$f330*$f330;
5930 6         19 $parm->{del1}= 3*$init->{xn}*$init->{xn}*$aonv*$aonv;
5931 6         15 $parm->{del2}= 2*$parm->{del1}*$f220*$g200*$q22;
5932 6         14 $parm->{del3}= 3*$parm->{del1}*$f330*$g300*$q33*$aonv;
5933 6         12 $parm->{del1}= $parm->{del1}*$f311*$g310*$q31*$aonv;
5934             $parm->{xlamo}=
5935 6         28 fmod($parm->{meananomaly}+$parm->{ascendingnode}+$parm->{argumentofperigee}-$theta,
5936             &SGP_TWOPI);
5937             $parm->{xfact}= $parm->{mdot}+ $init->{xpidot}- $rptim+
5938             $parm->{dmdt}+ $parm->{domdt}+ $parm->{dnodt}-
5939 6         32 $parm->{meanmotion};
5940              
5941             }
5942             #* ---------------- FOR SGP4, INITIALIZE THE INTEGRATOR ----------------
5943 11         26 $parm->{xli}= $parm->{xlamo};
5944 11         41 $parm->{xni}= $parm->{meanmotion};
5945 11         26 $parm->{atime}= 0;
5946 11         44 $init->{xn}= $parm->{meanmotion}+ $init->{dndt};
5947              
5948             }
5949             #c INCLUDE 'debug3.for'
5950              
5951 23         57 return;
5952             }
5953              
5954             #* -----------------------------------------------------------------------------
5955             #*
5956             #* SUBROUTINE DSPACE
5957             #*
5958             #* This Subroutine provides deep space contributions to mean elements for
5959             #* perturbing third body. these effects have been averaged over one
5960             #* revolution of the sun and moon. for earth resonance effects, the
5961             #* effects have been averaged over no revolutions of the satellite.
5962             #* (mean motion)
5963             #*
5964             #* author : david vallado 719-573-2600 28 jun 2005
5965             #*
5966             #* inputs :
5967             #* d2201, d2211, d3210, d3222, d4410, d4422, d5220, d5232, d5421, d5433 -
5968             #* dedt -
5969             #* del1, del2, del3 -
5970             #* didt -
5971             #* dmdt -
5972             #* dnodt -
5973             #* domdt -
5974             #* irez - flag for resonance 0-none, 1-one day, 2-half day
5975             #* argpo - argument of perigee
5976             #* argpdot - argument of perigee dot (rate)
5977             #* t - time
5978             #* tc -
5979             #* gsto - gst
5980             #* xfact -
5981             #* xlamo -
5982             #* no - mean motion
5983             #* atime -
5984             #* em - eccentricity
5985             #* ft -
5986             #* argpm - argument of perigee
5987             #* inclm - inclination
5988             #* xli -
5989             #* mm - mean anomaly
5990             #* xni - mean motion
5991             #* nodem - right ascension of ascending node
5992             #*
5993             #* outputs :
5994             #* atime -
5995             #* em - eccentricity
5996             #* argpm - argument of perigee
5997             #* inclm - inclination
5998             #* xli -
5999             #* mm - mean anomaly
6000             #* xni -
6001             #* nodem - right ascension of ascending node
6002             #* dndt -
6003             #* nm - mean motion
6004             #*
6005             #* locals :
6006             #* delt -
6007             #* ft -
6008             #* theta -
6009             #* x2li -
6010             #* x2omi -
6011             #* xl -
6012             #* xldot -
6013             #* xnddt -
6014             #* xndt -
6015             #* xomi -
6016             #*
6017             #* coupling :
6018             #* none -
6019             #*
6020             #* references :
6021             #* hoots, roehrich, norad spacetrack report #3 1980
6022             #* hoots, norad spacetrack report #6 1986
6023             #* hoots, schumacher and glover 2004
6024             #* vallado, crawford, hujsak, kelso 2006
6025             #*------------------------------------------------------------------------------
6026              
6027             sub _r_dspace {
6028 397     397   1138 my ($self, $t, $tc, $atime, $eccm, $argpm, $inclm, $xli, $mm, $xni,
6029             $nodem, $dndt, $xn) = @_;
6030             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
6031 397 50       1256 or confess "Programming error - Sgp4r not initialized";
6032              
6033             #* -------------------------- Local Variables --------------------------
6034 397         1382 my ($iretn, $iret);
6035 397         0 my ($delt, $ft, $theta, $x2li, $x2omi, $xl, $xldot, $xnddt, $xndt,
6036             $xomi);
6037              
6038 397         0 my ($g22, $g32, $g44, $g52, $g54, $fasx2, $fasx4, $fasx6, $rptim,
6039             $step2, $stepn, $stepp);
6040             #>>>>trw INCLUDE 'ASTMATH.CMN'
6041              
6042             #* ----------------------------- Constants -----------------------------
6043 397         553 $fasx2= 0.13130908;
6044 397         563 $fasx4= 2.8843198;
6045 397         485 $fasx6= 0.37448087;
6046 397         558 $g22= 5.7686396;
6047 397         516 $g32= 0.95240898;
6048 397         558 $g44= 1.8014998;
6049 397         531 $g52= 1.050833;
6050 397         526 $g54= 4.4108898;
6051 397         511 $rptim= 0.0043752690880113;
6052 397         515 $stepp= 720;
6053 397         581 $stepn= -720;
6054              
6055 397         556 $step2= 259200;
6056             #* --------------- CALCULATE DEEP SPACE RESONANCE EFFECTS --------------
6057 397         567 $$dndt= 0;
6058 397         1404 $theta= fmod($parm->{gsto}+ $tc*$rptim, &SGP_TWOPI);
6059              
6060 397         804 $$eccm= $$eccm+ $parm->{dedt}*$t;
6061 397         595 $$inclm= $$inclm+ $parm->{didt}*$t;
6062 397         651 $$argpm= $$argpm+ $parm->{domdt}*$t;
6063 397         602 $$nodem= $$nodem+ $parm->{dnodt}*$t;
6064              
6065 397         599 $$mm= $$mm+ $parm->{dmdt}*$t;
6066             #c sgp4fix for negative inclinations
6067             #c the following if statement should be commented out
6068             #c IF(Inclm .lt. 0.0D0) THEN
6069             #c Inclm = -Inclm
6070             #c Argpm = Argpm-PI
6071             #c nodem = nodem+PI
6072             #c ENDIF
6073              
6074             #c sgp4fix for propagator problems
6075             #c the following integration works for negative time steps and periods
6076             #c the specific changes are unknown because the original code was so convoluted
6077 397         516 $ft= 0;
6078              
6079 397         520 $$atime= 0;
6080 397 100       1060 if ($parm->{irez} != 0) {
6081             #* ----- UPDATE RESONANCES : NUMERICAL (EULER-MACLAURIN) INTEGRATION ---
6082             #* ---------------------------- EPOCH RESTART --------------------------
6083 220 0 0     546 if ( ($$atime == 0) || (($t >= 0) && ($$atime < 0)) ||
      33        
      0        
      0        
6084             (($t < 0) && ($$atime >= 0)) ) {
6085 220 100       469 if ($t >= 0) {
6086 195         311 $delt= $stepp;
6087             } else {
6088 25         34 $delt= $stepn;
6089             }
6090 220         313 $$atime= 0;
6091 220         348 $$xni= $parm->{meanmotion};
6092 220         391 $$xli= $parm->{xlamo};
6093             }
6094 220         308 $iretn= 381;
6095 220         318 $iret= 0;
6096 220         462 while ($iretn == 381) {
6097 544 50 33     1727 if ( (abs($t) < abs($$atime)) || ($iret == 351) ) {
6098 0 0       0 if ($t >= 0) {
6099 0         0 $delt= $stepn;
6100             } else {
6101 0         0 $delt= $stepp;
6102             }
6103 0         0 $iret= 351;
6104 0         0 $iretn= 381;
6105             } else {
6106 544 100       933 if ($t > 0) {
6107 485         675 $delt= $stepp;
6108             } else {
6109 59         78 $delt= $stepn;
6110             }
6111 544 100       946 if (abs($t-$$atime) >= $stepp) {
6112 324         428 $iret= 0;
6113 324         471 $iretn= 381;
6114             } else {
6115 220         389 $ft= $t-$$atime;
6116 220         326 $iretn= 0;
6117             }
6118              
6119             }
6120             #* --------------------------- DOT TERMS CALCULATED --------------------
6121             #* ------------------- NEAR - SYNCHRONOUS RESONANCE TERMS --------------
6122 544 100       927 if ($parm->{irez} != 2) {
6123             $xndt= $parm->{del1}*sin($$xli-$fasx2) +
6124             $parm->{del2}*sin(2*($$xli-$fasx4)) +
6125 219         595 $parm->{del3}*sin(3*($$xli-$fasx6));
6126 219         364 $xldot= $$xni+ $parm->{xfact};
6127             $xnddt= $parm->{del1}*cos($$xli-$fasx2) +
6128             2*$parm->{del2}*cos(2*($$xli-$fasx4)) +
6129 219         552 3*$parm->{del3}*cos(3*($$xli-$fasx6));
6130 219         333 $xnddt= $xnddt*$xldot;
6131              
6132             } else {
6133             #* --------------------- NEAR - HALF-DAY RESONANCE TERMS ---------------
6134             $xomi= $parm->{argumentofperigee}+
6135 325         542 $parm->{argpdot}*$$atime;
6136 325         433 $x2omi= $xomi+ $xomi;
6137 325         417 $x2li= $$xli+ $$xli;
6138             $xndt= $parm->{d2201}*sin($x2omi+$$xli-$g22) +
6139             $parm->{d2211}*sin($$xli-$g22) +
6140             $parm->{d3210}*sin($xomi+$$xli-$g32) +
6141             $parm->{d3222}*sin(-$xomi+$$xli-$g32) +
6142             $parm->{d4410}*sin($x2omi+$x2li-$g44)+
6143             $parm->{d4422}*sin($x2li-$g44)+
6144             $parm->{d5220}*sin($xomi+$$xli-$g52) +
6145             $parm->{d5232}*sin(-$xomi+$$xli-$g52) +
6146             $parm->{d5421}*sin($xomi+$x2li-$g54)+
6147 325         1600 $parm->{d5433}*sin(-$xomi+$x2li-$g54);
6148 325         505 $xldot= $$xni+$parm->{xfact};
6149             $xnddt= $parm->{d2201}*cos($x2omi+$$xli-$g22) +
6150             $parm->{d2211}*cos($$xli-$g22)+
6151             $parm->{d3210}*cos($xomi+$$xli-$g32) +
6152             $parm->{d3222}*cos(-$xomi+$$xli-$g32) +
6153             $parm->{d5220}*cos($xomi+$$xli-$g52) +
6154             $parm->{d5232}*cos(-$xomi+$$xli-$g52) +
6155             2*($parm->{d4410}*cos($x2omi+$x2li-$g44) +
6156             $parm->{d4422}*cos($x2li-$g44) +
6157             $parm->{d5421}*cos($xomi+$x2li-$g54) +
6158 325         1506 $parm->{d5433}*cos(-$xomi+$x2li-$g54));
6159 325         431 $xnddt= $xnddt*$xldot;
6160              
6161             }
6162             #* ------------------------------- INTEGRATOR --------------------------
6163 544 100       1166 if ($iretn == 381) {
6164 324         623 $$xli= $$xli+ $xldot*$delt+ $xndt*$step2;
6165 324         528 $$xni= $$xni+ $xndt*$delt+ $xnddt*$step2;
6166 324         599 $$atime= $$atime+ $delt;
6167              
6168             }
6169              
6170             }
6171 220         429 $$xn= $$xni+ $xndt*$ft+ $xnddt*$ft*$ft*0.5;
6172 220         413 $xl= $$xli+ $xldot*$ft+ $xndt*$ft*$ft*0.5;
6173 220 100       423 if ($parm->{irez} != 1) {
6174 125         207 $$mm= $xl-2*$$nodem+2*$theta;
6175 125         192 $$dndt= $$xn-$parm->{meanmotion};
6176             } else {
6177 95         156 $$mm= $xl-$$nodem-$$argpm+$theta;
6178 95         145 $$dndt= $$xn-$parm->{meanmotion};
6179              
6180             }
6181 220         338 $$xn= $parm->{meanmotion}+ $$dndt;
6182              
6183             }
6184             #c INCLUDE 'debug4.for'
6185              
6186 397         868 return;
6187             }
6188              
6189             #* -----------------------------------------------------------------------------
6190             #*
6191             #* SUBROUTINE INITL
6192             #*
6193             #* this subroutine initializes the spg4 propagator. all the initialization is
6194             #* consolidated here instead of having multiple loops inside other routines.
6195             #*
6196             #* author : david vallado 719-573-2600 28 jun 2005
6197             #*
6198             #* inputs :
6199             #* ecco - eccentricity 0.0 - 1.0
6200             #* epoch - epoch time in days from jan 0, 1950. 0 hr
6201             #* inclo - inclination of satellite
6202             #* no - mean motion of satellite
6203             #* satn - satellite number
6204             #*
6205             #* outputs :
6206             #* ainv - 1.0 / a
6207             #* ao - semi major axis
6208             #* con41 -
6209             #* con42 - 1.0 - 5.0 cos(i)
6210             #* cosio - cosine of inclination
6211             #* cosio2 - cosio squared
6212             #* eccsq - eccentricity squared
6213             #* method - flag for deep space 'd', 'n'
6214             #* omeosq - 1.0 - ecco * ecco
6215             #* posq - semi-parameter squared
6216             #* rp - radius of perigee
6217             #* rteosq - square root of (1.0 - ecco*ecco)
6218             #* sinio - sine of inclination
6219             #* gsto - gst at time of observation rad
6220             #* no - mean motion of satellite
6221             #*
6222             #* locals :
6223             #* ak -
6224             #* d1 -
6225             #* del -
6226             #* adel -
6227             #* po -
6228             #*
6229             #* coupling :
6230             #* getgravconst-
6231             #*
6232             #* references :
6233             #* hoots, roehrich, norad spacetrack report #3 1980
6234             #* hoots, norad spacetrack report #6 1986
6235             #* hoots, schumacher and glover 2004
6236             #* vallado, crawford, hujsak, kelso 2006
6237             #*------------------------------------------------------------------------------
6238              
6239             sub _r_initl {
6240 35     35   86 my ($self) = @_;
6241             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
6242 35 50       144 or confess "Programming error - Sgp4r not initialized";
6243             my $init = $parm->{init}
6244 35 50       97 or confess "Programming error - Sgp4r initialization not in progress";
6245              
6246             #* -------------------------- Local Variables --------------------------
6247             #cdav old way
6248             #c integer ids70
6249             #c real*8 ts70, ds70, tfrac, c1, thgr70, fk5r, c1p2p, thgr, thgro,
6250             #c & twopi
6251             #>>>>trw INCLUDE 'ASTMATH.CMN'
6252              
6253             #* ------------------------ WGS-72 EARTH CONSTANTS ---------------------
6254              
6255             #>>>>trw X2o3 = 2.0D0/3.0D0
6256              
6257             #>>>>trw CALL getgravconst( whichconst, tumin, mu, radiusearthkm, xke, j2, j3, j4, j3oj2 )
6258             #* ----------------- CALCULATE AUXILLARY EPOCH QUANTITIES --------------
6259 35         94 $init->{eccsq}= $parm->{eccentricity}*$parm->{eccentricity};
6260 35         94 $init->{omeosq}= 1 - $init->{eccsq};
6261 35         70 $init->{rteosq}= sqrt($init->{omeosq});
6262 35         82 $init->{cosio}= cos($parm->{inclination});
6263              
6264 35         121 $init->{cosio2}= $init->{cosio}*$init->{cosio};
6265             #* ---------------------- UN-KOZAI THE MEAN MOTION ---------------------
6266 35         171 my $ak= ($parm->{xke}/$parm->{meanmotion})**&SGP_TOTHRD;
6267             my $d1= 0.75*$parm->{j2}* (3*$init->{cosio2}-1) /
6268 35         118 ($init->{rteosq}*$init->{omeosq});
6269 35         84 my $del= $d1/($ak*$ak);
6270 35         97 my $adel= $ak* ( 1 - $del*$del- $del* (1/3 + 134*$del*$del/ 81) );
6271 35         61 $del= $d1/($adel*$adel);
6272              
6273 35         88 $parm->{meanmotion}= $parm->{meanmotion}/(1 + $del);
6274 35         123 $init->{ao}= ($parm->{xke}/$parm->{meanmotion})**&SGP_TOTHRD;
6275 35         75 $init->{sinio}= sin($parm->{inclination});
6276 35         73 my $po= $init->{ao}*$init->{omeosq};
6277 35         115 $init->{con42}= 1-5*$init->{cosio2};
6278 35         93 $parm->{con41}= -$init->{con42}-$init->{cosio2}-$init->{cosio2};
6279 35         76 $init->{ainv}= 1/$init->{ao};
6280 35         60 $init->{posq}= $po*$po;
6281 35         89 $init->{rp}= $init->{ao}*(1-$parm->{eccentricity});
6282              
6283 35         70 $parm->{deep_space}=0;
6284             #* ----------------- CALCULATE GREENWICH LOCATION AT EPOCH -------------
6285             #cdav new approach using JD
6286 35         79 my $radperday= &SGP_TWOPI* 1.0027379093508;
6287              
6288 35         77 my $temp= $self->{ds50}+ 2433281.5;
6289 35         105 my $tut1= ( int($temp-0.5) + 0.5 - 2451545 ) / 36525;
6290              
6291 35         143 $parm->{gsto}= 1.75336855923327 + 628.331970688841*$tut1+
6292             6.77071394490334e-06*$tut1*$tut1-
6293             4.50876723431868e-10*$tut1*$tut1*$tut1+ $radperday*(
6294             $temp-0.5-int($temp-0.5) );
6295 35         128 $parm->{gsto}= fmod($parm->{gsto}, &SGP_TWOPI);
6296 35 100       117 if ( $parm->{gsto} < 0 ) {
6297 9         35 $parm->{gsto}= $parm->{gsto}+ &SGP_TWOPI;
6298              
6299             }
6300             #* CALCULATE NUMBER OF INTEGER DAYS SINCE 0 JAN 1970.
6301             #cdav old way
6302             #c TS70 =EPOCH-7305.D0
6303             #c IDS70=TS70 + 1.D-8
6304             #c DS70 =IDS70
6305             #c TFRAC=TS70-DS70
6306             #* CALCULATE GREENWICH LOCATION AT EPOCH
6307             #c C1 = 1.72027916940703639D-2
6308             #c THGR70= 1.7321343856509374D0
6309             #c FK5R = 5.07551419432269442D-15
6310             #c twopi = 6.283185307179586D0
6311             #c C1P2P = C1+TWOPI
6312             #c THGR = DMOD(THGR70+C1*DS70+C1P2P*TFRAC+TS70*TS70*FK5R,twopi)
6313             #c THGRO = DMOD(THGR,twopi)
6314             #c gsto = thgro
6315             #c write(*,*) Satn,' gst delta ', gsto-gsto1
6316              
6317             #c INCLUDE 'debug5.for'
6318              
6319 35         73 return;
6320             }
6321              
6322             #* -----------------------------------------------------------------------------
6323             #*
6324             #* SUBROUTINE SGP4INIT
6325             #*
6326             #* This subroutine initializes variables for SGP4.
6327             #*
6328             #* author : david vallado 719-573-2600 28 jun 2005
6329             #*
6330             #* inputs :
6331             #* satn - satellite number
6332             #* bstar - sgp4 type drag coefficient kg/m2er
6333             #* ecco - eccentricity
6334             #* epoch - epoch time in days from jan 0, 1950. 0 hr
6335             #* argpo - argument of perigee (output if ds)
6336             #* inclo - inclination
6337             #* mo - mean anomaly (output if ds)
6338             #* no - mean motion
6339             #* nodeo - right ascension of ascending node
6340             #*
6341             #* outputs :
6342             #* satrec - common block values for subsequent calls
6343             #* return code - non-zero on error.
6344             #* 1 - mean elements, ecc >= 1.0 or ecc < -0.001 or a < 0.95 er
6345             #* 2 - mean motion less than 0.0
6346             #* 3 - pert elements, ecc < 0.0 or ecc > 1.0
6347             #* 4 - semi-latus rectum < 0.0
6348             #* 5 - epoch elements are sub-orbital
6349             #* 6 - satellite has decayed
6350             #*
6351             #* locals :
6352             #* CNODM , SNODM , COSIM , SINIM , COSOMM , SINOMM
6353             #* Cc1sq , Cc2 , Cc3
6354             #* Coef , Coef1
6355             #* cosio4 -
6356             #* day -
6357             #* dndt -
6358             #* em - eccentricity
6359             #* emsq - eccentricity squared
6360             #* eeta -
6361             #* etasq -
6362             #* gam -
6363             #* argpm - argument of perigee
6364             #* ndem -
6365             #* inclm - inclination
6366             #* mm - mean anomaly
6367             #* nm - mean motion
6368             #* perige - perigee
6369             #* pinvsq -
6370             #* psisq -
6371             #* qzms24 -
6372             #* rtemsq -
6373             #* s1, s2, s3, s4, s5, s6, s7 -
6374             #* sfour -
6375             #* ss1, ss2, ss3, ss4, ss5, ss6, ss7 -
6376             #* sz1, sz2, sz3
6377             #* sz11, sz12, sz13, sz21, sz22, sz23, sz31, sz32, sz33 -
6378             #* tc -
6379             #* temp -
6380             #* temp1, temp2, temp3 -
6381             #* tsi -
6382             #* xpidot -
6383             #* xhdot1 -
6384             #* z1, z2, z3 -
6385             #* z11, z12, z13, z21, z22, z23, z31, z32, z33 -
6386             #*
6387             #* coupling :
6388             #* getgravconst-
6389             #* initl -
6390             #* dscom -
6391             #* dpper -
6392             #* dsinit -
6393             #*
6394             #* references :
6395             #* hoots, roehrich, norad spacetrack report #3 1980
6396             #* hoots, norad spacetrack report #6 1986
6397             #* hoots, schumacher and glover 2004
6398             #* vallado, crawford, hujsak, kelso 2006
6399             #* ---------------------------------------------------------------------------- }
6400              
6401             sub _r_sgp4init {
6402 35     35   95 my ($self) = @_;
6403 35         91 my $oid = $self->get('id');
6404 35         226 my $parm = $self->{&TLE_INIT}{TLE_sgp4r} = {};
6405 35         129 my $init = $parm->{init} = {};
6406             # The following is modified in _r_initl
6407 35         139 $parm->{meanmotion} = $self->{meanmotion};
6408             # The following may be modified for deep space
6409 35         109 $parm->{eccentricity} = $self->{eccentricity};
6410 35         105 $parm->{inclination} = $self->{inclination};
6411 35         89 $parm->{ascendingnode} = $self->{ascendingnode};
6412 35         85 $parm->{argumentofperigee} = $self->{argumentofperigee};
6413 35         73 $parm->{meananomaly} = $self->{meananomaly};
6414              
6415             #>>>>trw my ($t, @r, @v);
6416 35         66 my ($t);
6417             #>>>>trw INCLUDE 'SGP4.CMN'
6418              
6419             #* -------------------------- Local Variables --------------------------
6420              
6421 35         158 my ($cc1sq, $cc2, $cc3, $coef, $coef1, $cosio4, $eeta, $etasq,
6422             $perige, $pinvsq, $psisq, $qzms24, $sfour, $tc, $temp, $temp1,
6423             $temp2, $temp3, $tsi, $xhdot1);
6424 35         0 my ($qzms2t, $ss, $temp4);
6425             #>>>>trw INCLUDE 'ASTMATH.CMN'
6426              
6427             #* ---------------------------- INITIALIZATION -------------------------
6428 35         106 $parm->{deep_space}=0;
6429             #c clear sgp4 flag
6430              
6431 35         123 $self->{model_error}= &SGP4R_ERROR_0;
6432             #c sgp4fix - note the following variables are also passed directly via sgp4 common.
6433             #c it is possible to streamline the sgp4init call by deleting the "x"
6434             #c variables, but the user would need to set the common values first. we
6435             #c include the additional assignment in case twoline2rv is not used.
6436              
6437             #>>>>trw bstar = xbstar
6438             #>>>>trw ecco = xecco
6439             #>>>>trw argpo = xargpo
6440             #>>>>trw inclo = xinclo
6441             #>>>>trw mo = xmo
6442             #>>>>trw no = xno
6443              
6444             #>>>>trw nodeo = xnodeo
6445              
6446 35         136 $self->_r_getgravconst();
6447 35         89 $ss= 78/$parm->{radiusearthkm}+ 1;
6448 35         87 $qzms2t= ((120-78)/$parm->{radiusearthkm}) ** 4;
6449             #>>>>trw X2o3 = 2.0D0 / 3.0D0
6450              
6451 35         139 $temp4= 1 + cos(&SGP_PI-1e-09);
6452             #>>>>trw Init = 'y'
6453              
6454 35         60 $t= 0;
6455              
6456 35 50       107 $self->{eccentricity} > 1
6457             and croak "Error - OID $oid Sgp4r TLE eccentricity > 1";
6458 35 50       98 $self->{eccentricity} < 0
6459             and croak "Error - OID $oid Sgp4r TLE eccentricity < 0";
6460 35 50       101 $self->{meanmotion} < 0
6461             and croak "Error - OID $oid Sgp4r TLE mean motion < 0";
6462 35         147 $self->_r_initl();
6463 35 100       93 if ($init->{rp} < 1) {
6464             #c Write(*,*) '# *** SATN',Satn,' EPOCH ELTS SUB-ORBITAL *** '
6465 1         15 $self->{model_error}= &SGP4R_ERROR_5;
6466              
6467             }
6468 35 50 33     133 if ($init->{omeosq} >= 0 || $parm->{meanmotion} >= 0) {
6469 35         96 $parm->{isimp}= 0;
6470 35 100       134 if ($init->{rp} < (220/$parm->{radiusearthkm}+1)) {
6471 16         36 $parm->{isimp}= 1;
6472             }
6473 35         122 $sfour= $ss;
6474 35         58 $qzms24= $qzms2t;
6475              
6476 35         70 $perige= ($init->{rp}-1)*$parm->{radiusearthkm};
6477             #* ----------- For perigees below 156 km, S and Qoms2t are altered -----
6478 35 100       80 if ($perige < 156) {
6479 9         30 $sfour= $perige-78;
6480 9 100       51 if ($perige <= 98) {
6481 3         7 $sfour= 20;
6482             }
6483 9         35 $qzms24= ( (120-$sfour)/$parm->{radiusearthkm})**4;
6484 9         41 $sfour= $sfour/$parm->{radiusearthkm}+ 1;
6485             }
6486              
6487 35         68 $pinvsq= 1/$init->{posq};
6488 35         78 $tsi= 1/($init->{ao}-$sfour);
6489 35         104 $parm->{eta}= $init->{ao}*$parm->{eccentricity}*$tsi;
6490 35         60 $etasq= $parm->{eta}*$parm->{eta};
6491 35         59 $eeta= $parm->{eccentricity}*$parm->{eta};
6492 35         74 $psisq= abs(1-$etasq);
6493 35         126 $coef= $qzms24*$tsi**4;
6494 35         115 $coef1= $coef/$psisq**3.5;
6495             $cc2= $coef1*$parm->{meanmotion}* ($init->{ao}*
6496             (1+1.5*$etasq+$eeta* (4+$etasq) )+0.375*
6497 35         194 $parm->{j2}*$tsi/$psisq*$parm->{con41}*(8+3*$etasq*(8+$etasq)));
6498 35         105 $parm->{cc1}= $self->{bstardrag}*$cc2;
6499 35         59 $cc3= 0;
6500 35 100       80 if ($parm->{eccentricity} > 0.0001) {
6501             $cc3=
6502             -2*$coef*$tsi*$parm->{j3oj2}*$parm->{meanmotion}*
6503 33         193 $init->{sinio}/$parm->{eccentricity};
6504             }
6505 35         87 $parm->{x1mth2}= 1-$init->{cosio2};
6506             $parm->{cc4}=
6507             2*$parm->{meanmotion}*$coef1*$init->{ao}*$init->{omeosq}*
6508             ($parm->{eta}*(2+0.5*$etasq)
6509             +$parm->{eccentricity}*(0.5 + 2*$etasq) - $parm->{j2}*$tsi/
6510             ($init->{ao}*$psisq)* (-3*$parm->{con41}*(1-2*
6511             $eeta+$etasq*(1.5-0.5*$eeta))+0.75*$parm->{x1mth2}*
6512 35         231 (2*$etasq-$eeta*(1+$etasq))*cos(2*$parm->{argumentofperigee})));
6513 35         113 $parm->{cc5}= 2*$coef1*$init->{ao}*$init->{omeosq}* (1 + 2.75*
6514             ($etasq+ $eeta) + $eeta*$etasq);
6515 35         63 $cosio4= $init->{cosio2}*$init->{cosio2};
6516 35         68 $temp1= 1.5*$parm->{j2}*$pinvsq*$parm->{meanmotion};
6517 35         63 $temp2= 0.5*$temp1*$parm->{j2}*$pinvsq;
6518             $temp3=
6519 35         74 -0.46875*$parm->{j4}*$pinvsq*$pinvsq*$parm->{meanmotion};
6520             $parm->{mdot}= $parm->{meanmotion}+
6521             0.5*$temp1*$init->{rteosq}*$parm->{con41}+ 0.0625*$temp2*
6522 35         140 $init->{rteosq}*(13 - 78*$init->{cosio2}+ 137*$cosio4);
6523             $parm->{argpdot}= -0.5*$temp1*$init->{con42}+ 0.0625*$temp2* (7
6524             - 114*$init->{cosio2}+
6525 35         134 395*$cosio4)+$temp3*(3-36*$init->{cosio2}+49*$cosio4);
6526 35         79 $xhdot1= -$temp1*$init->{cosio};
6527             $parm->{nodedot}= $xhdot1+(0.5*$temp2*(4-19*$init->{cosio2})+
6528 35         114 2*$temp3*(3 - 7*$init->{cosio2}))*$init->{cosio};
6529 35         78 $init->{xpidot}= $parm->{argpdot}+$parm->{nodedot};
6530             $parm->{omgcof}=
6531 35         80 $self->{bstardrag}*$cc3*cos($parm->{argumentofperigee});
6532 35         73 $parm->{xmcof}= 0;
6533 35 100       86 if ($parm->{eccentricity} > 0.0001) {
6534 33         114 $parm->{xmcof}= -&SGP_TOTHRD*$coef*$self->{bstardrag}/$eeta;
6535             }
6536 35         95 $parm->{xnodcf}= 3.5*$init->{omeosq}*$xhdot1*$parm->{cc1};
6537 35         99 $parm->{t2cof}= 1.5*$parm->{cc1};
6538             #c sgp4fix for divide by zero with xinco = 180 deg
6539 35 50       116 if (abs($init->{cosio}+1) > 1.5e-12) {
6540             $parm->{xlcof}= -0.25*$parm->{j3oj2}*$init->{sinio}*
6541 35         228 (3+5*$init->{cosio})/(1+$init->{cosio});
6542             } else {
6543             $parm->{xlcof}= -0.25*$parm->{j3oj2}*$init->{sinio}*
6544 0         0 (3+5*$init->{cosio})/$temp4;
6545             }
6546 35         113 $parm->{aycof}= -0.5*$parm->{j3oj2}*$init->{sinio};
6547 35         200 $parm->{delmo}= (1+$parm->{eta}*cos($parm->{meananomaly}))**3;
6548 35         92 $parm->{sinmao}= sin($parm->{meananomaly});
6549              
6550 35         99 $parm->{x7thm1}= 7*$init->{cosio2}-1;
6551             #* ------------------------ Deep Space Initialization ------------------
6552 35 100       123 if ((&SGP_TWOPI/$parm->{meanmotion}) >= 225) {
6553 23         58 $parm->{deep_space}=1;
6554 23         50 $parm->{isimp}= 1;
6555 23         50 $tc= 0;
6556 23         64 $init->{inclm}= $parm->{inclination};
6557 23         98 $self->_r_dscom ($tc);
6558              
6559             $self->_r_dpper ($t, \$parm->{eccentricity},
6560             \$parm->{inclination}, \$parm->{ascendingnode},
6561 23         142 \$parm->{argumentofperigee}, \$parm->{meananomaly});
6562 23         167 $init->{argpm}= 0;
6563 23         65 $init->{nodem}= 0;
6564              
6565 23         47 $init->{mm}= 0;
6566 23         96 $self->_r_dsinit ($t, $tc);
6567              
6568             }
6569             #* ------------ Set variables if not deep space or rp < 220 -------------
6570 35 100       110 if ( ! $parm->{isimp}) {
6571 4         10 $cc1sq= $parm->{cc1}*$parm->{cc1};
6572 4         25 $parm->{d2}= 4*$init->{ao}*$tsi*$cc1sq;
6573 4         14 $temp= $parm->{d2}*$tsi*$parm->{cc1}/ 3;
6574 4         12 $parm->{d3}= (17*$init->{ao}+ $sfour) * $temp;
6575             $parm->{d4}= 0.5*$temp*$init->{ao}*$tsi* (221*$init->{ao}+
6576 4         12 31*$sfour)*$parm->{cc1};
6577 4         15 $parm->{t3cof}= $parm->{d2}+ 2*$cc1sq;
6578             $parm->{t4cof}= 0.25*
6579 4         16 (3*$parm->{d3}+$parm->{cc1}*(12*$parm->{d2}+10*$cc1sq)
6580             );
6581             $parm->{t5cof}= 0.2* (3*$parm->{d4}+
6582             12*$parm->{cc1}*$parm->{d3}+ 6*$parm->{d2}*$parm->{d2}+
6583 4         20 15*$cc1sq* (2*$parm->{d2}+ $cc1sq) );
6584              
6585             }
6586              
6587             }
6588              
6589             #>>>>trw init = 'n'
6590              
6591             #>>>>trw CALL SGP4(whichconst, 0.0D0, r, v, error)
6592             #c INCLUDE 'debug6.for'
6593              
6594             #>>>>trw RETURN
6595              
6596 35         82 delete $parm->{init};
6597 35         266 return $parm;
6598             }
6599              
6600             #* -----------------------------------------------------------------------------
6601             #*
6602             #* SUBROUTINE SGP4
6603             #*
6604             #* this procedure is the sgp4 prediction model from space command. this is an
6605             #* updated and combined version of sgp4 and sdp4, which were originally
6606             #* published separately in spacetrack report #3. this version follows the
6607             #* methodology from the aiaa paper (2006) describing the history and
6608             #* development of the code.
6609             #*
6610             #* author : david vallado 719-573-2600 28 jun 2005
6611             #*
6612             #* inputs :
6613             #* satrec - initialised structure from sgp4init() call.
6614             #* tsince - time eince epoch (minutes)
6615             #*
6616             #* outputs :
6617             #* r - position vector km
6618             #* v - velocity km/sec
6619             #* return code - non-zero on error.
6620             #* 1 - mean elements, ecc >= 1.0 or ecc < -0.001 or a < 0.95 er
6621             #* 2 - mean motion less than 0.0
6622             #* 3 - pert elements, ecc < 0.0 or ecc > 1.0
6623             #* 4 - semi-latus rectum < 0.0
6624             #* 5 - epoch elements are sub-orbital
6625             #* 6 - satellite has decayed
6626             #*
6627             #* locals :
6628             #* am -
6629             #* axnl, aynl -
6630             #* betal -
6631             #* COSIM , SINIM , COSOMM , SINOMM , Cnod , Snod , Cos2u ,
6632             #* Sin2u , Coseo1 , Sineo1 , Cosi , Sini , Cosip , Sinip ,
6633             #* Cosisq , Cossu , Sinsu , Cosu , Sinu
6634             #* Delm -
6635             #* Delomg -
6636             #* Dndt -
6637             #* Eccm -
6638             #* EMSQ -
6639             #* Ecose -
6640             #* El2 -
6641             #* Eo1 -
6642             #* Eccp -
6643             #* Esine -
6644             #* Argpm -
6645             #* Argpp -
6646             #* Omgadf -
6647             #* Pl -
6648             #* R -
6649             #* RTEMSQ -
6650             #* Rdotl -
6651             #* Rl -
6652             #* Rvdot -
6653             #* Rvdotl -
6654             #* Su -
6655             #* T2 , T3 , T4 , Tc
6656             #* Tem5, Temp , Temp1 , Temp2 , Tempa , Tempe , Templ
6657             #* U , Ux , Uy , Uz , Vx , Vy , Vz
6658             #* inclm - inclination
6659             #* mm - mean anomaly
6660             #* nm - mean motion
6661             #* nodem - longi of ascending node
6662             #* xinc -
6663             #* xincp -
6664             #* xl -
6665             #* xlm -
6666             #* mp -
6667             #* xmdf -
6668             #* xmx -
6669             #* xmy -
6670             #* nodedf -
6671             #* xnode -
6672             #* nodep -
6673             #* np -
6674             #*
6675             #* coupling :
6676             #* getgravconst-
6677             #* dpper
6678             #* dpspace
6679             #*
6680             #* references :
6681             #* hoots, roehrich, norad spacetrack report #3 1980
6682             #* hoots, norad spacetrack report #6 1986
6683             #* hoots, schumacher and glover 2004
6684             #* vallado, crawford, hujsak, kelso 2006
6685             #*------------------------------------------------------------------------------
6686              
6687             sub sgp4r {
6688 18820     18820 1 33196 my ($self, $t) = @_;
6689 18820         36922 my $oid = $self->get('id');
6690 18820   66     72821 my $parm = $self->{&TLE_INIT}{TLE_sgp4r} ||= $self->_r_sgp4init ();
6691 18820         31497 my $time = $t;
6692 18820         39302 $t = ($t - $self->{epoch}) / 60;
6693              
6694 18820         84370 my (@r, @v);
6695             #>>>>trw INCLUDE 'SGP4.CMN'
6696              
6697             #* -------------------------- Local Variables --------------------------
6698              
6699 18820         0 my ($am, $axnl, $aynl, $betal, $cosim, $cnod, $cos2u, $coseo1,
6700             $cosi, $cosip, $cosisq, $cossu, $cosu, $delm, $delomg, $eccm,
6701             $emsq, $ecose, $el2, $eo1, $eccp, $esine, $argpm, $argpp,
6702             $omgadf, $pl, $rdotl, $rl, $rvdot, $rvdotl, $sinim, $sin2u,
6703             $sineo1, $sini, $sinip, $sinsu, $sinu, $snod, $su, $t2, $t3,
6704             $t4, $tem5, $temp, $temp1, $temp2, $tempa, $tempe, $templ, $u,
6705             $ux, $uy, $uz, $vx, $vy, $vz, $inclm, $mm, $xn, $nodem, $xinc,
6706             $xincp, $xl, $xlm, $mp, $xmdf, $xmx, $xmy, $xnoddf, $xnode,
6707             $nodep, $tc, $dndt);
6708 18820         0 my ($mr, $mv, $vkmpersec, $temp4);
6709              
6710 18820         0 my ($iter);
6711             #>>>>trw INCLUDE 'ASTMATH.CMN'
6712              
6713             #* ------------------------ WGS-72 EARTH CONSTANTS ---------------------
6714             #* ---------------------- SET MATHEMATICAL CONSTANTS -------------------
6715              
6716             #>>>>trw X2O3 = 2.0D0/3.0D0
6717             #c Keep compiler ok for warnings on uninitialized variables
6718 18820         27036 $mr= 0;
6719 18820         27164 $coseo1= 1;
6720              
6721 18820         24114 $sineo1= 0;
6722             #>>>>trw CALL getgravconst( whichconst, tumin, mu, radiusearthkm, xke, j2, j3, j4, j3oj2 )
6723 18820         53731 $temp4= 1 + cos(&SGP_PI-1e-09);
6724              
6725 18820         35100 $vkmpersec= $parm->{radiusearthkm}* $parm->{xke}/60;
6726             #* ------------------------- CLEAR SGP4 ERROR FLAG ---------------------
6727              
6728 18820         39246 $self->{model_error}= &SGP4R_ERROR_0;
6729             #* ----------- UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG ---------
6730 18820         32342 $xmdf= $parm->{meananomaly}+ $parm->{mdot}*$t;
6731 18820         28690 $omgadf= $parm->{argumentofperigee}+ $parm->{argpdot}*$t;
6732 18820         32064 $xnoddf= $parm->{ascendingnode}+ $parm->{nodedot}*$t;
6733 18820         25605 $argpm= $omgadf;
6734 18820         24945 $mm= $xmdf;
6735 18820         26305 $t2= $t*$t;
6736 18820         28593 $nodem= $xnoddf+ $parm->{xnodcf}*$t2;
6737 18820         32831 $tempa= 1 - $parm->{cc1}*$t;
6738 18820         29504 $tempe= $self->{bstardrag}*$parm->{cc4}*$t;
6739 18820         25845 $templ= $parm->{t2cof}*$t2;
6740 18820 100       36638 if ( ! $parm->{isimp}) {
6741 85         146 $delomg= $parm->{omgcof}*$t;
6742             $delm= $parm->{xmcof}*(( 1+$parm->{eta}*cos($xmdf)
6743 85         511 )**3-$parm->{delmo});
6744 85         126 $temp= $delomg+ $delm;
6745 85         128 $mm= $xmdf+ $temp;
6746 85         129 $argpm= $omgadf- $temp;
6747 85         137 $t3= $t2*$t;
6748 85         130 $t4= $t3*$t;
6749             $tempa= $tempa- $parm->{d2}*$t2- $parm->{d3}*$t3-
6750 85         167 $parm->{d4}*$t4;
6751             $tempe= $tempe+ $self->{bstardrag}*$parm->{cc5}*(sin($mm) -
6752 85         224 $parm->{sinmao});
6753             $templ= $templ+ $parm->{t3cof}*$t3+ $t4*($parm->{t4cof}+
6754 85         187 $t*$parm->{t5cof});
6755             }
6756 18820         27419 $xn= $parm->{meanmotion};
6757 18820         27266 $eccm= $parm->{eccentricity};
6758 18820         26091 $inclm= $parm->{inclination};
6759 18820 100       35772 if ($parm->{deep_space}) {
6760 397         560 $tc= $t;
6761             $self->_r_dspace ($t, $tc, \$parm->{atime}, \$eccm, \$argpm,
6762 397         1475 \$inclm, \$parm->{xli}, \$mm, \$parm->{xni}, \$nodem,
6763             \$dndt, \$xn);
6764              
6765             }
6766             #c mean motion less than 0.0
6767 18820 50       37605 if ($xn <= 0) {
6768 0         0 $self->{model_error}= &SGP4R_ERROR_2;
6769 0         0 croak "Error - OID $oid ", &SGP4R_ERROR_MEAN_MOTION;
6770             }
6771 18820         58832 $am= ($parm->{xke}/$xn)**&SGP_TOTHRD*$tempa**2;
6772 18820         34565 $xn= $parm->{xke}/$am**1.5;
6773 18820         25584 $eccm= $eccm-$tempe;
6774             $self->{debug}
6775 18820 50       37737 and warn "Debug - OID $oid sgp4r effective eccentricity $eccm\n";
6776             #c fix tolerance for error recognition
6777 18820 100 66     86976 if ($eccm >= 1 || $eccm < -0.001 || $am < 0.95) {
      66        
6778             #c write(6,*) '# Error 1, Eccm = ', Eccm, ' AM = ', AM
6779 4         11 $self->{model_error} = &SGP4R_ERROR_1;
6780 4         8 my $tfmt = '%d-%b-%Y %H:%M:%S';
6781 4         17 my @data = "Error - OID $oid " . &SGP4R_ERROR_MEAN_ECCEN;
6782 4         30 push @data, "eccentricity = $eccm";
6783 4         11 foreach my $thing (qw{universal epoch effective}) {
6784 12 100       75 if (defined ( my $value = $self->can($thing) ?
    100          
6785             $self->$thing() :
6786             $self->get($thing))) {
6787 8         15 local $@ = undef;
6788 8         20 my $diag = eval {
6789 8         333 strftime( "$thing = $tfmt", gmtime $value ) };
6790 8 50       30 defined $diag or $diag = "$thing = $value";
6791 8         24 push @data, $diag;
6792             } else {
6793 4         14 push @data, "$thing is undefined";
6794             }
6795             }
6796 4         924 croak join '; ', @data
6797             }
6798 18816 100       36431 if ($eccm < 0) {
6799 5         36 $eccm= 1e-06
6800             }
6801 18816         32353 $mm= $mm+$parm->{meanmotion}*$templ;
6802 18816         26672 $xlm= $mm+$argpm+$nodem;
6803 18816         24891 $emsq= $eccm*$eccm;
6804 18816         26223 $temp= 1 - $emsq;
6805 18816         54158 $nodem= fmod($nodem, &SGP_TWOPI);
6806 18816         36366 $argpm= fmod($argpm, &SGP_TWOPI);
6807 18816         38328 $xlm= fmod($xlm, &SGP_TWOPI);
6808              
6809 18816         43821 $mm= fmod($xlm- $argpm- $nodem, &SGP_TWOPI);
6810             #* --------------------- COMPUTE EXTRA MEAN QUANTITIES -----------------
6811 18816         32525 $sinim= sin($inclm);
6812              
6813 18816         27041 $cosim= cos($inclm);
6814             #* ------------------------ ADD LUNAR-SOLAR PERIODICS ------------------
6815 18816         28941 $eccp= $eccm;
6816 18816         25471 $xincp= $inclm;
6817 18816         24178 $argpp= $argpm;
6818 18816         26493 $nodep= $nodem;
6819 18816         23288 $mp= $mm;
6820 18816         24597 $sinip= $sinim;
6821 18816         24308 $cosip= $cosim;
6822 18816 100       35890 if ($parm->{deep_space}) {
6823 395         1355 $self->_r_dpper ($t, \$eccp, \$xincp, \$nodep, \$argpp, \$mp);
6824 395 100       915 if ($xincp < 0) {
6825 26         45 $xincp= -$xincp;
6826 26         48 $nodep= $nodep+ &SGP_PI;
6827 26         39 $argpp= $argpp- &SGP_PI;
6828             }
6829 395 50 33     1408 if ($eccp < 0 || $eccp > 1) {
6830 0         0 $self->{model_error}= &SGP4R_ERROR_3;
6831 0         0 croak "Error - OID $oid ", &SGP4R_ERROR_INST_ECCEN;
6832             }
6833              
6834             }
6835             #* ------------------------ LONG PERIOD PERIODICS ----------------------
6836 18816 100       33241 if ($parm->{deep_space}) {
6837 395         580 $sinip= sin($xincp);
6838 395         557 $cosip= cos($xincp);
6839 395         718 $parm->{aycof}= -0.5*$parm->{j3oj2}*$sinip;
6840             #c sgp4fix for divide by zero with xincp = 180 deg
6841 395 50       843 if (abs($cosip+1) > 1.5e-12) {
6842 395         927 $parm->{xlcof}= -0.25*$parm->{j3oj2}*$sinip*
6843             (3+5*$cosip)/(1+$cosip);
6844             } else {
6845 0         0 $parm->{xlcof}= -0.25*$parm->{j3oj2}*$sinip*
6846             (3+5*$cosip)/$temp4;
6847             }
6848             }
6849 18816         28291 $axnl= $eccp*cos($argpp);
6850 18816         30497 $temp= 1 / ($am*(1-$eccp*$eccp));
6851 18816         31873 $aynl= $eccp*sin($argpp) + $temp*$parm->{aycof};
6852              
6853 18816         30819 $xl= $mp+ $argpp+ $nodep+ $temp*$parm->{xlcof}*$axnl;
6854             #* ------------------------- SOLVE KEPLER'S EQUATION -------------------
6855 18816         40866 $u= fmod($xl-$nodep, &SGP_TWOPI);
6856 18816         26450 $eo1= $u;
6857 18816         23285 $iter=0;
6858             #c sgp4fix for kepler iteration
6859             #c the following iteration needs better limits on corrections
6860 18816         25194 $temp= 9999.9;
6861 18816   66     57674 while (($temp >= 1e-12) && ($iter < 10)) {
6862 56901         72143 $iter=$iter+1;
6863 56901         76764 $sineo1= sin($eo1);
6864 56901         73866 $coseo1= cos($eo1);
6865 56901         82935 $tem5= 1 - $coseo1*$axnl- $sineo1*$aynl;
6866 56901         88489 $tem5= ($u- $aynl*$coseo1+ $axnl*$sineo1- $eo1) / $tem5;
6867 56901         72477 $temp= abs($tem5);
6868 56901 100       98394 if ($temp > 1) {
6869 27         43 $tem5=$tem5/$temp
6870             }
6871 56901         142866 $eo1= $eo1+$tem5;
6872              
6873             }
6874             #* ----------------- SHORT PERIOD PRELIMINARY QUANTITIES ---------------
6875 18816         27589 $ecose= $axnl*$coseo1+$aynl*$sineo1;
6876 18816         26827 $esine= $axnl*$sineo1-$aynl*$coseo1;
6877 18816         26217 $el2= $axnl*$axnl+$aynl*$aynl;
6878 18816         26138 $pl= $am*(1-$el2);
6879             #c semi-latus rectum < 0.0
6880 18816 50       34762 if ( $pl < 0 ) {
6881 0         0 $self->{model_error}= &SGP4R_ERROR_4;
6882 0         0 croak "Error - OID $oid ", &SGP4R_ERROR_LATUSRECTUM;
6883             } else {
6884 18816         25832 $rl= $am*(1-$ecose);
6885 18816         27885 $rdotl= sqrt($am)*$esine/$rl;
6886 18816         25106 $rvdotl= sqrt($pl)/$rl;
6887 18816         24971 $betal= sqrt(1-$el2);
6888 18816         26651 $temp= $esine/(1+$betal);
6889 18816         28829 $sinu= $am/$rl*($sineo1-$aynl-$axnl*$temp);
6890 18816         29618 $cosu= $am/$rl*($coseo1-$axnl+$aynl*$temp);
6891 18816         39948 $su= atan2($sinu, $cosu);
6892 18816         27837 $sin2u= ($cosu+$cosu)*$sinu;
6893 18816         28520 $cos2u= 1-2*$sinu*$sinu;
6894 18816         25700 $temp= 1/$pl;
6895 18816         27856 $temp1= 0.5*$parm->{j2}*$temp;
6896              
6897 18816         24527 $temp2= $temp1*$temp;
6898             #* ------------------ UPDATE FOR SHORT PERIOD PERIODICS ----------------
6899 18816 100       33408 if ($parm->{deep_space}) {
6900 395         594 $cosisq= $cosip*$cosip;
6901 395         703 $parm->{con41}= 3*$cosisq- 1;
6902 395         669 $parm->{x1mth2}= 1 - $cosisq;
6903 395         630 $parm->{x7thm1}= 7*$cosisq- 1;
6904             }
6905             $mr= $rl*(1 - 1.5*$temp2*$betal*$parm->{con41}) +
6906 18816         39605 0.5*$temp1*$parm->{x1mth2}*$cos2u;
6907 18816         28296 $su= $su- 0.25*$temp2*$parm->{x7thm1}*$sin2u;
6908 18816         27563 $xnode= $nodep+ 1.5*$temp2*$cosip*$sin2u;
6909 18816         26927 $xinc= $xincp+ 1.5*$temp2*$cosip*$sinip*$cos2u;
6910 18816         31043 $mv= $rdotl- $xn*$temp1*$parm->{x1mth2}*$sin2u/ $parm->{xke};
6911              
6912             $rvdot= $rvdotl+ $xn*$temp1*
6913 18816         34429 ($parm->{x1mth2}*$cos2u+1.5*$parm->{con41}) / $parm->{xke};
6914             #* ------------------------- ORIENTATION VECTORS -----------------------
6915 18816         27769 $sinsu= sin($su);
6916 18816         27930 $cossu= cos($su);
6917 18816         27521 $snod= sin($xnode);
6918 18816         24757 $cnod= cos($xnode);
6919 18816         23708 $sini= sin($xinc);
6920 18816         26845 $cosi= cos($xinc);
6921 18816         27926 $xmx= -$snod*$cosi;
6922 18816         27580 $xmy= $cnod*$cosi;
6923 18816         31517 $ux= $xmx*$sinsu+ $cnod*$cossu;
6924 18816         26401 $uy= $xmy*$sinsu+ $snod*$cossu;
6925 18816         24247 $uz= $sini*$sinsu;
6926 18816         25126 $vx= $xmx*$cossu- $cnod*$sinsu;
6927 18816         27105 $vy= $xmy*$cossu- $snod*$sinsu;
6928              
6929 18816         24565 $vz= $sini*$cossu;
6930             #* ----------------------- POSITION AND VELOCITY -----------------------
6931 18816         33416 $r[1] = $mr*$ux* $parm->{radiusearthkm};
6932 18816         30024 $r[2] = $mr*$uy* $parm->{radiusearthkm};
6933 18816         28877 $r[3] = $mr*$uz* $parm->{radiusearthkm};
6934 18816         29052 $v[1] = ($mv*$ux+ $rvdot*$vx) * $vkmpersec;
6935 18816         27797 $v[2] = ($mv*$uy+ $rvdot*$vy) * $vkmpersec;
6936 18816         30016 $v[3] = ($mv*$uz+ $rvdot*$vz) * $vkmpersec;
6937              
6938             }
6939             #* --------------------------- ERROR PROCESSING ------------------------
6940             #c sgp4fix for decaying satellites
6941 18816 50       36185 if ($mr < 1) {
6942             #c write(*,*) '# decay condition ',mr
6943 0         0 $self->{model_error}= &SGP4R_ERROR_6;
6944              
6945             }
6946             #c INCLUDE 'debug7.for'
6947              
6948             #>>>>trw RETURN
6949              
6950 18816         66207 $self->__universal( $time );
6951 18816         68676 $self->eci (@r[1..3], @v[1..3]);
6952 18816         57264 $self->equinox_dynamical ($self->{epoch_dynamical});
6953 18816         45490 return $self;
6954             }
6955              
6956             =begin comment
6957              
6958             The following code was converted from the Fortran reference
6959             implementation, but is not used by this code.
6960              
6961             #* -----------------------------------------------------------------------------
6962             #*
6963             #* FUNCTION GSTIME
6964             #*
6965             #* This function finds the Greenwich SIDEREAL time. Notice just the INTEGER
6966             #* part of the Julian Date is used for the Julian centuries calculation.
6967             #* We use radper Solar day because we're multiplying by 0-24 solar hours.
6968             #*
6969             #* Author : David Vallado 719-573-2600 1 Mar 2001
6970             #*
6971             #* Inputs Description Range / Units
6972             #* JD - Julian Date days from 4713 BC
6973             #*
6974             #* OutPuts :
6975             #* GSTIME - Greenwich SIDEREAL Time 0 to 2Pi rad
6976             #*
6977             #* Locals :
6978             #* Temp - Temporary variable for reals rad
6979             #* TUT1 - Julian Centuries from the
6980             #* Jan 1, 2000 12 h epoch (UT1)
6981             #*
6982             #* Coupling :
6983             #*
6984             #* References :
6985             #* Vallado 2007, 194, Eq 3-45
6986             #* -----------------------------------------------------------------------------
6987              
6988             sub _r_gstime {
6989             my ($jd) = @_;
6990             my $gstime;
6991             #* ---------------------------- Locals -------------------------------
6992              
6993             my ($temp, $tut1);
6994             #>>>>trw INCLUDE 'astmath.cmn'
6995              
6996             $tut1= ( $$jd- 2451545 ) / 36525;
6997             $temp= - 6.2e-06*$tut1*$tut1*$tut1+ 0.093104*$tut1*$tut1+
6998             (876600*3600 + 8640184.812866)*$tut1+ 67310.54841;
6999              
7000             $temp= fmod($temp*&SGP_DE2RA/240, &SGP_TWOPI);
7001             if ( $temp < 0 ) {
7002             $temp= $temp+ &SGP_TWOPI;
7003              
7004             }
7005              
7006             $gstime= $temp;
7007             return $gstime;
7008             }
7009              
7010             =end comment
7011              
7012             =cut
7013              
7014             #* -----------------------------------------------------------------------------
7015             #*
7016             #* function getgravconst
7017             #*
7018             #* this function gets constants for the propagator. note that mu is identified to
7019             #* facilitiate comparisons with newer models.
7020             #*
7021             #* author : david vallado 719-573-2600 21 jul 2006
7022             #*
7023             #* inputs :
7024             #* whichconst - which set of constants to use 721, 72, 84
7025             #*
7026             #* outputs :
7027             #* tumin - minutes in one time unit
7028             #* mu - earth gravitational parameter
7029             #* radiusearthkm - radius of the earth in km
7030             #* xke - reciprocal of tumin
7031             #* j2, j3, j4 - un-normalized zonal harmonic values
7032             #* j3oj2 - j3 divided by j2
7033             #*
7034             #* locals :
7035             #*
7036             #* coupling :
7037             #*
7038             #* references :
7039             #* norad spacetrack report #3
7040             #* vallado, crawford, hujsak, kelso 2006
7041             #* ----------------------------------------------------------------------------
7042              
7043             sub _r_getgravconst {
7044 35     35   86 my ($self) = @_;
7045             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
7046 35 50       173 or confess "Programming error - Sgp4r not initialized";
7047              
7048 35 50       109 if ($self->{gravconst_r} == 721) {
7049 0         0 $parm->{radiusearthkm}= 6378.135;
7050 0         0 $parm->{xke}= 0.0743669161;
7051 0         0 $parm->{mu}= 398600.79964;
7052 0         0 $parm->{tumin}= 1 / $parm->{xke};
7053 0         0 $parm->{j2}= 0.001082616;
7054 0         0 $parm->{j3}= -2.53881e-06;
7055 0         0 $parm->{j4}= -1.65597e-06;
7056 0         0 $parm->{j3oj2}= $parm->{j3}/ $parm->{j2};
7057             }
7058              
7059 35 50       90 if ($self->{gravconst_r} == 72) {
7060 35         77 $parm->{mu}= 398600.8;
7061 35         63 $parm->{radiusearthkm}= 6378.135;
7062 35         187 $parm->{xke}= 60 / sqrt($parm->{radiusearthkm}**3/$parm->{mu});
7063 35         80 $parm->{tumin}= 1 / $parm->{xke};
7064 35         62 $parm->{j2}= 0.001082616;
7065 35         72 $parm->{j3}= -2.53881e-06;
7066 35         90 $parm->{j4}= -1.65597e-06;
7067 35         131 $parm->{j3oj2}= $parm->{j3}/ $parm->{j2};
7068             }
7069              
7070 35 50       112 if ($self->{gravconst_r} == 84) {
7071 0         0 $parm->{mu}= 398600.5;
7072 0         0 $parm->{radiusearthkm}= 6378.137;
7073 0         0 $parm->{xke}= 60 / sqrt($parm->{radiusearthkm}**3/$parm->{mu});
7074 0         0 $parm->{tumin}= 1 / $parm->{xke};
7075 0         0 $parm->{j2}= 0.00108262998905;
7076 0         0 $parm->{j3}= -2.53215306e-06;
7077 0         0 $parm->{j4}= -1.61098761e-06;
7078 0         0 $parm->{j3oj2}= $parm->{j3}/ $parm->{j2};
7079              
7080             }
7081 35         67 return;
7082             }
7083              
7084             ##### end of sgp4unit.for
7085              
7086             =begin comment
7087              
7088             # Used for debugging
7089              
7090             sub _r_dump {
7091             my $self = shift;
7092             no warnings qw{uninitialized};
7093             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
7094             or confess "Programming error - Sgp4r not initialized";
7095             my $fh = IO::File->new('perldump.out', '>>')
7096             or croak "Failed to open perldump.out: $!";
7097             print $fh ' ========== sgp4r initialization', "\n";
7098             print $fh ' SatNum = ', $self->get ('id'), "\n";
7099             print $fh ' ...', "\n";
7100             print $fh ' Bstar = ', $self->{bstardrag}, "\n";
7101             print $fh ' Ecco = ', $parm->{eccentricity}, "\n";
7102             print $fh ' Inclo = ', $parm->{inclination}, "\n";
7103             print $fh ' nodeo = ', $parm->{ascendingnode}, "\n";
7104             print $fh ' Argpo = ', $parm->{argumentofperigee}, "\n";
7105             print $fh ' No = ', $parm->{meanmotion}, "\n";
7106             print $fh ' Mo = ', $parm->{meananomaly}, "\n";
7107             print $fh ' NDot = ', '????', "\n";
7108             print $fh ' NDDot = ', '????', "\n";
7109             print $fh ' alta = ', 'not computed; unused?', "\n";
7110             print $fh ' altp = ', 'not computed; unused?', "\n";
7111             print $fh ' a = ', 'not computed; unused?', "\n";
7112             print $fh ' ...', "\n";
7113             print $fh ' ----', "\n";
7114             print $fh ' Aycof = ', $parm->{aycof}, "\n";
7115             print $fh ' CON41 = ', $parm->{con41}, "\n";
7116             print $fh ' Cc1 = ', $parm->{cc1}, "\n";
7117             print $fh ' Cc4 = ', $parm->{cc4}, "\n";
7118             print $fh ' Cc5 = ', $parm->{cc5}, "\n";
7119             print $fh ' D2 = ', $parm->{d2}, "\n";
7120             print $fh ' D3 = ', $parm->{d3}, "\n";
7121             print $fh ' D4 = ', $parm->{d4}, "\n";
7122             print $fh ' Delmo = ', $parm->{delmo}, "\n";
7123             print $fh ' Eta = ', $parm->{eta}, "\n";
7124             print $fh ' ArgpDot = ', $parm->{argpdot}, "\n";
7125             print $fh ' Omgcof = ', $parm->{omgcof}, "\n";
7126             print $fh ' Sinmao = ', $parm->{sinmao}, "\n";
7127             print $fh ' T2cof = ', $parm->{t2cof}, "\n";
7128             print $fh ' T3cof = ', $parm->{t3cof}, "\n";
7129             print $fh ' T4cof = ', $parm->{t4cof}, "\n";
7130             print $fh ' T5cof = ', $parm->{t5cof}, "\n";
7131             print $fh ' X1mth2 = ', $parm->{x1mth2}, "\n";
7132             print $fh ' MDot = ', $parm->{mdot}, "\n";
7133             print $fh ' nodeDot = ', $parm->{nodedot}, "\n";
7134             print $fh ' Xlcof = ', $parm->{xlcof}, "\n";
7135             print $fh ' Xmcof = ', $parm->{xmcof}, "\n";
7136             print $fh ' Xnodcf = ', $parm->{xnodcf}, "\n";
7137             print $fh ' ----', "\n";
7138             print $fh ' D2201 = ', $parm->{d2201}, "\n";
7139             print $fh ' D2211 = ', $parm->{d2211}, "\n";
7140             print $fh ' D3210 = ', $parm->{d3210}, "\n";
7141             print $fh ' D3222 = ', $parm->{d3222}, "\n";
7142             print $fh ' D4410 = ', $parm->{d4410}, "\n";
7143             print $fh ' D4422 = ', $parm->{d4422}, "\n";
7144             print $fh ' D5220 = ', $parm->{d5220}, "\n";
7145             print $fh ' D5232 = ', $parm->{d5232}, "\n";
7146             print $fh ' D5421 = ', $parm->{d5421}, "\n";
7147             print $fh ' D5433 = ', $parm->{d5433}, "\n";
7148             print $fh ' Dedt = ', $parm->{dedt}, "\n";
7149             print $fh ' Del1 = ', $parm->{del1}, "\n";
7150             print $fh ' Del2 = ', $parm->{del2}, "\n";
7151             print $fh ' Del3 = ', $parm->{del3}, "\n";
7152             print $fh ' Didt = ', $parm->{didt}, "\n";
7153             print $fh ' Dmdt = ', $parm->{dmdt}, "\n";
7154             print $fh ' Dnodt = ', $parm->{dnodt}, "\n";
7155             print $fh ' Domdt = ', $parm->{domdt}, "\n";
7156             print $fh ' E3 = ', $parm->{e3}, "\n";
7157             print $fh ' Ee2 = ', $parm->{ee2}, "\n";
7158             print $fh ' Peo = ', $parm->{peo}, "\n";
7159             print $fh ' Pgho = ', $parm->{pgho}, "\n";
7160             print $fh ' Pho = ', $parm->{pho}, "\n";
7161             print $fh ' Pinco = ', $parm->{pinco}, "\n";
7162             print $fh ' Plo = ', $parm->{plo}, "\n";
7163             print $fh ' Se2 = ', $parm->{se2}, "\n";
7164             print $fh ' Se3 = ', $parm->{se3}, "\n";
7165             print $fh ' Sgh2 = ', $parm->{sgh2}, "\n";
7166             print $fh ' Sgh3 = ', $parm->{sgh3}, "\n";
7167             print $fh ' Sgh4 = ', $parm->{sgh4}, "\n";
7168             print $fh ' Sh2 = ', $parm->{sh2}, "\n";
7169             print $fh ' Sh3 = ', $parm->{sh3}, "\n";
7170             print $fh ' Si2 = ', $parm->{si2}, "\n";
7171             print $fh ' Si3 = ', $parm->{si3}, "\n";
7172             print $fh ' Sl2 = ', $parm->{sl2}, "\n";
7173             print $fh ' Sl3 = ', $parm->{sl3}, "\n";
7174             print $fh ' Sl4 = ', $parm->{sl4}, "\n";
7175             print $fh ' GSTo = ', $parm->{gsto}, "\n";
7176             print $fh ' Xfact = ', $parm->{xfact}, "\n";
7177             print $fh ' Xgh2 = ', $parm->{xgh2}, "\n";
7178             print $fh ' Xgh3 = ', $parm->{xgh3}, "\n";
7179             print $fh ' Xgh4 = ', $parm->{xgh4}, "\n";
7180             print $fh ' Xh2 = ', $parm->{xh2}, "\n";
7181             print $fh ' Xh3 = ', $parm->{xh3}, "\n";
7182             print $fh ' Xi2 = ', $parm->{xi2}, "\n";
7183             print $fh ' Xi3 = ', $parm->{xi3}, "\n";
7184             print $fh ' Xl2 = ', $parm->{xl2}, "\n";
7185             print $fh ' Xl3 = ', $parm->{xl3}, "\n";
7186             print $fh ' Xl4 = ', $parm->{xl4}, "\n";
7187             print $fh ' Xlamo = ', $parm->{xlamo}, "\n";
7188             print $fh ' Zmol = ', $parm->{zmol}, "\n";
7189             print $fh ' Zmos = ', $parm->{zmos}, "\n";
7190             print $fh ' Atime = ', $parm->{atime}, "\n";
7191             print $fh ' Xli = ', $parm->{xli}, "\n";
7192             print $fh ' Xni = ', $parm->{xni}, "\n";
7193             print $fh ' IRez = ', $parm->{irez}, "\n";
7194             print $fh ' Isimp = ', $parm->{isimp}, "\n";
7195             print $fh ' Init = ', $parm->{init}, "\n";
7196             print $fh ' Method = ', ($parm->{deep_space} ? 'd' : 'n'), "\n";
7197             return;
7198             }
7199              
7200             =end comment
7201              
7202             =cut
7203              
7204             # Elevation of the illuminating body as seen from the satellite at the
7205             # given time.
7206             sub __sun_elev_from_sat {
7207 917     917   1761 my ( $self, $time ) = @_;
7208 917 100       1672 if ( defined $time ) {
7209 916         2362 $self->universal( $time );
7210             } else {
7211 1         5 $time = $self->universal();
7212             }
7213 917         2652 return ( $self->azel_offset(
7214             $self->get( 'illum' )->universal( $time ),
7215             $self->get( 'edge_of_earths_shadow' ),
7216             ) )[1] - $self->dip();
7217             }
7218              
7219             =item $text = $tle->tle_verbose(...);
7220              
7221             This method returns a verbose version of the TLE data, with one data
7222             field per line, labeled. The optional arguments are key-value pairs
7223             affecting the formatting of the output. The only key implemented at the
7224             moment is
7225              
7226             date_format
7227             specifies the strftime() format used for dates
7228             (default: '%d-%b-%Y %H:%M:%S').
7229              
7230             =cut
7231              
7232             sub tle_verbose {
7233 0     0 1 0 my ($self, %args) = @_;
7234 0   0     0 my $dtfmt = $args{date_format} || '%d-%b-%Y %H:%M:%S';
7235 0         0 my $epoch = __format_epoch_time_usec( $self->get( 'epoch' ), $dtfmt );
7236 0         0 my $semimajor = $self->get('semimajor'); # Of reference ellipsoid.
7237              
7238 0         0 my $result = <
7239 0         0 NORAD ID: @{[$self->get ('id')]}
7240 0   0     0 Name: @{[$self->get ('name') || 'unspecified']}
7241 0         0 International launch designator: @{[$self->get ('international')]}
7242             Epoch of data: $epoch GMT
7243             EOD
7244 0 0       0 if (defined (my $effective = $self->get('effective'))) {
7245 0         0 $result .= <
7246 0         0 Effective date: @{[strftime $dtfmt, gmtime $effective]} GMT
7247             EOD
7248             }
7249 0         0 $result .= <
7250 0         0 Classification status: @{[$self->get ('classification')]}
7251 0         0 Mean motion: @{[rad2deg ($self->get ('meanmotion'))]} degrees/minute
7252 0         0 First derivative of motion: @{[rad2deg ($self->get ('firstderivative'))]} degrees/minute squared
7253 0         0 Second derivative of motion: @{[rad2deg ($self->get ('secondderivative'))]} degrees/minute cubed
7254 0         0 B Star drag term: @{[$self->get ('bstardrag')]}
7255 0         0 Ephemeris type: @{[$self->get ('ephemeristype')]}
7256 0         0 Inclination of orbit: @{[rad2deg ($self->get ('inclination'))]} degrees
7257 0         0 Right ascension of ascending node: @{[rad2deg ($self->get ('ascendingnode'))]} degrees
7258 0         0 Eccentricity: @{[$self->get ('eccentricity')]}
7259 0         0 Argument of perigee: @{[rad2deg ($self->get ('argumentofperigee'))]} degrees from ascending node
7260 0         0 Mean anomaly: @{[rad2deg ($self->get ('meananomaly'))]} degrees
7261 0         0 Element set number: @{[$self->get ('elementnumber')]}
7262 0         0 Revolutions at epoch: @{[$self->get ('revolutionsatepoch')]}
7263 0         0 Period (derived): @{[$self->period()]} seconds
7264 0         0 Semimajor axis (derived): @{[$self->semimajor()]} kilometers
7265 0         0 Altitude at perigee (derived): @{[$self->periapsis() - $semimajor]} kilometers
7266 0         0 Altitude at apogee (derived): @{[$self->apoapsis() - $semimajor]} kilometers
7267             EOD
7268 0         0 return $result;
7269             }
7270              
7271             =item $hash_ref = $tle->TO_JSON();
7272              
7273             Despite its name, this method B convert the object to JSON.
7274             What it does instead is to return a reference to a hash that the
7275             L class will use to encode the object into JSON. The possible
7276             keys are, to the extent possible, those used by the Space Track REST
7277             interface.
7278              
7279             In order to get L to use this hook you need to instantiate a
7280             L object and turn on the conversion of blessed objects, like
7281             so:
7282              
7283             my $json = JSON->new()->convert_blessed( 1 );
7284             print $json->encode( $tle );
7285              
7286             The returned keys are a mish-mash of the keys returned by the Space
7287             Track C and C classes, plus others that are not maintained
7288             by Space Track. Since the Space Track keys are all upper case, I have
7289             made the non-Space Track keys all lower case.
7290              
7291             At this point I am not going to document the keys returned by this
7292             method, but they are generally self-explanatory. I find the most cryptic
7293             one is C<{INTLDES}>, which is the International Launch Designator,
7294             encoded with a four-digit year.
7295              
7296             =cut
7297              
7298             {
7299              
7300             my %json_map = (
7301             ARG_OF_PERICENTER => sub {
7302             my ( $self ) = @_;
7303             return rad2deg( $self->get( 'argumentofperigee' ) );
7304             },
7305             BSTAR => 'bstardrag',
7306             CLASSIFICATION_TYPE => 'classification',
7307             COMMENT => sub {
7308             return 'Generated by ' . __PACKAGE__ . ' v' . $VERSION;
7309             },
7310             CREATION_DATE => sub {
7311             return format_space_track_json_time( time );
7312             },
7313             ECCENTRICITY => 'eccentricity',
7314             ELEMENT_SET_NO => 'elementnumber',
7315             EPHEMERIS_TYPE => 'ephemeristype',
7316             EPOCH => sub {
7317             my ( $self ) = @_;
7318             return format_space_track_json_time( $self->get( 'epoch' ) );
7319             },
7320             EPOCH_MICROSECONDS => sub {
7321             my ( $self ) = @_;
7322             my $epoch = sprintf '%.6f', $self->get( 'epoch' );
7323             $epoch =~ s/ [^.]* [.] //smx;
7324             return $epoch;
7325             },
7326             FILE => 'file',
7327             INCLINATION => sub {
7328             my ( $self ) = @_;
7329             return rad2deg( $self->get( 'inclination' ) );
7330             },
7331             INTLDES => sub {
7332             my ( $self ) = @_;
7333             my $year = $self->get( 'launch_year' );
7334             my $num = $self->get( 'launch_num' );
7335             my $part = $self->get( 'launch_piece' );
7336             # As of August 27 2012, this is no longer yyyy-lllp, it is
7337             # yylllp, same as it has always been in the TLE format.
7338             $year %= 100;
7339             foreach ( $year, $num, $part ) {
7340             defined $_
7341             and $_ =~ m/ \S /smx
7342             or return;
7343             }
7344             return sprintf '%02d%03d%s', $year, $num, $part; # ditto
7345             },
7346             LAUNCH_NUM => 'launch_num',
7347             LAUNCH_PIECE => 'launch_piece',
7348             LAUNCH_YEAR => 'launch_year',
7349             MEAN_ANOMALY => sub {
7350             my ( $self ) = @_;
7351             return rad2deg( $self->get( 'meananomaly' ) );
7352             },
7353             MEAN_MOTION => sub {
7354             my ( $self ) = @_;
7355             return $self->get( 'meanmotion' ) * SGP_XMNPDA / TWOPI;
7356             },
7357             MEAN_MOTION_DDOT => sub {
7358             my ( $self ) = @_;
7359             return $self->get(
7360             'secondderivative'
7361             ) * SGP_XMNPDA * SGP_XMNPDA * SGP_XMNPDA / TWOPI;
7362             },
7363             MEAN_MOTION_DOT => sub {
7364             my ( $self ) = @_;
7365             return $self->get(
7366             'firstderivative'
7367             ) * SGP_XMNPDA * SGP_XMNPDA / TWOPI;
7368             },
7369             NORAD_CAT_ID => 'id',
7370             OBJECT_ID => sub {
7371             my ( $self ) = @_;
7372             my $year = $self->get( 'launch_year' );
7373             my $num = $self->get( 'launch_num' );
7374             my $part = $self->get( 'launch_piece' );
7375             foreach ( $year, $num, $part ) {
7376             defined $_
7377             and $_ =~ m/ \S /smx
7378             or return;
7379             }
7380             return sprintf '%04d-%03d%s', $year, $num, $part;
7381             },
7382             OBJECT_NAME => 'name',
7383             OBJECT_NUMBER => 'id',
7384             OBJECT_TYPE => sub {
7385             my ( $self ) = @_;
7386             return uc $self->body_type();
7387             },
7388             ORDINAL => 'ordinal',
7389             ORIGINATOR => 'originator',
7390             RA_OF_ASC_NODE => sub {
7391             my ( $self ) = @_;
7392             return rad2deg( $self->get( 'ascendingnode' ) );
7393             },
7394             RCSVALUE => 'rcs',
7395             REV_AT_EPOCH => 'revolutionsatepoch',
7396             # TLE_LINE0 => sub {
7397             # my ( $self ) = @_;
7398             # my $name = $self->get( 'name' );
7399             # defined $name
7400             # and $name = "0 $name";
7401             # return $name;
7402             # },
7403             # TLE_LINE0 is handled programmatically
7404             # TLE_LINE1 is handled programmatically
7405             # TLE_LINE2 is handled programmatically
7406             effective_date => sub {
7407             my ( $self ) = @_;
7408             return format_space_track_json_time( $self->get( 'effective' ) );
7409             },
7410             intrinsic_magnitude => 'intrinsic_magnitude',
7411             );
7412              
7413             # This guy is to be used by subclasses so they don't have to
7414             # implement their own converter. The arguments (after the invocant)
7415             # are a reference to the mapping hash and an optional reference to
7416             # a hash to populate. The return is a hash reference, which will be
7417             # the one provided if there _was_ one provided.
7418              
7419             # The mapping hash's keys are the keys to be provided in the output.
7420             # The values are either the Astro::Coord::ECI::TLE attributes
7421             # corresponding to those keys, or a code reference which computes
7422             # the value. If a code reference, it is called with the invocant and
7423             # the JSON key. No matter where they come from, values which are
7424             # undef or '' will not appear in the output hash.
7425              
7426             sub __to_json {
7427 0     0   0 my ( $self, $mapping, $rslt ) = @_;
7428 0   0     0 $rslt ||= {};
7429              
7430 0         0 foreach my $key ( keys %{ $mapping } ) {
  0         0  
7431 0         0 my $map = $mapping->{$key};
7432 0 0       0 my $val = CODE_REF eq ref $map ?
7433             $map->( $self, $key ) :
7434             $self->get( $map );
7435             defined $val
7436             and $val ne ''
7437 0 0 0     0 and $rslt->{$key} = $val;
7438             }
7439              
7440 0 0       0 if ( defined ( my $tle = $self->get( 'tle' ) ) ) {
7441 0         0 chomp $tle;
7442 0         0 my @lines = split "\n", $tle;
7443 0         0 unshift @lines, '' while @lines < 3;
7444 0         0 foreach my $line ( 1 .. 2 ) {
7445             defined $lines[$line]
7446             and $lines[$line] =~ m/ \S /smx
7447 0 0 0     0 and $rslt->{"TLE_LINE$line"} = $lines[$line];
7448             }
7449 0 0       0 if ( defined( my $name = $self->get( 'name' ) ) ) {
7450 0         0 $rslt->{TLE_LINE0} = "0 $name";
7451             }
7452             }
7453              
7454 0         0 return $rslt;
7455             }
7456              
7457             sub TO_JSON {
7458 0     0 1 0 my ( $self ) = @_;
7459 0         0 return $self->__to_json( \%json_map );
7460             }
7461              
7462             }
7463              
7464             {
7465             my $have_json;
7466             my @required = qw{
7467             NORAD_CAT_ID
7468             EPOCH
7469             MEAN_MOTION
7470             ECCENTRICITY
7471             INCLINATION
7472             RA_OF_ASC_NODE
7473             ARG_OF_PERICENTER
7474             MEAN_ANOMALY
7475             EPHEMERIS_TYPE
7476             CLASSIFICATION_TYPE
7477             ELEMENT_SET_NO
7478             REV_AT_EPOCH
7479             BSTAR
7480             MEAN_MOTION_DOT
7481             MEAN_MOTION_DDOT
7482             };
7483             my %json_map = (
7484             # INTLDES => 'international',
7485             NORAD_CAT_ID => 'id',
7486             OBJECT_NAME => 'name',
7487             # OBJECT_ID => 'international',
7488             RCSVALUE => 'rcs',
7489             # LAUNCH_YEAR => 'launch_year',
7490             # LAUNCH_NUM => 'launch_num',
7491             # LAUNCH_PIECE => 'launch_piece',
7492             # COMMENT => sub {
7493             # return 'Generated by ' . __PACKAGE__ . ' v' . $VERSION;
7494             # },
7495             # CREATION_DATE => sub {
7496             # return format_space_track_json_time( time );
7497             # },
7498             EPOCH => 'epoch',
7499             FILE => 'file',
7500             MEAN_MOTION => 'meanmotion',
7501             ECCENTRICITY => 'eccentricity',
7502             INCLINATION => 'inclination',
7503             RA_OF_ASC_NODE => 'ascendingnode',
7504             ARG_OF_PERICENTER => 'argumentofperigee',
7505             MEAN_ANOMALY => 'meananomaly',
7506             EPHEMERIS_TYPE => 'ephemeristype',
7507             CLASSIFICATION_TYPE => 'classification',
7508             ELEMENT_SET_NO => 'elementnumber',
7509             REV_AT_EPOCH => 'revolutionsatepoch',
7510             BSTAR => 'bstardrag',
7511             MEAN_MOTION_DOT => 'firstderivative',
7512             MEAN_MOTION_DDOT => 'secondderivative',
7513             OBJECT_TYPE => 'object_type',
7514             ORDINAL => 'ordinal',
7515             ORIGINATOR => 'originator',
7516             effective_date => 'effective',
7517             intrinsic_magnitude => 'intrinsic_magnitude',
7518             );
7519              
7520             sub _decode_json_time {
7521 0     0   0 my ( $string ) = @_;
7522 0 0       0 $string =~ m{ \A \s*
7523             ( [0-9]+ ) [^0-9]+ ( [0-9]+ ) [^0-9]+ ( [0-9]+ ) [^0-9]+
7524             ( [0-9]+ ) [^0-9]+ ( [0-9]+ ) [^0-9]+ ( [0-9]+ )
7525             (?: ( [.] [0-9]* ) )?
7526             \s* \z }smx
7527             or return;
7528 0         0 my @time = ( $1, $2, $3, $4, $5, $6 );
7529 0         0 my $frac = $7;
7530 0         0 $time[0] = __tle_year_to_Gregorian_year( $time[0] );
7531 0         0 $time[1] -= 1;
7532 0         0 my $rslt = greg_time_gm( reverse @time );
7533 0 0 0     0 defined $frac
7534             and $frac ne '.'
7535             and $rslt += $frac;
7536 0         0 return $rslt;
7537             }
7538              
7539             sub _parse_json {
7540 0     0   0 my ( undef, @args ) = @_; # Invocant unused
7541             defined $have_json
7542 0 0       0 or $have_json = eval {
    0          
7543 0         0 require JSON;
7544 0         0 1;
7545             } ? 1 : 0;
7546 0 0       0 $have_json
7547             or croak 'Can not load JSON';
7548 0         0 my $json = JSON->new()->utf8( 1 );
7549 0 0       0 my $attrs = HASH_REF eq ref $args[0] ? shift @args : {};
7550 0         0 my @rslt;
7551              
7552 0         0 foreach my $arg ( @args ) {
7553 0         0 my $decode = $json->decode( $arg );
7554              
7555 0 0       0 foreach my $hash ( ARRAY_REF eq ref $decode ? @{ $decode } :
  0         0  
7556             $decode ) {
7557              
7558 0   0     0 my $class = $hash->{astro_coord_eci_class} || __PACKAGE__;
7559 0         0 load_module( $class );
7560 0         0 push @rslt, $class->__from_json( $hash, $attrs );
7561              
7562             }
7563             }
7564              
7565 0         0 return @rslt;
7566             }
7567              
7568             sub __from_json {
7569 0     0   0 my ( $class, $hash, $attrs ) = @_;
7570              
7571 0   0     0 $attrs ||= {};
7572              
7573 0 0       0 if ( exists $hash->{SATNAME} ) { # TODO Deprecated
7574 0 0       0 warnings::enabled( 'deprecated' )
7575             and croak 'The SATNAME JSON key is deprecated ',
7576             'in favor of the OBJECT_NAME key';
7577             exists $hash->{OBJECT_NAME}
7578 0 0       0 or $hash->{OBJECT_NAME} = $hash->{SATNAME};
7579 0         0 delete $hash->{SATNAME};
7580             }
7581              
7582 0         0 foreach my $key ( @required ) {
7583 0 0       0 defined $hash->{$key}
7584             or return;
7585             }
7586              
7587             defined $hash->{INTLDES}
7588             and $hash->{INTLDES} =~
7589 0 0       0 s/ \A [0-9]{2} ( [0-9]{2} ) - /$1/smx;
7590              
7591 0         0 foreach my $key ( qw{ EPOCH effective_date } ) {
7592             defined $hash->{$key}
7593 0 0       0 and $hash->{$key} = _decode_json_time( $hash->{$key} );
7594             }
7595             defined $hash->{EPOCH_MICROSECONDS}
7596             and $hash->{EPOCH} += $hash->{EPOCH_MICROSECONDS} /
7597 0 0       0 1_000_000;
7598              
7599 0         0 foreach my $key ( qw{
7600             ARG_OF_PERICENTER INCLINATION MEAN_ANOMALY
7601             RA_OF_ASC_NODE
7602             } ) {
7603 0         0 $hash->{$key} *= SGP_DE2RA;
7604             }
7605              
7606             {
7607 0         0 my $temp = SGP_TWOPI;
  0         0  
7608 0         0 foreach my $key ( qw{
7609             MEAN_MOTION MEAN_MOTION_DOT MEAN_MOTION_DDOT
7610             } ) {
7611 0         0 $temp /= SGP_XMNPDA;
7612 0         0 $hash->{$key} *= $temp;
7613             }
7614             }
7615              
7616 0         0 my %tle = %{ $attrs };
  0         0  
7617 0         0 foreach my $key ( keys %{ $hash } ) {
  0         0  
7618 0         0 my $value = $hash->{$key};
7619 0 0       0 my $attr = $json_map{$key}
7620             or next;
7621 0         0 $tle{$attr} = $value;
7622             }
7623              
7624 0         0 my $obj = $class->new( %tle );
7625              
7626 0         0 foreach my $key ( qw{ OBJECT_ID INTLDES } ) {
7627 0 0       0 defined $hash->{$key}
7628             or next;
7629 0         0 $obj->_set_intldes( international => $hash->{$key} );
7630 0         0 last;
7631             }
7632              
7633 0         0 return $obj;
7634             }
7635             }
7636              
7637             =item $valid = $tle->validate($options, $time ...);
7638              
7639             This method checks to see if the currently-selected model can be run
7640             successfully. If so, it returns 1; if not, it returns 0.
7641              
7642             The $options argument is itself optional. If passed, it is a reference
7643             to a hash of option names and values. At the moment the only option used
7644             is
7645              
7646             quiet => 1 to suppress output to STDERR.
7647              
7648             If the C option is not specified, or is specified as a false
7649             value, validation failures will produce output to STDERR.
7650              
7651             Each $time argument is adjusted by passing it through C<<
7652             $tle->max_effective_date >>, and the distinct adjusted times are sorted
7653             into ascending order. The currently-selected model is run at each of the
7654             times thus computed. The return is 0 if any run fails, or 1 if they all
7655             succeed.
7656              
7657             If there are no $time arguments, the model is run at the effective date
7658             if that is specified, or the epoch if the effective date is not
7659             specified.
7660              
7661             =cut
7662              
7663             sub validate {
7664 0     0 1 0 my ($self, @args) = @_;
7665 0 0       0 my $opt = HASH_REF eq ref $args[0] ? shift @args : {};
7666 0         0 my %args;
7667 0 0       0 if (@args) {
7668 0         0 %args = map { ( $self->max_effective_date( $_ ) => 1 ) } @args;
  0         0  
7669             } else {
7670 0   0     0 $args{$self->get('effective') || $self->get('epoch')} = 1;
7671             }
7672 0 0       0 eval {
7673 0         0 foreach my $time ( sort { $a <=> $b } keys %args ) {
  0         0  
7674 0         0 $self->universal( $time );
7675             }
7676 0         0 1;
7677             } and return 1;
7678 0 0 0     0 $opt->{quiet} or $@ and warn $@;
7679 0         0 return 0;
7680             }
7681              
7682             #######################################################################
7683              
7684             # _actan
7685              
7686             # This function wraps the atan2 function, and normalizes the
7687             # result to the range 0 < result < 2 * pi.
7688              
7689             sub _actan {
7690 29     29   107 my $rslt = atan2 ($_[0], $_[1]);
7691 29 100       70 $rslt < 0 and $rslt += SGP_TWOPI;
7692 29         56 return $rslt;
7693             }
7694              
7695             # _convert_out
7696              
7697             # Convert model results to kilometers and kilometers per second.
7698              
7699             sub _convert_out {
7700 25     25   62 my ($self, @args) = @_;
7701 25         42 $args[0] *= (SGP_XKMPER / SGP_AE); # x
7702 25         30 $args[1] *= (SGP_XKMPER / SGP_AE); # y
7703 25         33 $args[2] *= (SGP_XKMPER / SGP_AE); # z
7704 25         35 $args[3] *= (SGP_XKMPER / SGP_AE * SGP_XMNPDA / SECSPERDAY); # dx/dt
7705 25         29 $args[4] *= (SGP_XKMPER / SGP_AE * SGP_XMNPDA / SECSPERDAY); # dy/dt
7706 25         29 $args[5] *= (SGP_XKMPER / SGP_AE * SGP_XMNPDA / SECSPERDAY); # dz/dt
7707 25         101 $self->__universal( pop @args );
7708 25         85 $self->eci (@args);
7709              
7710 25         89 $self->equinox_dynamical ($self->{epoch_dynamical});
7711              
7712 25         101 return $self;
7713             }
7714              
7715             # Called by pass() to find the illumination. The arguments are the sun
7716             # object (or nothing), the time, and a reference to the pass information
7717             # hash. The return is either nothing (if $sun is not defined) or
7718             # ( illumination => $illum ).
7719             sub _find_illumination {
7720 42     42   100 my ( $sun, $when, $info ) = @_;
7721 42 100       121 $sun
7722             or return;
7723 39         95 my $illum = $info->[0]{illumination};
7724 39         73 foreach my $evt ( @{ $info } ) {
  39         88  
7725 96 100       212 $evt->{time} > $when
7726             and last;
7727 58         100 $illum = $evt->{illumination};
7728             }
7729 39         209 return ( illumination => $illum );
7730             }
7731              
7732             # Called by pass() to calculate azimuth, elevation, and range. The
7733             # arguments are the TLE object, the station object, and the time. If the
7734             # TLE's 'lazy_pass_position' attribute is true, nothing is returned.
7735             # Otherwise the azimuth, elevation, and range are calculated and
7736             # returned as three name/value pairs (i.e. a six-element list).
7737             sub _find_position {
7738 30     30   60 my ( $tle, $sta, $when ) = @_;
7739 30 100       89 $tle->get( 'lazy_pass_position' )
7740             and return;
7741 15         68 $tle->universal( $when );
7742 15         48 my ( $azimuth, $elevation, $range ) = $sta->azel( $tle );
7743             return (
7744 15         224 azimuth => $azimuth,
7745             elevation => $elevation,
7746             range => $range,
7747             );
7748             }
7749              
7750             # Initial value of the 'inertial' attribute. TLEs are assumed to be
7751             # inertial until set otherwise.
7752              
7753 64     64   229 sub __initial_inertial{ return 1 };
7754              
7755             # Unsupported, experimental, and subject to change or retraction without
7756             # notice. The intent is to provide a way for the Astro::App::Satpass2
7757             # 'list' command to pick an appropriate template to format each line of
7758             # the listing based on the object being listed.
7759             sub __list_type {
7760 3     3   6 my ( $self ) = @_;
7761 3 100       16 return $self->{inertial} ? 'inertial' : 'fixed';
7762             }
7763              
7764             # _looks_like_real
7765             #
7766             # This returns a boolean which is true if the input looks like a real
7767             # number and is false otherwise. It is based on looks_like_number, but
7768             # excludes things like NaN, and Inf.
7769             sub _looks_like_real {
7770 3     3   8 my ( $number ) = @_;
7771 3 50       10 looks_like_number( $number )
7772             or return;
7773 3 50       25 $number =~ m/ \A nan \z /smxi
7774             and return;
7775 3 50       17 $number =~ m/ \A [+-]? inf (?: inity )? \z /smxi
7776             and return;
7777 3         13 return 1;
7778             }
7779              
7780             # *equinox_dynamical = \&Astro::Coord::ECI::equinox_dynamical;
7781              
7782             # $text = $self->_make_tle();
7783             #
7784             # This method manufactures a TLE. It's a 'real' TLE if the 'name'
7785             # attribute is not set, and a 'NASA' TLE (i.e. the 'T' stands for
7786             # 'three') if the 'name' attribute is set. The output is intended
7787             # to be equivalent to the TLE (if any) that initialized the
7788             # object, not identical to it. This method is used to manufacture
7789             # a TLE in the case where $self->get('tle') was called but the
7790             # object was not initialized by the parse() method.
7791              
7792             {
7793              
7794             my %hack = (
7795             effective => sub {
7796             ## my ( $self, $name, $value ) = @_;
7797             my ( undef, undef, $value ) = @_; # Invocant & name unused
7798             my $whole = floor($value);
7799             my ($sec, $min, $hr, undef, undef, $year, undef, $yday) =
7800             gmtime $value;
7801             my $effective =
7802             sprintf '%04d/%03d/%02d:%02d:%06.3f',
7803             $year + 1900, $yday + 1, $hr, $min,
7804             $sec + ($value - $whole);
7805             $effective =~ s/ [.]? 0+ \z //smx;
7806             return ( '--effective', $effective );
7807             },
7808             rcs => sub {
7809             ## my ( $self, $name, $value ) = @_;
7810             my ( undef, undef, $value ) = @_; # Invocant & name unused
7811             return ( '--rcs', $value );
7812             },
7813             );
7814              
7815             my @required_fields = qw{
7816             firstderivative secondderivative bstardrag inclination
7817             ascendingnode eccentricity argumentofperigee meananomaly
7818             meanmotion revolutionsatepoch
7819             };
7820              
7821             sub _make_tle {
7822 0     0   0 my $self = shift;
7823 0         0 my $output;
7824              
7825 0         0 my $oid = $self->get('id');
7826 0         0 my $name = $self->get( 'name' );
7827 0         0 my @line0;
7828              
7829 0 0       0 if ( defined $name ) {
7830 0         0 $name =~ s/ \s+ \z //smx;
7831 0 0       0 $name ne ''
7832             and push @line0, substr $name, 0, 24;
7833             }
7834              
7835 0 0       0 if ( my $code = $self->can( '__encode_operational_status' ) ) {
7836 0         0 push @line0, sprintf '[%s]', $code->( $self, 'status' );
7837             }
7838              
7839 0         0 foreach my $name ( sort keys %hack ) {
7840 0 0       0 defined( my $value = $self->get( $name ) ) or next;
7841 0         0 push @line0, $hack{$name}->( $self, $name, $value );
7842             }
7843 0 0       0 @line0 and $output .= join (' ', @line0) . "\n";
7844              
7845 0         0 my %ele;
7846             {
7847 0         0 my @missing_fields;
  0         0  
7848 0         0 foreach ( @required_fields ) {
7849 0 0       0 defined( $ele{$_} = $self->get( $_ ) )
7850             and next;
7851 0         0 push @missing_fields, $_;
7852             }
7853              
7854 0 0       0 if ( @missing_fields ) {
7855             # If all required fields are missing we presume it is
7856             # deliberate, and return nothing.
7857 0 0       0 @required_fields == @missing_fields
7858             and return undef; ## no critic (ProhibitExplicitReturnUndef)
7859             # Otherwise we croak with an error
7860 0 0       0 croak 'Can not generate TLE for ',
7861             defined $oid ? $oid : $name,
7862             '; undefined attribute(s) ',
7863             join ', ', @missing_fields;
7864             }
7865 0         0 my $temp = SGP_TWOPI;
7866 0         0 foreach (qw{meanmotion firstderivative secondderivative}) {
7867 0         0 $temp /= SGP_XMNPDA;
7868 0         0 $ele{$_} /= $temp;
7869             }
7870 0         0 foreach (qw{ascendingnode argumentofperigee meananomaly
7871             inclination}) {
7872 0         0 $ele{$_} /= SGP_DE2RA;
7873             }
7874 0         0 foreach my $key (qw{eccentricity}) {
7875 0         0 local $_ = sprintf '%.7f', $ele{$key};
7876 0         0 s/.*?\.//;
7877 0         0 $ele{$key} = $_;
7878             }
7879 0         0 $ele{epoch} = $self->__make_tle_epoch();
7880             $ele{firstderivative} = sprintf (
7881 0         0 '%.8f', $ele{firstderivative});
7882 0         0 $ele{firstderivative} =~ s/([-+]?)[\s0]*\./$1./;
7883 0         0 foreach my $key (qw{secondderivative bstardrag}) {
7884 0 0       0 if ($ele{$key}) {
7885 0         0 local $_ = sprintf '%.4e', $ele{$key};
7886 0         0 s/\.//;
7887 0         0 my ($mantissa, $exponent) = split 'e', $_;
7888 0         0 $exponent++;
7889 0         0 $ele{$key} = sprintf '%s%+1d', $mantissa, $exponent;
7890             } else {
7891 0         0 $ele{$key} = '00000-0';
7892             }
7893             }
7894             }
7895             $output .= _make_tle_checksum ('1%6s%s %-8s %-14s %10s %8s %8s %s %4s',
7896             $oid, $self->get('classification'),
7897             $self->get('international'),
7898 0         0 ( map { $ele{$_} } qw{ epoch firstderivative
  0         0  
7899             secondderivative bstardrag} ),
7900             $self->get('ephemeristype'), $self->get('elementnumber'),
7901             );
7902             $output .= _make_tle_checksum ('2%6s%9.4f%9.4f %-7s%9.4f%9.4f%12.8f%5s',
7903 0         0 $oid, ( map { $ele{$_} } qw{ inclination ascendingnode
  0         0  
7904             eccentricity argumentofperigee meananomaly meanmotion
7905             revolutionsatepoch } ),
7906             );
7907 0         0 return $output;
7908             }
7909             }
7910              
7911             sub __make_tle_epoch {
7912 0     0   0 my ( $self ) = @_;
7913 0         0 my $epoch = $self->get('epoch');
7914 0         0 my $epoch_dayfrac = sprintf '%.8f', ($epoch / SECSPERDAY);
7915 0         0 $epoch_dayfrac =~ s/.*?\././;
7916 0         0 my $epoch_daynum = strftime '%y%j', gmtime ($epoch);
7917 0         0 return $epoch_daynum . $epoch_dayfrac;
7918             }
7919              
7920             # $output = _make_tle_checksum($fmt ...);
7921             #
7922             # This subroutine calls sprintf using the first argument as a
7923             # format and the rest as arguments. It then computes the TLE-style
7924             # checksum, appends it to the output, slaps a newline on the end
7925             # of the whole thing, and returns it.
7926              
7927             sub _make_tle_checksum {
7928 0     0   0 my ($fmt, @args) = @_;
7929 0         0 my $buffer = sprintf $fmt, @args;
7930 0         0 my $sum = 0;
7931 0         0 foreach (split '', $buffer) {
7932 0 0       0 if ($_ eq '-') {
    0          
7933 0         0 $sum++;
7934             } elsif ( m/ [0-9] /smx ) {
7935 0         0 $sum += $_;
7936             }
7937             }
7938 0         0 $sum = $sum % 10;
7939 0         0 return sprintf "%-68s%i\n", substr ($buffer, 0, 68), $sum;
7940             }
7941              
7942             # _normalize_oid
7943             #
7944             # Normalize an OID by expanding it to five digits.
7945              
7946             sub _normalize_oid {
7947 63     63   115 my ( $oid ) = @_;
7948 63 50       168 $oid =~ m/ [^0-9] /smx
7949             and return $oid;
7950 63         374 return sprintf '%05d', $oid;
7951             }
7952              
7953             # _set_illum
7954              
7955             # Setting the {illum} attribute is complex enough that the code
7956             # got pulled out into its own subroutine. As with all mutators,
7957             # the arguments are the object reference, the attribute name, and
7958             # the new value.
7959              
7960             __PACKAGE__->alias (sun => 'Astro::Coord::ECI::Sun');
7961             __PACKAGE__->alias (moon => 'Astro::Coord::ECI::Moon');
7962             sub _set_illum {
7963 108     108   258 my ($self, $name, $body) = @_;
7964 108 50       267 unless (ref $body) {
7965 108 50       345 $type_map{$body} and $body = $type_map{$body};
7966 108         313 load_module ($body);
7967             }
7968 108 50       287 embodies ($body, 'Astro::Coord::ECI') or croak <
7969             Error - The illuminating body must be an Astro::Coord::ECI, or a
7970             subclass thereof, or the words 'sun' or 'moon', which are
7971             handled as special cases. You tried to use a
7972 0   0     0 '@{[ref $body || $body]}'.
7973             eod
7974 108 50       424 ref $body or $body = $body->new ();
7975 108         246 $self->{$name} = $body;
7976 108         400 return 0;
7977             }
7978              
7979             sub _set_intldes {
7980 44     44   132 my ( $self, $name, $val ) = @_;
7981              
7982 44 100 66     224 if ( defined $val && $val =~ m/ \S /smx ) {
7983              
7984 31         127 my $working = $val;
7985              
7986 31         91 $working =~ s/ \s+ \z //smx;
7987 31         53 $working =~ s/ \s /0/smxg;
7988              
7989 31         136 foreach my $re (
7990             qr< ( [0-9]+ ) - ( [0-9]+ ) ( .+ ) >smx,
7991             qr< ( [0-9]{2} ) ( [0-9]{3} ) ( .+ ) >smx,
7992             ) {
7993 62 100       1568 $working =~ m/ \A $re \z /smx
7994             or next;
7995 30         143 my ( $year, $num, $piece ) = ( $1, $2, $3 );
7996              
7997 30 100       118 $year < 100
    50          
7998             and $year += $year < 57 ? 2000 : 1900;
7999              
8000 30         76 $self->{launch_year} = $year;
8001 30         96 $self->{launch_num} = $num;
8002 30         61 $self->{launch_piece} = $piece;
8003              
8004 30         151 $self->{$name} = sprintf '%02d%03d%s', $year % 100, $num, $piece;
8005              
8006 30         188 return 0;
8007             }
8008              
8009             }
8010              
8011             # We bypass the public interface to avoid thrashing
8012              
8013             $self->{launch_year} =
8014             $self->{launch_num} =
8015 14         57 $self->{launch_piece} = undef;
8016              
8017 14         51 $self->{$name} = $val;
8018              
8019 14         43 return 0;
8020             }
8021              
8022             {
8023             my %intldes_valid = (
8024             launch_year => sub {
8025             my ( $val ) = @_;
8026             $val =~ RE_ALL_DIGITS
8027             and $val <= 9999
8028             or croak 'Invalid launch_year';
8029             $val < 100
8030             and $val += $val < 57 ? 2000 : 1900;
8031             return $val + 0;
8032             },
8033             launch_num => sub {
8034             my ( $val ) = @_;
8035             $val =~ RE_ALL_DIGITS
8036             and $val < 1000
8037             or croak 'Invalid launch_num';
8038             return $val + 0;
8039             },
8040             launch_piece => sub {
8041             my ( $val ) = @_;
8042             $val =~ m/ \A [[:alpha:]]+ \z /smx
8043             or croak 'Invalid launch_piece';
8044             return uc $val;
8045             },
8046             );
8047              
8048             my $value_or_empty = sub {
8049             my ( $self, $name ) = @_;
8050             return defined $self->{$name} ? $self->{$name} : '';
8051             };
8052              
8053             sub _set_intldes_part {
8054 4     4   10 my ( $self, $name, $val ) = @_;
8055              
8056             $self->{$name} = defined $val ?
8057 4 100       16 $intldes_valid{$name}->( $val ) :
8058             $val;
8059              
8060 4         7 my %intldes;
8061 4         9 foreach my $key ( qw{ launch_year launch_num launch_piece } ) {
8062 12         24 $intldes{$key} = $value_or_empty->( $self, $key );
8063             }
8064             $intldes{launch_year} eq ''
8065 4 100       14 or $intldes{launch_year} %= 100;
8066              
8067             my $tplt = join '',
8068             ( $intldes{launch_year} eq '' ? '%2s' : '%02d' ),
8069 4 100       18 ( $intldes{launch_num} eq '' ? '%3s' : '%03d' ),
    100          
8070             '%s';
8071 4         8 $self->{international} = sprintf $tplt, map { $intldes{$_} }
  12         34  
8072             qw{ launch_year launch_num launch_piece };
8073              
8074 4         18 return 0;
8075             }
8076              
8077             }
8078              
8079             # _set_object_type
8080             #
8081             # This acts as a mutator for the object type.
8082             {
8083             my %name_to_type;
8084             my @number_to_type;
8085             foreach my $type (
8086             BODY_TYPE_UNKNOWN,
8087             BODY_TYPE_DEBRIS,
8088             BODY_TYPE_ROCKET_BODY,
8089             BODY_TYPE_PAYLOAD,
8090             ) {
8091             $number_to_type[$type] = $type;
8092             $name_to_type{ fold_case( $type ) } = $type;
8093             }
8094             sub _set_object_type {
8095 0     0   0 my ( $self, $name, $value ) = @_;
8096 0 0       0 if ( defined $value ) {
8097 0 0       0 if ( $value =~ RE_ALL_DIGITS ) {
8098 0         0 $self->{$name} = $number_to_type[$value];
8099             } else {
8100 0         0 $self->{$name} = $name_to_type{ fold_case( $value ) };
8101             }
8102 0 0       0 unless ( defined $self->{$name} ) {
8103 0         0 carp "Invalid $name '$value'; setting to unknown";
8104 0         0 $self->{$name} = BODY_TYPE_UNKNOWN;
8105             }
8106             } else {
8107 0         0 $self->{$name} = undef;
8108             }
8109 0         0 return 0;
8110             }
8111             }
8112              
8113             # _set_optional_float_no_reinit
8114             #
8115             # This acts as a mutator for any attribute whose value is either undef
8116             # or a floating-point number, and which does not cause the model to be
8117             # renitialized when its value changes. We disallow NaN.
8118              
8119             sub _set_optional_float_no_reinit {
8120 3     3   29 my ( $self, $name, $value ) = @_;
8121 3 50 33     16 if ( defined $value && ! _looks_like_real( $value ) ) {
8122 0         0 carp "Invalid $name '$value'; must be a float or undef";
8123 0         0 $value = undef;
8124             }
8125 3         9 $self->{$name} = $value;
8126 3         11 return 0;
8127             }
8128              
8129             # _set_optional_unsigned_integer_no_reinit
8130             #
8131             # This acts as a mutator for any attribute whose value is either undef
8132             # or an unsigned integer, and which does not cause the model to be
8133             # reinitialized when its value changes.
8134              
8135             sub _set_optional_unsigned_integer_no_reinit {
8136 0     0   0 my ( $self, $name, $value ) = @_;
8137 0 0 0     0 if ( defined $value && $value =~ m/ [^0-9] /smx ) {
8138 0         0 carp "Invalid $name '$value'; must be unsigned integer or undef";
8139 0         0 $value = undef;
8140             }
8141 0         0 $self->{$name} = $value;
8142 0         0 return 0;
8143             }
8144              
8145             sub _next_elevation_screen {
8146 95     95   320 my ( $sta, $pass_step, @args ) = @_;
8147 95 50       224 ref $sta
8148             or confess 'Programming error - station not a reference';
8149 95         399 my ( $suntim, $dawn ) = $sta->next_elevation( @args );
8150 95 50       311 defined $suntim
8151             or confess 'Programming error - time of next elevation undefined';
8152 95 100       261 $dawn or $pass_step = - $pass_step;
8153 95         279 my $sun_screen = $suntim + $pass_step / 2;
8154 95 100       472 return ( $suntim, $dawn, $sun_screen,
8155             $dawn ? $sun_screen : $suntim,
8156             );
8157             }
8158              
8159             #######################################################################
8160              
8161             # Initialization of aliases and status
8162              
8163             {
8164             # The following classes initialize themselves on load.
8165             local $@ = undef;
8166             eval { ## no critic (RequireCheckingReturnValueOfEval)
8167             require Astro::Coord::ECI::TLE::Iridium;
8168             };
8169             }
8170              
8171             # The following is all the Celestrak visual list that have magnitudes in
8172             # Heavens Above. These data are generated by the following:
8173             #
8174             # $ tools/heavens-above-mag --celestrak
8175             #
8176             # Last-Modified: Tue, 26 Sep 2023 01:23:57 GMT
8177              
8178             # The following constants are unsupported, and may be modified or
8179             # revoked at any time. They exist to support
8180             # xt/author/magnitude_status.t
8181 16     16   157 use constant _CELESTRAK_VISUAL => 'Tue, 26 Sep 2023 01:23:57 GMT';
  16         34  
  16         1098  
8182 16     16   151 use constant _MCCANTS_VSNAMES => undef;
  16         50  
  16         1008  
8183 16     16   120 use constant _MCCANTS_QUICKSAT => undef;
  16         54  
  16         7245  
8184              
8185             %magnitude_table = (
8186             '00694' => 2.7, # ATLAS CENTAUR 2 R/B
8187             '00733' => 4.2, # THOR AGENA D R/B
8188             '00877' => 4.2, # SL-3 R/B
8189             '02802' => 4.7, # SL-8 R/B
8190             '03230' => 5.2, # SL-8 R/B
8191             '03597' => 5.7, # OAO 2
8192             '03669' => 8.2, # ISIS 1
8193             '04327' => 5.7, # SERT 2
8194             '04814' => 4.2, # SL-3 R/B
8195             '05118' => 4.2, # SL-3 R/B
8196             '05560' => 4.2, # ASTEX 1
8197             '05730' => 4.2, # SL-8 R/B
8198             '06073' => 5.7, # COSMOS 482 DESCENT CRAFT
8199             '06153' => 5.2, # OAO 3 (COPERNICUS)
8200             '06155' => 4.2, # ATLAS CENTAUR R/B
8201             '08459' => 5.2, # SL-8 R/B
8202             '10114' => 4.7, # SL-3 R/B
8203             '10967' => 3.2, # SEASAT 1
8204             '11251' => 4.7, # METEOR 1-29
8205             '11267' => 4.7, # SL-14 R/B
8206             '11574' => 4.2, # SL-8 R/B
8207             '11672' => 4.2, # SL-14 R/B
8208             '12139' => 4.2, # SL-8 R/B
8209             '12465' => 4.2, # SL-3 R/B
8210             '12585' => 5.2, # METEOR PRIRODA
8211             '12904' => 4.2, # SL-3 R/B
8212             '13068' => 4.2, # SL-3 R/B
8213             '13154' => 4.7, # SL-3 R/B
8214             '13403' => 4.2, # SL-3 R/B
8215             '13552' => 4.2, # COSMOS 1408
8216             '13553' => 4.7, # SL-14 R/B
8217             '13819' => 4.7, # SL-3 R/B
8218             '14032' => 3.7, # COSMOS 1455
8219             '14208' => 4.2, # SL-3 R/B
8220             '14372' => 4.7, # COSMOS 1500
8221             '14699' => 4.2, # COSMOS 1536
8222             '14819' => 4.7, # COSMOS 1544
8223             '14820' => 4.7, # SL-14 R/B
8224             '15483' => 4.7, # SL-8 R/B
8225             '15494' => 3.7, # COSMOS 1626
8226             '15772' => 4.2, # SL-12 R/B(2)
8227             '15945' => 4.7, # SL-14 R/B
8228             '16182' => 3.2, # SL-16 R/B
8229             '16496' => 4.7, # SL-14 R/B
8230             '16719' => 4.2, # COSMOS 1743
8231             '16792' => 4.7, # SL-14 R/B
8232             '16882' => 4.7, # SL-14 R/B
8233             '16908' => 4.2, # EGS (AJISAI)
8234             '17295' => 4.2, # COSMOS 1812
8235             '17567' => 4.7, # SL-14 R/B
8236             '17589' => 4.7, # COSMOS 1833
8237             '17590' => 3.2, # SL-16 R/B
8238             '17912' => 4.7, # SL-14 R/B
8239             '17973' => 4.2, # COSMOS 1844
8240             '18153' => 4.7, # SL-14 R/B
8241             '18187' => 4.2, # COSMOS 1867
8242             '18421' => 4.2, # COSMOS 1892
8243             '18749' => 4.7, # SL-14 R/B
8244             '18958' => 4.7, # COSMOS 1933
8245             '19046' => 4.2, # SL-3 R/B
8246             '19120' => 2.7, # SL-16 R/B
8247             '19210' => 3.7, # COSMOS 1953
8248             '19257' => 4.7, # SL-8 R/B
8249             '19573' => 4.2, # COSMOS 1975
8250             '19574' => 4.2, # SL-14 R/B
8251             '19650' => 2.7, # SL-16 R/B
8252             '20261' => 5.2, # INTERCOSMOS 24
8253             '20262' => 5.7, # SL-14 R/B
8254             '20303' => 4.2, # DELTA 2 R/B(1)
8255             '20323' => 4.7, # DELTA 1 R/B
8256             '20443' => 4.2, # ARIANE 40 R/B
8257             '20453' => 4.7, # DELTA 2 R/B(1)
8258             '20465' => 4.2, # COSMOS 2058
8259             '20466' => 4.2, # SL-14 R/B
8260             '20511' => 4.2, # SL-14 R/B
8261             '20580' => 2.2, # HST
8262             '20625' => 2.7, # SL-16 R/B
8263             '20663' => 4.7, # COSMOS 2084
8264             '20666' => 4.7, # SL-6 R/B(2)
8265             '20775' => 4.2, # SL-8 R/B
8266             '21088' => 4.2, # SL-8 R/B
8267             '21397' => 4.7, # OKEAN 3
8268             '21422' => 4.2, # COSMOS 2151
8269             '21423' => 4.7, # SL-14 R/B
8270             '21574' => 5.2, # ERS 1
8271             '21610' => 3.7, # ARIANE 40 R/B
8272             '21819' => 4.7, # INTERCOSMOS 25
8273             '21876' => 4.7, # SL-8 R/B
8274             '21938' => 4.2, # SL-8 R/B
8275             '21949' => 4.7, # USA 81
8276             '22219' => 3.7, # COSMOS 2219
8277             '22220' => 2.7, # SL-16 R/B
8278             '22236' => 3.7, # COSMOS 2221
8279             '22285' => 2.7, # SL-16 R/B
8280             '22286' => 4.2, # COSMOS 2228
8281             '22566' => 2.7, # SL-16 R/B
8282             '22626' => 4.2, # COSMOS 2242
8283             '22803' => 2.7, # SL-16 R/B
8284             '22830' => 4.2, # ARIANE 40 R/B
8285             '23087' => 4.2, # COSMOS 2278
8286             '23088' => 2.7, # SL-16 R/B
8287             '23343' => 2.7, # SL-16 R/B
8288             '23405' => 2.7, # SL-16 R/B
8289             '23560' => 3.7, # ERS 2
8290             '23561' => 3.7, # ARIANE 40+ R/B
8291             '23705' => 2.7, # SL-16 R/B
8292             '24298' => 2.7, # SL-16 R/B
8293             '24883' => 6.8, # ORBVIEW 2 (SEASTAR)
8294             '25400' => 2.7, # SL-16 R/B
8295             '25407' => 2.7, # SL-16 R/B
8296             '25544' => -1.8, # ISS (ZARYA)
8297             '25732' => 4.2, # CZ-4B R/B
8298             '25860' => 3.7, # OKEAN O
8299             '25861' => 2.7, # SL-16 R/B
8300             '25876' => 4.2, # DELTA 2 R/B
8301             '25977' => 5.7, # HELIOS 1B
8302             '25994' => 2.7, # TERRA
8303             '26070' => 2.7, # SL-16 R/B
8304             '26474' => 2.7, # TITAN 4B R/B
8305             '26905' => 3.7, # USA 160
8306             '26907' => 3.7, # USA 160 DEB
8307             '27386' => 3.7, # ENVISAT
8308             '27422' => 3.2, # IDEFIX/ARIANE 42P
8309             '27424' => 4.7, # AQUA
8310             '27432' => 3.7, # CZ-4B R/B
8311             '27597' => 2.7, # ADEOS 2
8312             '27601' => 2.7, # H-2A R/B
8313             '28059' => 4.7, # CZ-4B R/B
8314             '28222' => 4.2, # CZ-2C R/B
8315             '28353' => 2.7, # SL-16 R/B
8316             '28415' => 4.2, # CZ-4B R/B
8317             '28480' => 3.7, # CZ-2C R/B
8318             # '28499' => undef, # ARIANE 5 R/B has no recorded magnitude
8319             '28738' => 4.7, # CZ-2D R/B
8320             '28773' => 4.2, # ASTRO E2
8321             '28931' => 3.2, # ALOS
8322             '28932' => 3.7, # H-2A R/B
8323             '29228' => 3.7, # RESURS DK-1
8324             '29252' => 4.7, # GENESIS 1
8325             '29507' => 2.7, # CZ-4B R/B
8326             '31114' => 3.2, # CZ-2C R/B
8327             '31598' => 3.7, # SKYMED 1
8328             '31789' => 5.7, # GENESIS 2
8329             '31792' => 3.2, # COSMOS 2428
8330             '31793' => 2.7, # SL-16 R/B
8331             '33504' => 5.3, # KORONAS-FOTON
8332             # '37731' => undef, # CZ-2C R/B has no recorded magnitude
8333             '38341' => 3.2, # H-2A R/B
8334             # '39271' => undef, # CUSAT 2/FALCON 9 has no recorded magnitude
8335             # '39358' => undef, # SJ-16 has no recorded magnitude
8336             # '39364' => undef, # CZ-2C R/B has no recorded magnitude
8337             '39679' => 3.4, # SL-4 R/B
8338             '39766' => 3.7, # ALOS 2
8339             '40354' => 4.2, # SL-27 R/B
8340             # '41038' => undef, # YAOGAN 29 has no recorded magnitude
8341             # '41337' => undef, # ASTRO H has no recorded magnitude
8342             # '42758' => undef, # HXMT has no recorded magnitude
8343             # '43521' => undef, # CZ-2C R/B has no recorded magnitude
8344             # '43641' => undef, # SAOCOM 1-A has no recorded magnitude
8345             # '43682' => undef, # H-2A R/B has no recorded magnitude
8346             # '46265' => undef, # SAOCOM 1-B has no recorded magnitude
8347             '48274' => 0.0, # CSS (TIANHE-1)
8348             # '48865' => undef, # COSMOS 2550 has no recorded magnitude
8349             # '51842' => undef, # OBJECT U has no recorded magnitude
8350             # '52794' => undef, # CZ-2C R/B has no recorded magnitude
8351             # '53131' => undef, # CZ-2C R/B has no recorded magnitude
8352             '53807' => 3.5, # BLUEWALKER 3
8353             # '57800' => undef, # XRISM has no recorded magnitude
8354             );
8355              
8356             1;
8357              
8358             __END__