File Coverage

blib/lib/Astro/Coord/ECI/TLE.pm
Criterion Covered Total %
statement 2333 2985 78.1
branch 401 920 43.5
condition 136 269 50.5
subroutine 159 180 88.3
pod 42 42 100.0
total 3071 4396 69.8


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   271557 use strict;
  16         41  
  16         681  
230 16     16   100 use warnings;
  16         54  
  16         1373  
231              
232             our $VERSION = '0.134';
233              
234 16     16   136 use base qw{ Astro::Coord::ECI Exporter };
  16         33  
  16         12708  
235              
236 16         6020 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 gm_strftime load_module local_strftime
240             looks_like_number max min
241             mod2pi PI PIOVER2 rad2deg SECSPERDAY TWOPI thetag
242             __default_station
243             @CARP_NOT
244 16     16   123 };
  16         32  
245              
246 16     16   129 use Carp qw{carp croak confess};
  16         33  
  16         1219  
247 16     16   11747 use Data::Dumper;
  16         165366  
  16         1702  
248 16     16   8515 use IO::File;
  16         179435  
  16         2622  
249 16     16   251 use POSIX qw{ ceil floor fmod modf };
  16         36  
  16         147  
250 16     16   1713 use Scalar::Util ();
  16         72  
  16         1370  
251              
252             BEGIN {
253 16     16   52 local $@;
254 16         92 eval {require Scalar::Util; Scalar::Util->import ('dualvar'); 1}
  16         424  
  16         2727  
255 16 50       53 or *dualvar = sub {$_[0]};
  0         0  
256             }
257              
258             { # Local symbol block.
259             my @const = qw{
260             PASS_EVENT_NONE
261             PASS_EVENT_SHADOWED
262             PASS_EVENT_LIT
263             PASS_EVENT_DAY
264             PASS_EVENT_RISE
265             PASS_EVENT_MAX
266             PASS_EVENT_SET
267             PASS_EVENT_APPULSE
268             PASS_EVENT_START
269             PASS_EVENT_END
270             PASS_EVENT_BRIGHTEST
271             PASS_VARIANT_VISIBLE_EVENTS
272             PASS_VARIANT_FAKE_MAX
273             PASS_VARIANT_NO_ILLUMINATION
274             PASS_VARIANT_START_END
275             PASS_VARIANT_BRIGHTEST
276             PASS_VARIANT_TRUNCATE
277             PASS_VARIANT_NONE
278             BODY_TYPE_UNKNOWN
279             BODY_TYPE_DEBRIS
280             BODY_TYPE_ROCKET_BODY
281             BODY_TYPE_PAYLOAD
282             };
283             our @EXPORT_OK = @const;
284             our %EXPORT_TAGS = (
285             all => \@EXPORT_OK,
286             constants => \@const
287             );
288             }
289              
290 16     16   130 use constant RE_ALL_DIGITS => qr{ \A [0-9]+ \z }smx;
  16         37  
  16         1905  
291              
292             # The following constants are from section 12 (Users Guide, Constants,
293             # and Symbols) of SpaceTrack Report No. 3, Models for Propagation of
294             # NORAD Element Sets by Felix R. Hoots and Ronald L. Roehrich, December
295             # 1980, compiled by T. S. Kelso 31 December 1988. The FORTRAN variables
296             # in the original are defined without the "SGP_" prefix. Were there
297             # are duplicates (with one commented out), the commented-out version is
298             # the one in the NORAD report, and the replacement has greater
299             # precision. If there are two commented out, the second was a greater
300             # precision constant, and the third is (ultimately) calculated based
301             # on pi = atan2 (0, -1).
302              
303 16     16   107 use constant SGP_CK2 => 5.413080E-4;
  16         30  
  16         1063  
304 16     16   128 use constant SGP_CK4 => .62098875E-6;
  16         36  
  16         917  
305 16     16   103 use constant SGP_E6A => 1.0E-6;
  16         95  
  16         868  
306 16     16   87 use constant SGP_QOMS2T => 1.88027916E-9;
  16         28  
  16         965  
307 16     16   85 use constant SGP_S => 1.01222928;
  16         27  
  16         1056  
308             ## use constant SGP_TOTHRD => .66666667;
309 16     16   110 use constant SGP_TOTHRD => 2 / 3;
  16         48  
  16         1015  
310 16     16   85 use constant SGP_XJ3 => -.253881E-5;
  16         33  
  16         845  
311 16     16   83 use constant SGP_XKE => .743669161E-1;
  16         35  
  16         826  
312 16     16   85 use constant SGP_XKMPER => 6378.135; # Earth radius, KM.
  16         29  
  16         742  
313 16     16   88 use constant SGP_XMNPDA => 1440.0; # Time units per day.
  16         29  
  16         768  
314 16     16   82 use constant SGP_XSCPMN => 60; # Seconds per time unit.
  16         28  
  16         831  
315 16     16   83 use constant SGP_AE => 1.0; # Distance units / earth radii.
  16         41  
  16         1013  
316             ## use constant SGP_DE2RA => .174532925E-1; # radians/degree.
317             ## use constant SGP_DE2RA => 0.0174532925199433; # radians/degree.
318 16     16   88 use constant SGP_DE2RA => PI / 180; # radians/degree.
  16         39  
  16         884  
319             ## use constant SGP_PI => 3.14159265; # Pi.
320             ## use constant SGP_PI => 3.14159265358979; # Pi.
321 16     16   83 use constant SGP_PI => PI; # Pi.
  16         31  
  16         791  
322             ## use constant SGP_PIO2 => 1.57079633; # Pi/2.
323             ## use constant SGP_PIO2 => 1.5707963267949; # Pi/2.
324 16     16   102 use constant SGP_PIO2 => PIOVER2; # Pi/2.
  16         43  
  16         745  
325             ## use constant SGP_TWOPI => 6.2831853; # 2 * Pi.
326             ## use constant SGP_TWOPI => 6.28318530717959; # 2 * Pi.
327 16     16   89 use constant SGP_TWOPI => TWOPI; # 2 * Pi.
  16         42  
  16         949  
328             ## use constant SGP_X3PIO2 => 4.71238898; # 3 * Pi / 2.
329             ## use constant SGP_X3PIO2 => 4.71238898038469; # 3 * Pi / 2.
330 16     16   80 use constant SGP_X3PIO2 => 3 * PIOVER2;
  16         36  
  16         875  
331              
332 16     16   143 use constant SGP_RHO => .15696615;
  16         31  
  16         17132  
333              
334             # FORTRAN variable glossary, read from same source, and stated in
335             # terms of the output produced by the parse method.
336             #
337             # EPOCH => epoch
338             # XNDT20 => firstderivative
339             # XNDD60 => secondderivative
340             # BSTAR => bstardrag
341             # XINCL => inclination
342             # XNODE0 => ascendingnode
343             # E0 => eccentricity
344             # OMEGA0 => argumentofperigee
345             # XM0 => meananomaly
346             # XNO => meanmotion
347              
348             # List all the legitimate attributes for the purposes of the
349             # get and set methods. Possible values of the hash are:
350             # undef => read-only attribute
351             # 0 => no model re-initializing necessary
352             # 1 => at least one model needs re-initializing
353             # code reference - the reference is called with the
354             # object unmodified, with the arguments
355             # being the object, the name of the attribute,
356             # and the new value of the attribute. The code
357             # must make the needed changes to the attribute, and
358             # return 0 or 1, interpreted as above.
359              
360             my %attrib = (
361             backdate => 0,
362             effective => sub {
363             my ($self, $name, $value) = @_;
364             if ( defined $value && ! looks_like_number( $value ) ) {
365             if ( $value =~ m{ \A ([0-9]+) / ([0-9]+) / ([0-9]+) : ([0-9]+) :
366             ([0-9]+ (?: [.] [0-9]* )? ) \z }smx ) {
367             $value = greg_time_gm( 0, 0, 0, 1, 0,
368             __tle_year_to_Gregorian_year( $1 + 0 ) ) + (
369             (($2 - 1) * 24 + $3) * 60 + $4) * 60 + $5;
370             } else {
371             carp "Invalid effective date '$value'";
372             $value = undef;
373             }
374             }
375             $self->{$name} = $value;
376             return 0;
377             },
378             classification => 0,
379             international => \&_set_intldes,
380             epoch => sub {
381             $_[0]{$_[1]} = $_[2];
382             $_[0]{ds50} = $_[0]->ds50 ();
383             $_[0]{epoch_dynamical} = $_[2] + dynamical_delta ($_[2]);
384             return 1;
385             },
386             firstderivative => 1,
387             gravconst_r => sub {
388             ($_[2] == 72 || $_[2] == 721 || $_[2] == 84)
389             or croak "Error - Illegal gravconst_r; must be 72, 721, or 84";
390             $_[0]{$_[1]} = $_[2];
391             return 1; # sgp4r needs reinit if this changes.
392             },
393             secondderivative => 1,
394             bstardrag => 1,
395             ephemeristype => 0,
396             elementnumber => 0,
397             inclination => 1,
398             model => sub {
399             $_[0]->is_valid_model ($_[2]) || croak <
400             Error - Illegal model name '$_[2]'.
401             eod
402             $_[0]{$_[1]} = $_[2];
403             return 0;
404             },
405             model_error => 0,
406             ascendingnode => 1,
407             eccentricity => 1,
408             argumentofperigee => 1,
409             meananomaly => 1,
410             meanmotion => 1,
411             revolutionsatepoch => 0,
412             debug => 0,
413             geometric => 0, # Use geometric horizon for pass rise/set.
414             visible => 0, # Pass() reports only illuminated passes.
415             appulse => 0, # Maximum appulse to report.
416             interval => 0, # Interval for pass() positions, if positive.
417             lazy_pass_position => 0, # Position optional if true.
418             pass_variant => sub {
419             my ( $self, $name, $val ) = @_;
420             $val =~ RE_ALL_DIGITS
421             or croak 'The pass_variant attribute must be an unsigned number';
422             $self->{$name} = $val;
423             return 0;
424             },
425             ds50 => undef, # Read-only
426             epoch_dynamical => undef, # Read-only
427             rcs => 0, # Radar cross-section
428             tle => undef, # Read-only
429             file => \&_set_optional_unsigned_integer_no_reinit,
430             illum => \&_set_illum,
431             launch_year => \&_set_intldes_part,
432             launch_num => \&_set_intldes_part,
433             launch_piece => \&_set_intldes_part,
434             object_type => \&_set_object_type,
435             ordinal => \&_set_optional_unsigned_integer_no_reinit,
436             originator => 0,
437             pass_threshold => sub {
438             my ($self, $name, $value) = @_;
439             not defined $value
440             or looks_like_number( $value )
441             or carp "Invalid $name '$value'";
442             $self->{$name} = $value;
443             return 0;
444             },
445             reblessable => sub {
446             my $doit = !$_[0]{$_[1]} && $_[2] && $_[0]->get ('id');
447             $_[0]{$_[1]} = $_[2];
448             $doit and $_[0]->rebless ();
449             return 0;
450             },
451             intrinsic_magnitude => \&_set_optional_float_no_reinit,
452             );
453             my %static = (
454             appulse => deg2rad (10), # Report appulses < 10 degrees.
455             backdate => 1, # Use object in pass before its epoch.
456             geometric => 0, # Use geometric horizon for pass rise/set.
457             gravconst_r => 72, # Specify geodetic data set for sgp4r.
458             illum => 'sun',
459             interval => 0,
460             lazy_pass_position => 0,
461             model => 'model',
462             pass_variant => 0,
463             reblessable => 1,
464             visible => 1,
465             );
466             my %model_attrib = ( # For the benefit of is_model_attribute()
467             ds50 => 1, # Read-only, but it fits the definition.
468             epoch => 1, # Hand-set, since we dont want to call the code.
469             epoch_dynamical => 1, # Read-only, but fits the definition.
470             );
471             foreach (keys %attrib) {
472             $model_attrib{$_} = 1 if $attrib{$_} && !ref $attrib{$_}
473             }
474             my %status; # Subclassing data - initialized at end
475             my %magnitude_table; # Magnitude data - initialized at end
476             my $magnitude_adjust = 0; # Adjustment to magnitude table value
477              
478 16     16   154 use constant TLE_INIT => '_init';
  16         45  
  16         9368  
479              
480             =item $tle = Astro::Coord::ECI::TLE->new()
481              
482             This method instantiates an object to represent a NORAD two- or
483             three-line orbital element set. This is a subclass of
484             L.
485              
486             Any arguments get passed to the set() method.
487              
488             It is both anticipated and recommended that you use the parse()
489             method instead of this method to create an object, since the models
490             currently have no code to guard against incomplete data.
491              
492             =cut
493              
494             sub new {
495 64     64 1 518352 my $class = shift;
496 64         576 my $self = $class->SUPER::new (%static, @_);
497 64         238 return $self;
498             }
499              
500             =item $tle->after_reblessing (\%possible_attributes)
501              
502             This method supports reblessing into a subclass, with the argument
503             representing attributes that the subclass may wish to set. It is called
504             by rebless() and should not be called by the user.
505              
506             At this level it does nothing.
507              
508             =cut
509              
510       87 1   sub after_reblessing {}
511              
512             =item Astro::Coord::ECI::TLE->alias (name => class ...)
513              
514             This static method adds an alias for a class name, for the benefit of
515             users of the status() method and 'illum' attributes, and ultimately of
516             the rebless() method. It is intended to be used by subclasses to
517             register short names for themselves upon initialization, though of
518             course you can call it yourself as well.
519              
520             For example, this class calls
521              
522             __PACKAGE__->alias (tle => __PACKAGE__);
523              
524             You can register more than one alias in a single call. Aliases
525             can be deleted by assigning them a false value (e.g. '' or undef).
526              
527             If called without arguments, it returns the current aliases.
528              
529             You can actually call this as a normal method, but it still behaves
530             like a static method.
531              
532             =cut
533              
534             my %type_map = ();
535              
536             sub alias {
537 48     48 1 194 my ($self, @args) = @_;
538 48 50       174 @args % 2 and croak <
539             Error - Must have even number of arguments for alias().
540             eod
541 48 0       138 return wantarray ? %type_map : {%type_map} unless @args;
    50          
542 48         132 while (@args) {
543 48         123 my $name = shift @args;
544 48 50       151 my $class = shift @args or do {
545 0         0 delete $type_map{$name};
546 0         0 next;
547             };
548 48 50       174 $class = $type_map{$class} if $type_map{$class};
549 48         262 load_module ($class);
550 48         246 $type_map{$name} = $class;
551             }
552 48         114 return $self;
553             }
554             __PACKAGE__->alias (tle => __PACKAGE__);
555              
556             =item $kilometers = $tle->apoapsis();
557              
558             This method returns the apoapsis of the orbit, in kilometers. Since
559             Astro::Coord::ECI::TLE objects always represent bodies orbiting the
560             Earth, this is more usually called apogee.
561              
562             Note that this is the distance from the center of the Earth, not the
563             altitude.
564              
565             =cut
566              
567             sub apoapsis {
568 8     8 1 26 my $self = shift;
569             return $self->{&TLE_INIT}{TLE_apoapsis} ||=
570 8   66     42 (1 + $self->get('eccentricity')) * $self->semimajor();
571             }
572              
573             =item $kilometers = $tle->apogee();
574              
575             This method is simply a synonym for apoapsis().
576              
577             =cut
578              
579             *apogee = \&apoapsis;
580              
581             # See Astro::Coord::ECI for docs.
582              
583             sub attribute {
584 0 0   0 1 0 return exists $attrib{$_[1]} ?
585             __PACKAGE__ :
586             $_[0]->SUPER::attribute ($_[1])
587             }
588              
589             =item $tle->before_reblessing ()
590              
591             This method supports reblessing into a subclass. It is intended to do
592             any cleanup the old class needs before reblessing into the new class. It
593             is called by rebless(), and should not be called by the user.
594              
595             At this level it does nothing.
596              
597             =cut
598              
599       87 1   sub before_reblessing {}
600              
601             =item $type = $tle->body_type ()
602              
603             This method returns the type of the body as one of the BODY_TYPE_*
604             constants. This is the C<'object_type'> attribute if that is defined.
605             Otherwise it is derived from the common name using an algorithm similar
606             to the one used by the Space Track web site. This algorithm will not
607             work if the common name is not available, or if it does not conform to
608             the Space Track naming conventions. Known or suspected differences from
609             the algorithm described at the bottom of the Satellite Box Score page
610             include:
611              
612             * The C algorithm is not case-sensitive. The
613             Space Track algorithm appears to assume all upper-case.
614              
615             * The C algorithm looks for words (that is,
616             alphanumeric strings delimited by non-alphanumeric characters), whereas
617             the Space Track documentation seems to say it just looks for substrings.
618             However, implementing the documented algorithm literally results in OID
619             20479 'DEBUT (ORIZURU)' being classified as debris, whereas Space Track
620             returns it in response to a query for name 'deb' that excludes debris.
621              
622             The possible returns are:
623              
624             C<< BODY_TYPE_UNKNOWN => dualvar( 0, 'unknown' ) >> if the value of the
625             C attribute is C, or if it is empty or contains only
626             white space.
627              
628             C<< BODY_TYPE_DEBRIS => dualvar( 1, 'debris' ) >> if the value of the
629             C attribute contains one of the words 'deb', 'debris', 'coolant',
630             'shroud', or 'westford needles', all checks being case-insensitive.
631              
632             C<< BODY_TYPE_ROCKET_BODY => dualvar( 2, 'rocket body' ) >> if the body
633             is not debris, but the value of the C attribute contains one of
634             the strings 'r/b', 'akm' (for 'apogee kick motor') or 'pkm' (for
635             'perigee kick motor') all checks being case-insensitive.
636              
637             C<< BODY_TYPE_PAYLOAD => dualvar( 3, 'payload' ) >> if the body is not
638             unknown, debris, or a rocket body.
639              
640             The above constants are not exported by default, but they are exportable
641             either by name or using the C<:constants> tag.
642              
643             If L does not export C, the
644             constants are defined to be numeric. The cautious programmer will
645             therefore test them using numeric tests.
646              
647             =cut
648              
649 16     16   194 use constant BODY_TYPE_UNKNOWN => dualvar( 0, 'unknown' );
  16         55  
  16         1465  
650 16     16   223 use constant BODY_TYPE_DEBRIS => dualvar( 1, 'debris' );
  16         119  
  16         1142  
651 16     16   168 use constant BODY_TYPE_ROCKET_BODY => dualvar( 2, 'rocket body' );
  16         36  
  16         1107  
652 16     16   120 use constant BODY_TYPE_PAYLOAD => dualvar( 3, 'payload' );
  16         31  
  16         43661  
653              
654             sub body_type {
655 12     12 1 1155 my ( $self ) = @_;
656 12         12 my $type;
657 12 50       20 $type = $self->get( 'object_type' )
658             and return $type;
659 12 100       16 defined( my $name = $self->get( 'name' ) )
660             or return BODY_TYPE_UNKNOWN;
661 11 50       48 $name =~ m/ \A \s* \z /smx
662             and return BODY_TYPE_UNKNOWN;
663 11 100 100     106 ( $name =~ m/ \b deb \b /smxi
      100        
      100        
      100        
664             || $name =~ m/ \b debris \b /smxi
665             || $name =~ m/ \b coolant \b /smxi
666             || $name =~ m/ \b shroud \b /smxi
667             || $name =~ m/ \b westford \s+ needles \b /smxi )
668             and return BODY_TYPE_DEBRIS;
669 5 100 100     25 ( $name =~ m{ \b r/b \b }smxi
670             || $name =~ m/ \b [ap] km \b /smxi )
671             and return BODY_TYPE_ROCKET_BODY;
672 2         7 return BODY_TYPE_PAYLOAD;
673             }
674              
675             =item $tle->can_flare ()
676              
677             This method returns true if the object is capable of generating flares
678             (i.e. predictable bright flashes) and false otherwise. At this level
679             of the inheritance hierarchy, it always returns false, but subclasses
680             may return true.
681              
682             =cut
683              
684 0     0 1 0 sub can_flare {return 0}
685              
686             =item $elevation = $tle->correct_for_refraction( $elevation )
687              
688             This override of the superclass' method simply returns the elevation
689             passed to it. Atmospheric refraction at orbital altitudes is going to be
690             negligible except B close to the horizon, and I have no
691             algorithm for that.
692              
693             If I B come up with something to handle refraction close to the
694             horizon, though, it will appear here. One would expect the refraction
695             right at the limb to be twice that calculated by Thorfinn's algorithm
696             (used in the superclass) because the light travels to the Earth's
697             surface and back out again.
698              
699             See the L C and
700             C documentation for whether this class'
701             C method is actually called by those methods.
702              
703             =cut
704              
705             sub correct_for_refraction {
706 917     917 1 2413 my ( undef, $elevation ) = @_; # Invocant unused
707 917         2042 return $elevation;
708             }
709              
710             =item $value = $tle->ds50($time)
711              
712             This method converts the time to days since 1950 Jan 0, 0 h GMT.
713             The time defaults to the epoch of the data set. This method does not
714             affect the $tle object - it is exposed for convenience and for testing
715             purposes.
716              
717             It can also be called as a "static" method, i.e. as
718             Astro::Coord::ECI::TLE->ds50 ($time), but in this case the time may not
719             be defaulted, and no attempt has been made to make this a pretty error.
720              
721             =cut
722              
723             { # Begin local symbol block
724              
725             # Because different Perl implementations may have different
726             # epochs, we assume that 2000 Jan 1 0h UT is representable, and
727             # pre-calculate that time in terms of seconds since the epoch.
728             # Then, when the method is called, we convert the argument to
729             # days since Y2K, and then add the magic number needed to get
730             # us to days since 1950 Jan 0 0h UT.
731              
732             my $y2k = greg_time_gm( 0, 0, 0, 1, 0, 2000 ); # Calc. time of 2000 Jan 1 0h UT
733              
734             sub ds50 {
735 59     59 1 142 my ($self, $epoch) = @_;
736 59 50       221 defined $epoch or $epoch = $self->{epoch};
737 59         180 my $rslt = ($epoch - $y2k) / SECSPERDAY + 18263;
738 59 50 33     246 (ref $self && $self->{debug}) and print <
739             Debug ds50 ($epoch) = $rslt
740             eod
741 59         165 return $rslt;
742             }
743             } # End local symbol block
744              
745             =item $value = $tle->get('attribute')
746              
747             This method retrieves the value of the given attribute. See the
748             L section for a description of the attributes.
749              
750             =cut
751              
752             {
753             my %accessor = (
754             tle => sub {$_[0]{$_[1]} ||= $_[0]->_make_tle()},
755             );
756             sub get {
757 45601     45601 1 1430220 my $self = shift;
758 45601         79341 my $name = shift;
759 45601 50       90363 if (ref $self) {
760 45601 100       202164 exists $attrib{$name} or return $self->SUPER::get ($name);
761             return $accessor{$name} ?
762             $accessor{$name}->($self, $name) :
763 4697 100       23130 $self->{$name};
764             } else {
765 0 0       0 exists $static{$name} or
766             return $self->SUPER::get ($name);
767 0         0 return $static{$name};
768             }
769             }
770             }
771              
772             =item $illuminated = $tle->illuminated();
773              
774             This method returns a true value if the body is illuminated, and a false
775             value if it is not.
776              
777             =cut
778              
779             sub illuminated {
780 502     502 1 1265 my ( $self, $time ) = @_;
781 502         1713 return $self->__sun_elev_from_sat( $time ) >= 0;
782             }
783              
784             =item @events = $tle->intrinsic_events( $start, $end );
785              
786             This method returns any events that are intrinsic to the C<$tle> object.
787             If optional argument C<$start> is defined, only events occurring at or
788             after that Perl time are returned. Similarly, if optional argument
789             C<$end> is defined, only events occurring before that Perl time are
790             returned.
791              
792             The return is an array of array references. Each array reference
793             specifies the Perl time of the event and a text description of the
794             event.
795              
796             At this level of the object hierarchy nothing is returned. Subclasses
797             may override this to add C events. The overrides should return
798             anything returned by C in addition to
799             anything they return themselves.
800              
801             The order of the returned events is undefined.
802              
803             =cut
804              
805             sub intrinsic_events {
806 47     47 1 124 return;
807             }
808              
809             =item $deep = $tle->is_deep();
810              
811             This method returns true if the object is in deep space - meaning that
812             its period is at least 225 minutes (= 13500 seconds).
813              
814             =cut
815              
816             sub is_deep {
817             return $_[0]->{&TLE_INIT}{TLE_isdeep}
818 10 100   10 1 86 if exists $_[0]->{&TLE_INIT}{TLE_isdeep};
819 4         22 return ($_[0]->{&TLE_INIT}{TLE_isdeep} = $_[0]->period () >= 13500);
820             }
821              
822             =item $boolean = $tle->is_model_attribute ($name);
823              
824             This method returns true if the named attribute is an attribute of
825             the model - i.e. it came from the TLE data and actually affects the
826             model computations. It is really for the benefit of
827             Astro::Coord::ECI::TLE::Set, so that class can determine how its
828             set() method should handle the attribute.
829              
830             =cut
831              
832 1     1 1 7 sub is_model_attribute { return $model_attrib{$_[1]} }
833              
834             =item $boolean = $tle->is_valid_model ($model_name);
835              
836             This method returns true if the given name is the name of an orbital
837             model, and false otherwise.
838              
839             Actually, in the spirit of UNIVERSAL::can, it returns a reference to
840             the code if the model exists, and undef otherwise.
841              
842             This is really for the benefit of Astro::Coord::ECI::TLE::Set, so it
843             knows it needs to select the correct member object before running the
844             model.
845              
846             This method can be called as a static method, or even as a subroutine.
847              
848             =cut
849              
850             { # Begin local symbol block
851              
852             my %valid = map {$_ => __PACKAGE__->can ($_)}
853             qw{model model4 model4r model8 null sdp4 sdp8 sgp sgp4 sgp4r sgp8};
854              
855             #>>> NOTE WELL
856             #>>> If a model is added, the period method must change
857             #>>> as well, to calculate using the new model. I really
858             #>>> ought to do all this with code attributes.
859              
860             sub is_valid_model {
861 128     128 1 398 return $valid{$_[1]}
862             }
863              
864             } # End local symbol block
865              
866             =item $mag = $tle->magnitude( $station );
867              
868             This method returns the magnitude of the body as seen from the given
869             station. If no C<$station> is specified, the object's C<'station'>
870             attribute is used. If that is not set, and exception is thrown.
871              
872             This is calculated from the C<'intrinsic_magnitude'> attribute, the
873             distance from the station to the satellite, and the fraction of the
874             satellite illuminated. The formula is from Mike McCants.
875              
876             We return C if the C<'intrinsic_magnitude'> or C<'illum'>
877             attributes are C, or if the illuminating body is below the
878             horizon as seen from the satellite.
879              
880             After this method returns the time set in the station attribute should
881             be considered undefined. In fact, it will be set to the same time as the
882             invocant if a defined magnitude was returned. But if C was
883             returned, the station's time may not have been changed.
884              
885             Some very desultory investigation of International Space Station
886             magnitude predictions suggests that this method produces magnitude
887             estimates about half a magnitude less bright than Heavens Above.
888              
889             =cut
890              
891             sub magnitude {
892 1     1 1 7 my ( $self, $sta ) = __default_station( @_ );
893              
894             # If we have no standard magnitude, just return undef.
895 1 50       3 defined( my $std_mag = $self->get( 'intrinsic_magnitude' ) )
896             or return undef; ## no critic (ProhibitExplicitReturnUndef)
897              
898             # If we have no illuminating body for some reason, we also have to
899             # just return undef.
900 1 50       5 my $illum = $self->get( 'illum' )
901             or return undef; ## no critic (ProhibitExplicitReturnUndef)
902              
903             # Pick up the time.
904 1         51 my $time = $self->universal();
905              
906             # If the illuminating body is below the horizon, we return undef.
907 1 50       6 $self->illuminated()
908             or return undef; ## no critic (ProhibitExplicitReturnUndef)
909              
910             # Compute the range amd the elevation.
911 1         6 my ( undef, $elev, $range ) = $sta->universal( $time )->azel( $self );
912              
913             # If the satellite is below the horizon, just return undef
914 1 50       6 $elev < 0
915             and return undef; ## no critic (ProhibitExplicitReturnUndef)
916              
917             # Adjust the magnitude if the illuminating body is not the Sun.
918 1 50       9 my $mag_adj = $illum->isa( 'Astro::Coord::ECI::Sun' ) ? 0 :
919             $illum->magnitude() - Astro::Coord::ECI::Sun->MEAN_MAGNITUDE();
920              
921             # Compute the fraction of the satellite illuminated.
922 1         10 my $frac_illum = ( 1 + cos( $self->angle( $illum, $sta ) ) ) / 2;
923              
924             # Finally we get to McCants' algorithm
925 1         9 return $std_mag + $mag_adj - 15.75 +
926             2.5 * log( $range ** 2 / $frac_illum ) / log( 10 );
927              
928             }
929              
930             =item Astro::Coord::ECI::TLE->magnitude_table( command => arguments ...)
931              
932             This method maintains the internal magnitude table, which is used by the
933             parse() method to fill in magnitudes, since they are not normally
934             available from the usual sources. The first argument determines what is
935             done to the status table; subsequent arguments depend on the first
936             argument. Valid commands and arguments are:
937              
938             C $id, $mag )> adds a magnitude entry to the
939             table, replacing the existing entry for the given OID if any.
940              
941             C $adjustment )> maintains a magnitude
942             adjustment to be added to the value in the magnitude table before
943             setting the C of an object. If the argument is
944             C the current adjustment is returned; otherwise the argument
945             becomes the new adjustment. Actual magnitude table entries are not
946             modified by this operation; the adjustment is done in the C
947             method.
948              
949             C clears the magnitude table.
950              
951             C $id )> removes the given OID from the table
952             if it is there.
953              
954             C \%mag ) replaces the magnitude table
955             with the contents of the given hash. The keys will be normalized to 5
956             digits.
957              
958             C $file_name, $mag_offset )> replaces the
959             magnitude table with the contents of the named Molczan-format file. The
960             C<$file_name> argument can also be a scalar reference with the scalar
961             containing the data, or an open handle. The C<$mag_offset> is an
962             adjustment to be added to the magnitudes read from the file, and
963             defaults to 0.
964              
965             C $file_name, $mag_offset )> replaces the
966             magnitude table with the contents of the named Quicksat-format file. The
967             C<$file_name> argument can also be a scalar reference with the scalar
968             containing the data, or an open handle. The C<$mag_offset> is an
969             adjustment to be added to the magnitudes read from the file, and
970             defaults to 0. In addition to this value, C<0.7> is added to the
971             magnitude before storage to adjust the data from full-phase to
972             half-phase.
973              
974             C ... )> returns an array which is a slice of
975             the magnitude table, which is stored as a hash. In other words, it
976             returns OID/magnitude pairs in no particular order. If any further
977             arguments are passed, they are the OIDs to return. Otherwise all are
978             returned.
979              
980             Examples of Molczan-format data are contained in F and
981             F available on Mike McCants' web site; these can be fetched
982             using the L C method. An
983             example of Quicksat-format data is contained in F. See Mike
984             McCants' web site, L for an
985             explanation of the differences.
986              
987             Note that if you have one of the reported pure Perl versions of
988             L, you can not pass open handles to
989             functionality that would otherwise accept them.
990              
991             =cut
992              
993             {
994             my $openhandle = Scalar::Util->can( 'openhandle' ) || sub { return };
995              
996             my $parse_file = sub {
997             my ( $file_name, $mag_offset, $parse_info ) = @_;
998             defined $mag_offset
999             or $mag_offset = 0;
1000             $mag_offset += $parse_info->{mag_offset};
1001             my %mag;
1002             my $fh;
1003             if ( $openhandle->( $file_name ) ) {
1004             $fh = $file_name;
1005             } else {
1006             open $fh, '<', $file_name ## no critic (RequireBriefOpen)
1007             or croak "Failed to open $file_name: $!";
1008             }
1009             local $_ = undef; # while (<>) ... does not localize $_.
1010             while ( <$fh> ) {
1011             chomp;
1012             m/ \A \s* (?: \# | \z ) /smx
1013             and next; # Extension to syntax.
1014             $parse_info->{pad} > length
1015             and $_ = sprintf '%-*s', $parse_info->{pad}, $_;
1016             # Perl 5.8 and below require an explicit buffer to unpack.
1017             my ( $id, $mag ) = unpack $parse_info->{template}, $_;
1018             $mag =~ s/ \s+ //smxg;
1019             looks_like_number( $mag )
1020             or next;
1021             $mag{ _normalize_oid( $id ) } = $mag + $parse_info->{mag_offset};
1022             }
1023             close $fh;
1024             %magnitude_table = %mag;
1025             };
1026              
1027             my %cmd_def = (
1028             add => sub {
1029             my ( $id, $mag ) = @_;
1030             defined $id
1031             and $id =~ m/ \A [0-9]+ \z /smx
1032             and defined $mag
1033             and looks_like_number( $mag )
1034             or croak 'magnitude_table add needs an OID and a magnitude';
1035             $magnitude_table{ _normalize_oid( $id ) } = $mag;
1036             return;
1037             },
1038             adjust => sub {
1039             my ( $adj ) = @_;
1040             if ( defined $adj ) {
1041             looks_like_number( $adj )
1042             or croak 'magnitude_table adjust needs a floating point number';
1043             $magnitude_adjust = $adj;
1044             return;
1045             } else {
1046             return $magnitude_adjust;
1047             }
1048             },
1049             clear => sub {
1050             %magnitude_table = ();
1051             return;
1052             },
1053             dump => sub {
1054             local $Data::Dumper::Terse = 1;
1055             local $Data::Dumper::Sortkeys = 1;
1056             print Dumper( \%magnitude_table );
1057             return;
1058             },
1059             drop => sub {
1060             my ( $id ) = @_;
1061             defined $id
1062             and $id =~ m/ \A [0-9]+ \z /smx
1063             or croak 'magnitude_table drop needs an OID';
1064             delete $magnitude_table{ _normalize_oid( $id ) };
1065             return;
1066             },
1067             magnitude => sub {
1068             my ( $tbl ) = @_;
1069             HASH_REF eq ref $tbl
1070             or croak 'magnitude_table magnitude needs a hash ref';
1071             my %mag;
1072             foreach my $key ( keys %{ $tbl } ) {
1073             my $val = $tbl->{$key};
1074             $key =~ m/ \A [0-9]+ \z /smx
1075             or croak "OID '$key' must be numeric";
1076             looks_like_number( $val )
1077             or croak "Magnitude '$val' must be numeric";
1078             $mag{ _normalize_oid( $key ) } = $val;
1079             }
1080             %magnitude_table = %mag;
1081             return;
1082             },
1083             molczan => sub {
1084             my ( $file_name, $mag_factor ) = @_;
1085             $parse_file->( $file_name, $mag_factor, {
1086             mag_offset => 0,
1087             pad => 49,
1088             template => 'a5x32a5',
1089             } );
1090             return;
1091             },
1092             quicksat => sub {
1093             my ( $file_name, $mag_factor ) = @_;
1094             $parse_file->( $file_name, $mag_factor, {
1095             mag_offset => 0.7,
1096             pad => 56,
1097             template => 'a5x28a5',
1098             } );
1099             return;
1100             },
1101             show => sub {
1102             my ( @arg ) = @_;
1103             @arg
1104             or return %magnitude_table;
1105             return (
1106             map { $_ => $magnitude_table{$_} }
1107             grep { defined $magnitude_table{$_} }
1108             map { _normalize_oid( $_ ) } @arg
1109             );
1110             },
1111             );
1112              
1113             sub magnitude_table {
1114 29     29 1 286605 my ( undef, $cmd, @arg ) = @_; # Invocant not used
1115 29 50       91 my $code = $cmd_def{$cmd}
1116             or croak "'$cmd' is not a valid magnitude_table subcommand";
1117 29         64 return $code->( @arg );
1118             }
1119             }
1120              
1121             =item $time = $tle->max_effective_date(...);
1122              
1123             This method returns the maximum date among its arguments and the
1124             effective date of the $tle object as set in the C attribute,
1125             if that is defined. If no effective date is set but the C
1126             attribute is false, the C of the object is used as the effective
1127             date. If there are no arguments and no effective date, C is
1128             returned.
1129              
1130             =cut
1131              
1132             sub max_effective_date {
1133 26     26 1 103 my ($self, @args) = @_;
1134 26 100       131 if (my $effective = $self->get('effective')) {
    100          
1135 5         14 push @args, $effective;
1136             } elsif (!$self->get('backdate')) {
1137 3         9 push @args, $self->get('epoch');
1138             }
1139 26         93 return max( grep {defined $_} @args );
  31         224  
1140             }
1141              
1142             =item $tle = $tle->members();
1143              
1144             This method simply returns the object it is called on. It exists for
1145             convenience in getting back validated objects when iterating over a
1146             mixture of L and
1147             L objects.
1148              
1149             =cut
1150              
1151             sub members {
1152 0     0 1 0 return shift;
1153             }
1154              
1155             =item $tle = $tle->model($time)
1156              
1157             This method calculates the position of the body described by the TLE
1158             object at the given time, using the preferred model. As of
1159             Astro::Coord::ECI::TLE 0.010_10 this is sgp4r; previously it was sgp4 or
1160             sdp4, whichever was appropriate.
1161              
1162             The intent is that this method will use whatever model is currently
1163             preferred. If the preferred model changes, this method will use the
1164             new preferred model as soon as I:
1165              
1166             - Find out about the change;
1167             - Can get the specifications for the new model;
1168             - Can find the time to code up the new model.
1169              
1170             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1171             or equatorial ()) to retrieve the position you just calculated.
1172              
1173             =cut
1174              
1175             BEGIN {
1176 16     16   1771 *model = \&sgp4r;
1177             }
1178              
1179             =item $tle = $tle->model4 ($time)
1180              
1181             This method calculates the position of the body described by the TLE
1182             object at the given time, using either the SGP4 or SDP4 model,
1183             whichever is appropriate.
1184              
1185             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1186             or equatorial ()) to retrieve the position you just calculated.
1187              
1188             =cut
1189              
1190             sub model4 {
1191 0 0   0 1 0 return $_[0]->is_deep ? $_[0]->sdp4 ($_[1]) : $_[0]->sgp4 ($_[1]);
1192             }
1193              
1194             =item $tle = $tle->model4r ($time)
1195              
1196             This method calculates the position of the body described by the TLE
1197             object at the given time, using the "Revisiting Spacetrack Report #3"
1198             model (sgp4r). It is really just a synonym for sgp4r, which covers both
1199             near-earth and deep space bodies, but is provided for consistency's
1200             sake. If some other model becomes preferred, this method will still call
1201             sgp4r.
1202              
1203             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1204             or equatorial ()) to retrieve the position you just calculated.
1205              
1206             =cut
1207              
1208             BEGIN {
1209 16     16   30198 *model4r = \&sgp4r;
1210             }
1211              
1212             =item $tle = $tle->model8 ($time)
1213              
1214             This method calculates the position of the body described by the TLE
1215             object at the given time, using either the SGP8 or SDP8 model,
1216             whichever is appropriate.
1217              
1218             You need to call one of the Astro::Coord::ECI methods (e.g. geodetic ()
1219             or equatorial ()) to retrieve the position you just calculated.
1220              
1221             =cut
1222              
1223             sub model8 {
1224 0 0   0 1 0 return $_[0]->is_deep ? $_[0]->sdp8 ($_[1]) : $_[0]->sgp8 ($_[1]);
1225             }
1226              
1227             =item $tle = $tle->null ($time)
1228              
1229             This method does nothing. It is a valid orbital model, though. If you
1230             call $tle->set (model => 'null'), no position calculation is done as a
1231             side effect of calling $tle->universal ($time).
1232              
1233             =cut
1234              
1235 6     6 1 12 sub null { return $_[0] }
1236              
1237             =item @elements = Astro::Coord::ECI::TLE->parse( @data );
1238              
1239             This method parses NORAD two- or three-line element sets, JSON element
1240             sets, or a mixture, returning a list of Astro::Coord::ECI::TLE objects.
1241             The L section identifies those attributes which will be
1242             filled in by this method.
1243              
1244             TLE input will be split into individual lines, and all blank lines and
1245             lines beginning with '#' will be eliminated. The remaining lines are
1246             assumed to represent two- or three-line element sets, in so-called
1247             external format. Internal format (denoted by a 'G' in column 79 of line
1248             1 of the set, not counting the common name if any) is not supported,
1249             and the presence of such data will result in an exception being thrown.
1250              
1251             Input beginning with C<[{> (with optional spaces) is presumed to be
1252             NORAD JSON element sets and parsed accordingly.
1253              
1254             Optionally, the first argument (after the invocant) can be a reference
1255             to a hash of default attribute values. These are preferred over the
1256             static values, but attributes provided by the TLE or JSON input override
1257             both.
1258              
1259             =cut
1260              
1261             sub parse {
1262 15     15 1 926579 my ($self, @args) = @_;
1263 15         40 my @rslt;
1264 15 100       78 my $attrs = HASH_REF eq ref $args[0] ? shift @args : {};
1265              
1266 15         35 my @data;
1267 15         48 foreach my $datum (@args) {
1268 15 50       71 ref $datum and croak <
1269             Error - Arguments to parse() must be scalar.
1270             eod
1271 15 50       74 if ( $datum =~ m/ \A \s* \[? \s* \{ /smx ) {
1272 0         0 push @rslt, $self->_parse_json( $attrs, $datum );
1273             } else {
1274 15         168 foreach my $line (split qr{\n}, $datum) {
1275 96         413 $line =~ s/ \s+ \z //smx;
1276 96 50       242 $line =~ m/ \A \s* [#] /smx and next;
1277 96 50       301 $line and push @data, $line;
1278             }
1279             }
1280             }
1281              
1282 15         57 while (@data) {
1283 44         178 my %ele = ( %static, %{ $attrs } );
  44         264  
1284 44         132 my $name;
1285 44         86 my $line = shift @data;
1286 44         265 $line =~ s/\s+$//;
1287 44         91 my $tle = "$line\n";
1288 44 100 100     297 $line =~ m{ \A 1 (\s* [0-9]+) }smx and length $1 == 6 or do {
1289 8         27 ( $name = $line ) =~ s/ \A 0 \s+ //smx; # SpaceTrack 3le
1290 8         19 $line = shift @data;
1291 8         29 $tle .= "$line\n";
1292             };
1293 44 50 33     164 if (length ($line) > 79 && substr ($line, 79, 1) eq 'G') {
1294 0         0 croak "G (internal) format data not supported";
1295             } else {
1296 44 50 33     266 ($line =~ m/^1(\s*[0-9]+)/ && length ($1) == 6)
1297             or croak "Invalid line 1 '$line'";
1298 44 50       214 length ($line) < 80 and $line .= ' ' x (80 - length ($line));
1299              
1300 44         461 @ele{qw{id classification international epoch firstderivative
1301             secondderivative bstardrag ephemeristype elementnumber}} =
1302             unpack 'x2A5A1x1A8x1A14x1A10x1A8x1A8x1A1x1A4', $line;
1303 44         183 $ele{elementnumber} =~ s/ \A \s+ //smx;
1304              
1305 44         93 $line = shift @data;
1306 44         116 $tle .= "$line\n";
1307 44 50 33     258 ($line =~ m/^2(\s*[0-9]+)/ && length ($1) == 6)
1308             or croak "Invalid line 2 '$line'";
1309 44 100       131 length ($line) < 80 and $line .= ' ' x (80 - length ($line));
1310 44         307 @ele{qw{id_2 inclination ascendingnode eccentricity
1311             argumentofperigee meananomaly meanmotion
1312             revolutionsatepoch}} =
1313             unpack 'x2A5x1A8x1A8x1A7x1A8x1A8x1A11A5', $line;
1314              
1315 44         121 foreach my $key ( qw{ id epoch firstderivative
1316             secondderivative bstardrag ephemeristype elementnumber
1317             id_2 inclination ascendingnode eccentricity
1318             argumentofperigee meananomaly meanmotion }
1319             ) {
1320 616         1526 $ele{$key} =~ s/ \s /0/smxg;
1321             }
1322              
1323             $ele{id} == $ele{id_2} or
1324 44 50       165 croak "Invalid data. Line 1 was for id $ele{id} but ",
1325             "line 2 was for $ele{id_2}";
1326 44         92 delete $ele{id_2};
1327             }
1328 44         96 foreach (qw{eccentricity}) {
1329 44         320 $ele{$_} = "0.$ele{$_}" + 0;
1330             }
1331 44         92 foreach (qw{secondderivative bstardrag}) {
1332 88         584 $ele{$_} =~ s/(.)(.{5})(..)/$1.$2e$3/;
1333 88         301 $ele{$_} += 0;
1334             }
1335 44         92 foreach (qw{epoch}) {
1336 44         197 my ($yr, $day) = $ele{$_} =~ m/(..)(.*)/;
1337 44         158 $yr = __tle_year_to_Gregorian_year( $yr );
1338 44         180 $ele{$_} = greg_time_gm( 0, 0, 0, 1, 0, $yr ) +
1339             ( $day - 1 ) * SECSPERDAY;
1340             }
1341              
1342             # From here is conversion to the units expected by the
1343             # models.
1344              
1345 44         2123 foreach (qw{ascendingnode argumentofperigee meananomaly
1346             inclination}) {
1347 176         449 $ele{$_} *= SGP_DE2RA;
1348             }
1349 44         82 my $temp = SGP_TWOPI;
1350 44         84 foreach (qw{meanmotion firstderivative secondderivative}) {
1351 132         215 $temp /= SGP_XMNPDA;
1352 132         355 $ele{$_} *= $temp;
1353             }
1354              
1355 44         351 my $body = __PACKAGE__->new (%ele); # Note that setting the
1356             # ID does the reblessing.
1357 44         209 $body->__parse_name( $name );
1358 44         101 $body->{tle} = $tle;
1359 44         414 push @rslt, $body;
1360             }
1361              
1362 15 50       51 if ( keys %magnitude_table ) {
1363 15         61 foreach my $tle ( @rslt ) {
1364 44 50       96 defined( my $oid = $tle->get( 'id' ) )
1365             or next;
1366 44 50       100 defined $tle->get( 'intrinsic_magnitude' )
1367             and next;
1368 44 100       115 defined( my $std_mag = $magnitude_table{ _normalize_oid( $oid ) } )
1369             or next;
1370 2         7 $tle->set( intrinsic_magnitude => $std_mag +
1371             $magnitude_adjust );
1372             }
1373             }
1374 15         170 return @rslt;
1375             }
1376              
1377             sub __parse_name {
1378 44     44   92 my ( $self, $name ) = @_;
1379 44 100       143 defined $name
1380             or return;
1381 8         57 $name =~ s{ \s* -- ( effective | rcs ) \s+ ( \S+ ) }{
1382 4         31 $self->set( $1 => $2 );
1383 4         21 ''
1384             }smxge;
1385 8 50       61 $name ne ''
1386             and $self->set( name => $name );
1387 8         21 return;
1388             }
1389              
1390             # Parse information for the above from
1391             # CelesTrak "FAQs: Two-Line Element Set Format", by Dr. T. S. Kelso,
1392             # http://celestrak.org/columns/v04n03/
1393             # Per this, all data are for the NORAD SGP4/SDP4 model, except for the
1394             # first and second time derivative, which are for the simpler SGP model.
1395             # The actual documentation of the algorithms, along with a reference
1396             # implementation in FORTRAN, is available at
1397             # http://celestrak.org/NORAD/documentation/spacetrk.pdf
1398              
1399             =item @passes = $tle->pass ($station, $start, $end, \@sky)
1400              
1401             This method returns passes of the body over the given station between
1402             the given start end end times. The \@sky argument is background bodies
1403             to compute appulses with (see note 3).
1404              
1405             A pass is detected by this method when the body sets. Unless
1406             C (see below) is in effect, this means that
1407             passes are not usefully detected for geosynchronous or
1408             near-geosynchronous bodies, and that passes where the body sets after
1409             the C<$end> time will not be detected.
1410              
1411             All arguments are optional, the defaults being
1412              
1413             $station = the 'station' attribute of the invocant
1414             $start = time()
1415             $end = $start + 7 days
1416             \@sky = []
1417              
1418             The return is a list of passes, which may be empty. Each pass is
1419             represented by an anonymous hash containing the following keys:
1420              
1421             {body} => Reference to body making pass;
1422             {time} => Time of pass (culmination);
1423             {events} => [the individual events of the pass].
1424              
1425             The individual events are also anonymous hashes, with each hash
1426             containing the following keys:
1427              
1428             {azimuth} => Azimuth of event in radians (see note 1);
1429             {body} => Reference to body making pass (see note 2);
1430             {appulse} => { # This is present only for PASS_EVENT_APPULSE;
1431             {angle} => minimum separation in radians;
1432             {body} => other body involved in appulse;
1433             }
1434             {elevation} => Elevation of event in radians (see note 1);
1435             {event} => Event code (PASS_EVENT_xxxx);
1436             {illumination} => Illumination at time of event (PASS_EVENT_xxxx);
1437             {range} => Distance to event in kilometers (see note 1);
1438             {station} => Reference to observing station (see note 2);
1439             {time} => Time of event;
1440              
1441             The events are coded by the following manifest constants:
1442              
1443             PASS_EVENT_NONE => dualvar (0, '');
1444             PASS_EVENT_SHADOWED => dualvar (1, 'shdw');
1445             PASS_EVENT_LIT => dualvar (2, 'lit');
1446             PASS_EVENT_DAY => dualvar (3, 'day');
1447             PASS_EVENT_RISE => dualvar (4, 'rise');
1448             PASS_EVENT_MAX => dualvar (5, 'max');
1449             PASS_EVENT_SET => dualvar (6, 'set');
1450             PASS_EVENT_APPULSE => dualvar (7, 'apls');
1451             PASS_EVENT_START => dualvar( 11, 'start' );
1452             PASS_EVENT_END => dualvar( 12, 'end' );
1453             PASS_EVENT_BRIGHTEST => dualvar( 13, 'brgt' );
1454              
1455             The C and C events are not normally
1456             generated. You can get them in lieu of whatever events start and end the
1457             pass by setting C in the C
1458             attribute. Unless you are filtering out non-visible events, though, they
1459             are just the rise and set events under different names.
1460              
1461             The dualvar function comes from Scalar::Util, and generates values
1462             which are numeric in numeric context and strings in string context. If
1463             Scalar::Util cannot be loaded the numeric values are returned.
1464              
1465             These manifest constants can be imported using the individual names, or
1466             the tags ':constants' or ':all'. They can also be accessed as methods
1467             using (e.g.) $tle->PASS_EVENT_LIT, or as static methods using (e.g.)
1468             Astro::Coord::ECI::TLE->PASS_EVENT_LIT.
1469              
1470             Illumination is represented by one of PASS_EVENT_SHADOWED,
1471             PASS_EVENT_LIT, or PASS_EVENT_DAY. The first two are calculated based on
1472             whether the illuminating body (i.e. the body specified by the 'illum'
1473             attribute) is above the horizon; the third is based on whether the Sun
1474             is higher than specified by the 'twilight' attribute, and trumps the
1475             other two (i.e. if it's day it doesn't matter whether the satellite is
1476             illuminated).
1477              
1478             Time resolution of the events is typically to the nearest second, except
1479             for appulses, which need to be calculated more closely to detect
1480             transits. The time reported for the event is the time B the event
1481             occurred. For example, the time reported for rise is the earliest time
1482             the body is found above the horizon, and the time reported for set is
1483             the earliest time the body is found below the horizon.
1484              
1485             The operation of this method is affected by the following attributes,
1486             in addition to its arguments and the orbital elements associated with
1487             the object:
1488              
1489             * appulse # Maximum appulse to report
1490             * edge_of_earths_shadow # Used in the calculation of
1491             # whether the satellite is illuminated or in
1492             # shadow.
1493             * geometric # Use geometric horizon for pass rise/set
1494             * horizon # Effective horizon
1495             * interval # Interval for pass() positions, if positive
1496             * lazy_pass_position # {azimuth}, {elevation} and {range}
1497             # are optional if true (see note 1).
1498             * pass_threshold # Minimum elevation satellite must reach
1499             # for the pass to be reportable. If visible
1500             # is true, it must be visible above this
1501             # elevation
1502             * pass_variant # Tweak what pass() returns; currently no
1503             # effect unless 'visible' is true.
1504             * illum # Source of illumination.
1505             * twilight # Distance of illuminator below horizon
1506             * visible # Pass() reports only illuminated passes
1507              
1508             Note 1:
1509              
1510             If the C attribute is true, the {azimuth},
1511             {elevation}, and {range} keys may not be present. This attribute gives
1512             the event-calculating algorithm permission to omit these if the time of
1513             the event can be determined without computing the position of the body.
1514             Currently this happens only for events generated in response to setting
1515             the C attribute, but the user should not make this assumption
1516             in his or her own code.
1517              
1518             Typically you will only want to set this true if, after calling the
1519             C method, you are not interested in the azimuth, elevation and
1520             range, but compute the event positions in some coordinates other than
1521             azimuth, elevation, and range.
1522              
1523             Note 2:
1524              
1525             The time set in the various {body} and {station} objects is B
1526             guaranteed to be anything in particular. Specifically, it is almost
1527             certainly not the time of the event. If you make use of the {body}
1528             object you will probably need to set its time to the time of the event
1529             before you do so.
1530              
1531             Note 3:
1532              
1533             The algorithm for computing appulses has been modified slightly in
1534             version 0.056_04. This modification only applies to elements
1535             of the optional C<\@sky> array that represent artificial satellites.
1536              
1537             The problem I'm trying to address is that two satellites in very similar
1538             orbits can appear to converge again after their appulse, due to their
1539             increasing distance from the observer. If this happens early enough in
1540             the pass it can fool the binary search algorithm that determines the
1541             appulse time.
1542              
1543             The revision is to first step across the pass, finding the closest
1544             approach of the two bodies. A binary search is then done on a small
1545             interval around the closest approach.
1546              
1547             =cut
1548              
1549 16     16   171 use constant PASS_EVENT_NONE => dualvar (0, ''); # Guaranteed false.
  16         270  
  16         1741  
1550 16     16   363 use constant PASS_EVENT_SHADOWED => dualvar (1, 'shdw');
  16         36  
  16         1303  
1551 16     16   113 use constant PASS_EVENT_LIT => dualvar (2, 'lit');
  16         40  
  16         1161  
1552 16     16   94 use constant PASS_EVENT_DAY => dualvar (3, 'day');
  16         30  
  16         1130  
1553 16     16   122 use constant PASS_EVENT_RISE => dualvar (4, 'rise');
  16         28  
  16         1075  
1554 16     16   118 use constant PASS_EVENT_MAX => dualvar (5, 'max');
  16         34  
  16         1082  
1555 16     16   90 use constant PASS_EVENT_SET => dualvar (6, 'set');
  16         63  
  16         1018  
1556 16     16   143 use constant PASS_EVENT_APPULSE => dualvar (7, 'apls');
  16         29  
  16         1161  
1557 16     16   129 use constant PASS_EVENT_START => dualvar( 11, 'start' );
  16         46  
  16         1055  
1558 16     16   139 use constant PASS_EVENT_END => dualvar( 12, 'end' );
  16         39  
  16         1110  
1559 16     16   93 use constant PASS_EVENT_BRIGHTEST => dualvar( 13, 'brgt' );
  16         40  
  16         1020  
1560              
1561 16     16   102 use constant PASS_VARIANT_VISIBLE_EVENTS => 0x01;
  16         51  
  16         913  
1562 16     16   105 use constant PASS_VARIANT_FAKE_MAX => 0x02;
  16         29  
  16         868  
1563 16     16   137 use constant PASS_VARIANT_START_END => 0x04;
  16         31  
  16         756  
1564 16     16   85 use constant PASS_VARIANT_NO_ILLUMINATION => 0x08;
  16         36  
  16         729  
1565 16     16   81 use constant PASS_VARIANT_BRIGHTEST => 0x10;
  16         32  
  16         790  
1566 16     16   98 use constant PASS_VARIANT_TRUNCATE => 0x20;
  16         34  
  16         768  
1567 16     16   81 use constant PASS_VARIANT_NONE => 0x00; # Must be 0.
  16         37  
  16         2508  
1568              
1569             my @pass_variant_mask = (
1570             PASS_VARIANT_NO_ILLUMINATION | PASS_VARIANT_START_END |
1571             PASS_VARIANT_BRIGHTEST | PASS_VARIANT_TRUNCATE,
1572             PASS_VARIANT_VISIBLE_EVENTS | PASS_VARIANT_FAKE_MAX |
1573             PASS_VARIANT_START_END | PASS_VARIANT_BRIGHTEST |
1574             PASS_VARIANT_TRUNCATE,
1575             );
1576              
1577 16     16   137 use constant SCREENING_HORIZON_OFFSET => deg2rad( -3 );
  16         28  
  16         103  
1578              
1579             # ***** Promise Astro::Coord::ECI::TLE::Set that pass() only uses the
1580             # ***** public interface. That way pass() will get the Set object,
1581             # ***** and will work if we have more than one set of elements for the
1582             # ***** body, even if we switch element sets in the middle of a pass.
1583              
1584             *_nodelegate_pass = \&pass;
1585              
1586             # The following method is not supported, and may be changed or retracted
1587             # at any time without notice. Its purpose in life is to provide a handle
1588             # by which the experimental and unreleased Astro::Coord::ECI::Points
1589             # objects can manipulate the the start and end times of the pass
1590             # calculation.
1591             sub __default_pass_times {
1592 14     14   37 my ( undef, $start, $end ) = @_; # Invocant unused
1593 14 50       49 defined $start
1594             or $start = time;
1595 14 50       37 defined $end
1596             or $end = $start + 7 * SECSPERDAY;
1597 14         42 return ( $start, $end );
1598             }
1599              
1600             sub pass {
1601 14     14 1 1338 my @args = __default_station( @_ );
1602 14         31 my @sky;
1603             ARRAY_REF eq ref $args[-1]
1604 14 100       105 and @sky = @{pop @args};
  12         39  
1605 14         38 my $tle = shift @args;
1606 14         33 my $sta = shift @args;
1607              
1608             # We give subclasses a way of specifying their own default times. If
1609             # an undefined end time is returned, the subclass is stating that
1610             # there are no passes in the given range, and we simply return.
1611 14         79 my ( $pass_start, $pass_end ) = $tle->__default_pass_times(
1612             splice @args, 0, 2 );
1613 14 50       41 defined $pass_start
1614             or return;
1615              
1616 14 50       54 $pass_end >= $pass_start or croak <
1617             Error - End time must be after start time.
1618             eod
1619              
1620 14         92 $pass_start = $tle->max_effective_date($pass_start);
1621 14 50       41 $pass_start <= $pass_end or return;
1622              
1623 14         65 my @lighting = (
1624             PASS_EVENT_SHADOWED,
1625             PASS_EVENT_LIT,
1626             PASS_EVENT_DAY,
1627             );
1628 14         41 my $verbose = $tle->get ('interval');
1629 14         32 my $pass_step = 60;
1630 14         35 my $horizon = $tle->get ('horizon');
1631 14 50       36 my $effective_horizon = $tle->get ('geometric') ? 0 : $horizon;
1632 14         44 my $pass_threshold = $tle->get( 'pass_threshold' );
1633 14         34 my $twilight = $tle->get ('twilight');
1634 14         34 my $want_visible = $tle->get ('visible');
1635 14         36 my $appulse_dist = $tle->get ('appulse');
1636 14         42 my $debug = $tle->get ('debug');
1637 14 100       40 my $pass_variant = $tle->get( 'pass_variant' ) &
1638             $pass_variant_mask[ $want_visible ? 1 : 0 ];
1639 14 50       46 defined $tle->get( 'intrinsic_magnitude' )
1640             or $pass_variant &= ~ PASS_VARIANT_BRIGHTEST;
1641 14         32 my $truncate = $pass_variant & PASS_VARIANT_TRUNCATE;
1642 14 100 66     61 defined $pass_threshold
1643             and $pass_threshold > $horizon
1644             or $pass_threshold = $horizon;
1645              
1646             # We need the number of radians the satellite travels in a minute so
1647             # we can be slightly conservative determining whether the satellite
1648             # might be lit while screening for a pass.
1649             # TODO For something not in orbit the period should be undefined.
1650             # But we might call pass() on it anyway because something like a
1651             # sounding rocket would still rise and set. What we have at the
1652             # moment is a total crock, but until I can figure out something
1653             # better ...
1654 14         60 my $period = $tle->period();
1655             # TODO the next statement is the crock referred to just above
1656 14 50       55 defined $period
1657             or $period = 90 * 60; # Pretend we're in a 90 min orbit
1658 14         43 my $min_sun_elev_from_sat = - TWOPI / $period * 60;
1659              
1660             # We also want to be slightly conservative when deciding whether the
1661             # satellite passes above the horizon. Since the above is clearly too
1662             # much (since at its maximum elevation the apparent path of the
1663             # satellite is horizontal) we reduce it using a piece of pure
1664             # ad-hocery.
1665 14         39 my $screening_horizon = $horizon + SCREENING_HORIZON_OFFSET;
1666 14 50       53 $effective_horizon < $screening_horizon
1667             and $screening_horizon = $effective_horizon;
1668              
1669             # We need the sun at some point, maybe
1670              
1671 14         34 my ( $sun, $suntim, $dawn, $sun_screen, $sun_limit );
1672 14 100       78 if ( $pass_variant & PASS_VARIANT_NO_ILLUMINATION ) {
1673 1         5 $suntim = $sun_screen = $sun_limit = $pass_end + SECSPERDAY;
1674 1         3 $dawn = 1;
1675             } else {
1676 13         36 $sun = $tle->get( 'sun' );
1677 13         61 ( $suntim, $dawn, $sun_screen, $sun_limit ) =
1678             _next_elevation_screen( $sta->universal( $pass_start ),
1679             $pass_step, $sun, $twilight );
1680             }
1681              
1682             # For each time to be covered
1683              
1684 14         35 my $step = $pass_step;
1685 14         38 my $bigstep = 5 * $step;
1686 14         27 my $littlestep = $step;
1687 14         26 my $end = $pass_end;
1688 14 100       42 $truncate
1689             and $end += $littlestep;
1690 14         56 my @info; # Information on an individual pass.
1691             my @passes; # Accumulated informtion on all passes.
1692 14         0 my $visible;
1693 14         48 for (my $time = $pass_start; $time <= $end; $time += $step) {
1694              
1695             # If the current sun event has occurred, handle it and calculate
1696             # the next one.
1697              
1698 41453 100       80729 if ( $time >= $sun_limit ) {
1699 82         376 ( $suntim, $dawn, $sun_screen, $sun_limit ) =
1700             _next_elevation_screen( $sta->universal( $suntim ),
1701             $pass_step, $sun, $twilight );
1702             }
1703              
1704             # Skip if the sun is up. We set the step size small, because we
1705             # are not actually tracking the satellite so we do not know what
1706             # the appropriate size is.
1707              
1708             $want_visible
1709             and not @info
1710             and not $dawn
1711             and $time < $sun_screen
1712 41453 100 100     216209 and do {
      100        
      100        
1713 28770         42217 $step = $littlestep;
1714 28770         58583 next;
1715             };
1716              
1717             # Calculate azimuth and elevation.
1718              
1719 12683         40615 my ($azm, $elev, $rng) = $sta->azel ($tle->universal ($time));
1720              
1721             # Adjust the step size based on how far the body is below the
1722             # horizon.
1723              
1724 12683 100       38888 $step = $elev < -.4 ? $bigstep : $littlestep;
1725              
1726             # If the body is below the horizon, we check for accumulated data,
1727             # handle it if any, clear it, and on to the next iteration. We
1728             # have to make the check on effective horizon as well as screening
1729             # horizon, because maybe we are at the very end of the prediction
1730             # period and the satellite makes it below the effective horizon
1731             # but not the screening horizon before the end of the prediction
1732             # period. Sigh.
1733              
1734 12683 100 66     38480 if ( $elev < $screening_horizon
      33        
      66        
      100        
      66        
1735             || @info && $elev < $effective_horizon &&
1736             $info[-1]{elevation} >= $effective_horizon
1737             || $truncate && $time >= $pass_end
1738             ) {
1739 12022 100       27812 @info = () unless $visible;
1740 12022 100       48937 next unless @info;
1741              
1742             # We may have skipped part of the pass because it began in
1743             # daylight or before the official beginning of the prediction
1744             # period. Pick up that part now.
1745              
1746             { # Single-iteration loop.
1747 113         207 my $time = $info[0]{time} - $step;
  113         437  
1748 113 100 100     483 $truncate
1749             and $time < $pass_start
1750             and last;
1751 112         558 my ( $try_azm, $try_elev, $try_rng ) = $sta->azel (
1752             $tle->universal( $time ) );
1753 112 50       597 last if $try_elev < $effective_horizon;
1754 0 0       0 my $litup = $time < $suntim ? 2 - $dawn : 1 + $dawn;
1755 0 0 0     0 1 == $litup
1756             and not $tle->illuminated( $time )
1757             and $litup = 0;
1758 0         0 unshift @info, {
1759             azimuth => $try_azm,
1760             elevation => $try_elev,
1761             event => PASS_EVENT_NONE,
1762             illumination => $lighting[$litup],
1763             range => $try_rng,
1764             time => $time,
1765             };
1766 0         0 redo;
1767             }
1768              
1769             # Compute the exact events.
1770              
1771 113         226 my @time;
1772              
1773             # Compute exact max
1774              
1775             =begin comment
1776              
1777             {
1778             my @try;
1779             if ( @info > 1 ) {
1780             @try = (
1781             [ $info[0]{time}, $sta->azel( $tle->universal(
1782             $info[0]{time} ) ) ],
1783             [ $info[-1]{time}, $sta->azel( $tle->universal(
1784             $info[-1]{time} ) ) ],
1785             );
1786             } else {
1787             my $trial_time = $info[0]{time} - 30;
1788             push @try, [ $trial_time, $sta->azel(
1789             $tle->universal( $trial_time ) ) ];
1790             $trial_time += 60;
1791             push @try, [ $trial_time, $sta->azel(
1792             $tle->universal( $trial_time ) ) ];
1793             }
1794              
1795             while ( $try[1][0] - $try[0][0] > 0.01 ) {
1796             my $middle = ( $try[0][0] + $try[1][0] ) / 2;
1797             my $inx = $try[0][2] > $try[1][2] ? 1 : 0;
1798             splice @try, $inx, 1, [ $middle, $sta->azel(
1799             $tle->universal( $middle ) ) ];
1800             }
1801              
1802             push @time, [ floor( $try[1][0] + .5 ), PASS_EVENT_MAX ];
1803              
1804             }
1805              
1806             =end comment
1807              
1808             =cut
1809              
1810             my ( $trial_start, $trial_finish ) =
1811             ( $info[0]{time} - $pass_step,
1812 113         623 $info[-1]{time} + $pass_step
1813             );
1814 113 100       386 $truncate
1815             and ( $trial_start, $trial_finish ) = (
1816             max( $trial_start, $pass_start ),
1817             min( $trial_finish, $pass_end )
1818             );
1819             my $culmination = find_first_true( $trial_start,
1820             $trial_finish,
1821 983     983   3883 sub { ( $sta->azel( $tle->universal( $_[0] ) ) )[1] >
1822             ( $sta->azel( $tle->universal( $_[0] + 1 ) ) )[1]
1823 113         1394 });
1824 113         1069 push @time, [ $culmination, PASS_EVENT_MAX ];
1825              
1826             # Compute exact rise and set.
1827              
1828             $truncate
1829             or ( $trial_start, $trial_finish ) = (
1830 113 100       863 $info[0]{time} - $step, $info[-1]{time} + $step );
1831             my $sat_rise = find_first_true( $trial_start,
1832             $culmination,
1833 844     844   3149 sub { ( $sta->azel( $tle->universal( $_[0] ) ) )[1] >=
1834             $effective_horizon
1835             },
1836 113         1229 );
1837             my $sat_set = find_first_true ( $culmination,
1838             $trial_finish,
1839 878     878   3140 sub { ( $sta->azel( $tle->universal( $_[0] ) ) )[1] <
1840             $effective_horizon
1841             },
1842 113         1357 );
1843 113         1045 push @time,
1844             [ $sat_rise, PASS_EVENT_RISE ],
1845             [ $sat_set, PASS_EVENT_SET ],
1846             ;
1847              
1848 113 50       380 warn <<"EOD" if $debug; ## no critic (RequireCarping)
1849              
1850 0         0 Debug - Computed @{[ local_strftime '%d-%b-%Y %H:%M:%S', $time[0][0]
1851             ]} $time[0][1]
1852 0         0 @{[ local_strftime '%d-%b-%Y %H:%M:%S', $time[1][0]
1853             ]} $time[1][1]
1854 0         0 @{[ local_strftime '%d-%b-%Y %H:%M:%S', $time[2][0]
1855             ]} $time[2][1]
1856             EOD
1857              
1858             # Because we relaxed the detection criteria to be sure we
1859             # caught all passes, we may have a pass that ended before
1860             # the prediction interval started. Reject that here.
1861              
1862             $sat_set < $pass_start
1863 113 50       406 and do {
1864 0         0 @info = ();
1865 0         0 next;
1866             };
1867              
1868             # Clear the original data.
1869              
1870 113         1789 @info = ();
1871              
1872             # Generate the full data for the exact events.
1873              
1874 113         303 my ($suntim, $dawn);
1875 113 50       348 warn "Contents of \@time: ", Dumper (\@time) ## no critic (RequireCarping)
1876             if $debug;
1877 113         988 foreach (sort {$a->[0] <=> $b->[0]} @time) {
  339         1198  
1878 339         1086 my ( $time, $evnt_name, @extra ) = @$_;
1879 339         1396 my ($azm, $elev, $rng) = $sta->azel (
1880             $tle->universal ($time));
1881 339         875 my @illumination;
1882 339 100       1095 if ( $sun ) {
1883 219 100 66     1172 ($suntim, $dawn) =
1884             $sta->universal ($time)->next_elevation ($sun,
1885             $twilight)
1886             if !$suntim || $time >= $suntim;
1887 219 50       710 my $litup = $time < $suntim ? 2 - $dawn : 1 + $dawn;
1888 219 100 66     1218 1 == $litup
1889             and not $tle->illuminated( $time )
1890             and $litup = 0;
1891 219         1093 push @illumination, illumination => $lighting[$litup];
1892             }
1893 339         4778 push @info, {
1894             azimuth => $azm,
1895             body => $tle,
1896             elevation => $elev,
1897             event => $evnt_name,
1898             range => $rng,
1899             station => $sta,
1900             time => $time,
1901             @illumination,
1902             @extra,
1903             };
1904             }
1905              
1906             # Compute illumination changes
1907              
1908 113 100       448 if ( $sun ) {
1909 73         158 my @illum;
1910             my $prior;
1911 73         189 foreach my $evt ( @info ) {
1912 219 100       619 $prior or next;
1913             $prior->{illumination} == $evt->{illumination}
1914 146 100       551 and next;
1915             my ($suntim, $dawn) =
1916 36         176 $sta->universal ($prior->{time})->
1917             next_elevation ($sun, $twilight);
1918             my $time =
1919             find_first_true ($prior->{time}, $evt->{time},
1920             sub {
1921 282 50   282   760 my $litup = $_[0] < $suntim ?
1922             2 - $dawn : 1 + $dawn;
1923 282 100 66     1188 1 == $litup
1924             and not $tle->illuminated( $_[0] )
1925             and $litup = 0;
1926             $lighting[$litup] == $evt->{illumination}
1927 36         621 });
  282         2044  
1928 36         323 my ($azm, $elev, $rng) = $sta->azel (
1929             $tle->universal ($time));
1930             push @illum, {
1931             azimuth => $azm,
1932             body => $tle,
1933             elevation => $elev,
1934             event => $evt->{illumination},
1935             illumination => $evt->{illumination},
1936 36         637 range => $rng,
1937             station => $sta,
1938             time => $time,
1939             };
1940             } continue {
1941 219         496 $prior = $evt;
1942             }
1943 73         237 push @info, @illum;
1944             }
1945              
1946             # Do not record this pass if it turns out not to contain
1947             # any points that meet the recording criteria.
1948              
1949             eval { # So I can return().
1950 113         264 foreach my $event ( @info ) {
1951 319 100       903 $event->{elevation} < $pass_threshold
1952             and next;
1953             not $want_visible
1954 50 100 100     337 or $event->{illumination} == PASS_EVENT_LIT
1955             or next;
1956 47         177 return 1;
1957             }
1958 66         234 return 0;
1959 113 100       286 } or do {
1960 66         592 @info = ();
1961 66         644 next;
1962             };
1963              
1964             # Put the events created thus far into order.
1965              
1966 47         361 @info = sort { $a->{time} <=> $b->{time} } @info;
  168         450  
1967              
1968             # Compute the brightest moment if desired.
1969              
1970 47 50       162 if ( $pass_variant & PASS_VARIANT_BRIGHTEST ) {
1971              
1972 0         0 @info = sort { $a->{time} <=> $b->{time} } @info,
  0         0  
1973             _pass_compute_brightest( $tle, $sta, $sun, \@info );
1974             }
1975              
1976             # If we want visible events only
1977              
1978 47 100       162 if ( $pass_variant & PASS_VARIANT_VISIBLE_EVENTS ) {
1979              
1980             # Filter out anything that does not pass muster
1981              
1982 20         99 @info = grep { $_->{illumination} == PASS_EVENT_LIT ||
1983             $_->{event} == PASS_EVENT_SHADOWED ||
1984 70 100 66     377 $_->{event} == PASS_EVENT_DAY
1985             } @info;
1986              
1987             # If we want to fake a max event if that took place in
1988             # darkness
1989              
1990 20 100 100     97 if ( $pass_variant & PASS_VARIANT_FAKE_MAX &&
1991 41         121 ! grep { $_->{event} == PASS_EVENT_MAX } @info ) {
1992              
1993             # Given that the max got dropped, the fake max is
1994             # either the first or the last point.
1995              
1996             my ( $dup_inx, $splice_inx ) =
1997             $info[0]{elevation} > $info[-1]{elevation} ?
1998 1 50       7 ( 0, 1 ) : ( -1, -1 );
1999              
2000             # Shallow clone, and change the event code to max.
2001              
2002 1         2 my $max = { %{ $info[$dup_inx] } };
  1         9  
2003 1         4 $max->{event} = PASS_EVENT_MAX;
2004              
2005             # Insert the max either just after the first, or
2006             # just before the last event, as the case may be.
2007              
2008 1         3 splice @info, $splice_inx, 0, $max;
2009              
2010             }
2011             }
2012              
2013             # If we want the first and last events to be 'start' and
2014             # 'end', willy-nilly, hammer these codes into them.
2015              
2016 47 100       177 if ( $pass_variant & PASS_VARIANT_START_END ) {
2017 8         28 $info[0]{event} = PASS_EVENT_START;
2018 8         28 $info[-1]{event} = PASS_EVENT_END;
2019             }
2020              
2021             # If PASS_VARIANT_TRUNCATE is in effect, the first and last
2022             # events should be 'start' and 'end' IF AND ONLY IF the
2023             # satellite is above the horizon at that point AND the time
2024             # is at the start or end of the interval. Because the first
2025             # event is AFTER its exact time, we need to back up a bit
2026             # and recalculate.
2027              
2028 47 100       150 if ( $truncate ) {
2029 2         8 my $prior = $info[0]{time} - 1;
2030 2 100       11 if ( $prior <= $pass_start ) {
2031 1         8 my $elevation = ( $sta->azel(
2032             $tle->universal( $prior ) ) )[1];
2033             $elevation > $effective_horizon
2034 1 50       9 and $info[0]{event} = PASS_EVENT_START;
2035             }
2036             $info[-1]{elevation} > $effective_horizon
2037             and $info[-1]{time} >= $pass_end
2038 2 100 66     17 and $info[-1]{event} = PASS_EVENT_END;
2039             }
2040              
2041             # Pick up the first and last event times, to use to bracket
2042             # future calculations.
2043              
2044 47         131 my $first_time = $info[0]{time};
2045 47         121 my $last_time = $info[-1]{time};
2046 47         134 my $number_of_events = @info;
2047              
2048             # Compute nearest approach to background bodies
2049              
2050             # Note (fortuitous discovery) the ISS travels 1.175
2051             # degrees per second at the zenith, so I need better
2052             # than 1 second resolution to detect a transit.
2053              
2054 47         134 foreach my $body (@sky) {
2055             my $when = find_first_true(
2056             _pass_bracket_appulse( $sta, $tle, $body,
2057             $first_time, $last_time ),
2058 571     571   2434 sub {$sta->angle ($body->universal ($_[0]),
2059             $tle->universal ($_[0])) <
2060             $sta->angle ($body->universal ($_[0] + .1),
2061             $tle->universal ($_[0] + .1))},
2062 45         184 .1);
2063 45         485 my $angle =
2064             $sta->angle ($body->universal ($when),
2065             $tle->universal ($when));
2066 45 100       237 next if $angle > $appulse_dist;
2067 12         50 my ( $azimuth, $elevation, $range ) = $sta->azel( $tle );
2068 12         191 push @info, {
2069             body => $tle,
2070             event => PASS_EVENT_APPULSE,
2071             station => $sta,
2072             time => $when,
2073             azimuth => $azimuth,
2074             elevation => $elevation,
2075             range => $range,
2076             appulse => {
2077             angle => $angle,
2078             body => $body,
2079             },
2080             _find_illumination( $sun, $when, \@info ),
2081             };
2082              
2083 12 50       68 warn <<"EOD" if $debug; ## no critic (RequireCarping)
2084 0         0 $time[$#time][1] @{[ local_strftime '%d-%b-%Y %H:%M:%S',
2085             $time[$#time][0]]}
2086             EOD
2087             }
2088              
2089             # Add in the intrinsic events if there are any.
2090 47         209 foreach my $evt (
2091             $tle->intrinsic_events( $first_time, $last_time )
2092             ) {
2093 0         0 my ( $when, $event ) = @{ $evt };
  0         0  
2094 0         0 push @info, {
2095             body => $tle,
2096             event => $event,
2097             station => $sta,
2098             time => $when,
2099             _find_illumination( $sun, $when, \@info ),
2100             $tle->_find_position( $sta, $when ),
2101             };
2102             }
2103              
2104             # If we're verbose, calculate the points.
2105              
2106 47 100       165 if ( $verbose ) {
2107              
2108 2         8 my %events = map { $_->{time} => 1 } @info;
  6         31  
2109 2         47 for ( my $it = ceil( $first_time ); $it < $last_time;
2110             $it += $verbose ) {
2111              
2112             # If we already have an event for this time, skip.
2113              
2114 32 100       122 $events{$it} and next;
2115              
2116             # The next line of code relies on the fact that the
2117             # events from rise through max and set are already
2118             # in chronological order. Yes, in theory we step off
2119             # the end of that part of @info, but in practice we
2120             # exit the for loop before we get to that point.
2121              
2122 30         90 push @info, {
2123             body => $tle,
2124             event => PASS_EVENT_NONE,
2125             station => $sta,
2126             time => $it,
2127             _find_illumination( $sun, $it, \@info ),
2128             $tle->_find_position( $sta, $it ),
2129             };
2130             }
2131             }
2132              
2133             # Sort the data again if we have added events.
2134              
2135             @info > $number_of_events
2136 47 100       236 and @info = sort { $a->{time} <=> $b->{time} } @info;
  158         372  
2137              
2138             # Record the data for the pass.
2139              
2140 47 50       161 confess <
2141             Programming error - \$culmination undefined at end of pass calculation.
2142             eod
2143 47         406 push @passes, {
2144             body => $tle,
2145             events => [@info],
2146             time => $culmination,
2147             };
2148              
2149             # Clear out the data.
2150              
2151 47         123 @info = ();
2152 47         91 $visible = 0;
2153 47         101 $culmination = undef;
2154 47         525 next;
2155             }
2156              
2157             { # Localize
2158              
2159             # Calculate whether the body is visible.
2160              
2161 661         1131 my @illumination;
  661         1227  
2162 661 100       1447 if ( $sun ) {
2163 415 50       1043 my $litup = $time < $sun_screen ? 2 - $dawn : 1 + $dawn;
2164 415         1380 my $sun_elev_from_sat = $tle->__sun_elev_from_sat( $time );
2165 415   66     1615 $visible ||= $elev > $screening_horizon && (
      100        
2166             ! $want_visible ||
2167             $litup == 1 && $sun_elev_from_sat >= $min_sun_elev_from_sat
2168             );
2169 415 50       1121 $litup = $time < $suntim ? 2 - $dawn : 1 + $dawn;
2170 415 100 66     1808 $litup == 1
2171             and $sun_elev_from_sat < 0
2172             and $litup = 0;
2173 415         1745 push @illumination, illumination => $lighting[$litup];
2174             } else {
2175 246         554 $visible = $elev > $screening_horizon;
2176             }
2177              
2178             # Accumulate results.
2179              
2180 661         7779 push @info, {
2181             azimuth => $azm,
2182             elevation => $elev,
2183             event => PASS_EVENT_NONE,
2184             range => $rng,
2185             time => $time,
2186             @illumination,
2187             };
2188              
2189             }
2190              
2191             }
2192 14         268 return @passes;
2193              
2194             }
2195              
2196             # The problem the following attempts to deal with is that if two
2197             # satellites with similar orbits rise about the same time, they may
2198             # appear to approach, diverge, and approach again. The last apparent
2199             # approach is because they are receding from the observer faster than
2200             # from each other.
2201             #
2202             # What the following code attempts to do is to provide reasonable
2203             # brackets around the time of closest approach. If the body is a TLE
2204             # object, we step across the pass in 30-second intervals, and return the
2205             # interval 30 seconds before and after the closest position found.
2206             # Otherwise we just return the beginning and end of the pass.
2207             #
2208             # Originally there was an attempt to determine if the orbits were
2209             # "sufficiently close", and only step across if that was the case. But
2210             # it proved impracticable to define "sufficiently close", and it was
2211             # determined by benchmarking that the preliminary stepping had only a
2212             # minimal effect on the algorithm's execution time. So we step any time
2213             # we are computing an appulse of an artificial satellite to another
2214             # artificial satellite.
2215              
2216             {
2217              
2218             # The following manifest constant is to be used only here. Pretend
2219             # it is localized.
2220              
2221 16     16   162 use constant APPULSE_CHECK_STEP => 30; # seconds
  16         45  
  16         281293  
2222              
2223             sub _pass_bracket_appulse {
2224 45     45   154 my ( $sta, $tle, $body, $first_time, $last_time ) = @_;
2225              
2226             # The problem we're trying to avoid does not occur unless the
2227             # body is a TLE.
2228 45 100       172 embodies( $body, 'Astro::Coord::ECI::TLE' )
2229             or return ( $first_time, $last_time );
2230              
2231             # OK, we think we have a problem. Step across the entire pass in
2232             # 30-second intervals and find the one where the two bodies
2233             # approach most closely.
2234 1         4 my ( $smallest, $mark );
2235 1         6 for ( my $time = $first_time; $time <= $last_time;
2236             $time += APPULSE_CHECK_STEP
2237             ) {
2238 16         55 my $angle = $sta->angle(
2239             $body->universal( $time ),
2240             $tle->universal( $time ),
2241             );
2242 16 100 66     126 defined $smallest
2243             and $angle > $smallest
2244             or ( $smallest, $mark ) = ( $angle, $time );
2245             }
2246              
2247             # We return an interval around this closest point as the
2248             # interval in which to apply the binary search algorithm.
2249             return (
2250 1         25 max( $mark - APPULSE_CHECK_STEP, $first_time ),
2251             min( $mark + APPULSE_CHECK_STEP, $last_time ),
2252             );
2253             }
2254             }
2255              
2256             # Compute the position of the satellite at its brightest. We expect to
2257             # be called only if the computation makes sense -- that is, if the
2258             # intrinsic_magnitude attribute is set and we are calculating
2259             # visibility. We will return an event hash, or nothing if there are no
2260             # illuminated points. We will return nothing with a warning if there is
2261             # exactly one illuminated point, since we can't conveniently make the
2262             # calculation from this and it should not happen anyway.
2263             #
2264             # The arguments are:
2265             # $tle - The orbiting body
2266             # $sta - The observing body
2267             # $sun - The illuminating body (assumed defined)
2268             # $info - A reference to the array of events computed thus far, in order
2269             # by time.
2270             #
2271             # The $info array is assumed to already have visibility and visibility
2272             # events calculated.
2273             sub _pass_compute_brightest {
2274 0     0   0 my ( $tle, $sta, $sun, $info ) = @_;
2275 0         0 my @wrk = @{ $info };
  0         0  
2276              
2277             # We skip over all the un-illuminated events at the start.
2278 0         0 while ( $wrk[0]{illumination} == PASS_EVENT_SHADOWED ) {
2279 0         0 shift @wrk;
2280             @wrk
2281 0 0       0 or return;
2282             }
2283 0         0 my $earliest = $wrk[0]{time};
2284              
2285             # We want the time of the first shadowed event, since we're
2286             # illuminated up to that point.
2287 0         0 my $latest = $wrk[-1]{time};
2288 0         0 while ( $wrk[-1]{illumination} == PASS_EVENT_SHADOWED ) {
2289 0         0 $latest = $wrk[-1]{time};
2290 0         0 pop @wrk;
2291             @wrk
2292 0 0       0 or return;
2293             }
2294              
2295             # We back off a second from the time of the shadow (or set) event,
2296             # to get a time when we are illuminated and above the horizon.
2297 0         0 $latest -= 1;
2298             @wrk > 1
2299 0 0       0 or do {
2300             # carp 'No magnitude calculation done: only one illuminated position';
2301 0         0 return;
2302             };
2303              
2304             # Because the behavior is non-linear, we step through the time at
2305             # 30-second intervals, then at 1-second intervals to find the
2306             # brightest.
2307 0         0 my $twilight = $tle->get( 'twilight' );
2308 0         0 foreach my $delta ( 30, 1 ) {
2309 0         0 @wrk = ();
2310 0         0 for ( my $time = $earliest; $time <= $latest; $time += $delta ) {
2311 0         0 push @wrk, [
2312             $time,
2313             $tle->universal( $time )->magnitude( $sta ),
2314             ];
2315             }
2316             # Because our time span is probably not a multiple of our step
2317             # size, we slap the last time onto the end.
2318 0 0       0 $wrk[-1][0] < $latest
2319             and push @wrk, [
2320             $latest,
2321             $tle->universal( $latest )->magnitude( $sta ),
2322             ];
2323              
2324             # The next interval becomes the brightest and second-brightest
2325             # time found.
2326 0         0 @wrk = sort { $a->[1] <=> $b->[1] } grep { defined $_->[1] } @wrk;
  0         0  
  0         0  
2327 0         0 ( $earliest, $latest ) = sort { $a <=> $b }
2328 0         0 map { $wrk[$_][0] } 0, 1;
  0         0  
2329             }
2330              
2331             # Make up and return the event.
2332 0         0 my $time = $wrk[0][0];
2333 0         0 my ( $azm, $elev, $rng ) =
2334             $sta->azel( $tle->universal( $time ) );
2335 0         0 my ( undef, $sun_elev ) = $sta->azel( $sun->universal(
2336             $time ) );
2337 0 0       0 my $illum = $sun_elev < $twilight ?
2338             PASS_EVENT_LIT :
2339             PASS_EVENT_DAY;
2340             return {
2341 0         0 azimuth => $azm,
2342             body => $tle,
2343             elevation => $elev,
2344             event => PASS_EVENT_BRIGHTEST,
2345             illumination => $illum,
2346             magnitude => $wrk[0][1],
2347             range => $rng,
2348             station => $sta,
2349             time => $time,
2350             };
2351             }
2352              
2353             =item $kilometers = $tle->periapsis();
2354              
2355             This method returns the periapsis of the orbit, in kilometers. Since
2356             Astro::Coord::ECI::TLE objects always represent bodies orbiting the
2357             Earth, this is more usually called perigee.
2358              
2359             Note that this is the distance from the center of the Earth, not the
2360             altitude.
2361              
2362             =cut
2363              
2364             sub periapsis {
2365 8     8 1 31 my $self = shift;
2366             return $self->{&TLE_INIT}{TLE_periapsis} ||=
2367 8   66     38 (1 - $self->get('eccentricity')) * $self->semimajor();
2368             }
2369              
2370             =item $kilometers = $tle->perigee();
2371              
2372             This method is simply a synonym for periapsis().
2373              
2374             =cut
2375              
2376             *perigee = \&periapsis;
2377              
2378             =item $seconds = $tle->period ($model);
2379              
2380             This method returns the orbital period of the object in seconds using
2381             the given model. If the model is unspecified (or specified as a false
2382             value), the current setting of the 'model' attribute is used.
2383              
2384             There are actually only two period calculations available. If the model
2385             is 'sgp4r' (or its equivalents 'model' and 'model4r'), the sgp4r
2386             calculation will be used. Otherwise the calculation from the original
2387             Space Track Report Number 3 will be used. 'Otherwise' includes the case
2388             where the model is 'null'.
2389              
2390             The difference between using the original and the revised algorithm is
2391             minimal. For the objects in the sgp4-ver.tle file provided with the
2392             'Revisiting Spacetrack Report #3' code, the largest is about 50
2393             nanoseconds for OID 23333, which is in a highly eccentric orbit.
2394              
2395             The difference between using the various values of gravconst_r with
2396             sgp4r is somewhat more pronounced. Among the objects in sgp4-ver.tle the
2397             largest difference was about a millisecond, again for OID 23333.
2398              
2399             Neither of these differences seems to me significant, but I thought it
2400             would be easier to take the model into account than to explain why I did
2401             not.
2402              
2403             A note on subclassing: A body that is not in orbit should return a
2404             period of C.
2405              
2406             =cut
2407              
2408             {
2409             my %model_map = (
2410             model => \&_period_r,
2411             model4r => \&_period_r,
2412             sgp4r => \&_period_r,
2413             );
2414             sub period {
2415 52     52 1 25989 my $self = shift;
2416 52   100     494 my $code = $model_map{shift || $self->{model}} || \&_period;
2417 52         202 return $code->($self);
2418             }
2419             }
2420              
2421             # Original period calculation, recast to remove an equivocation on
2422             # where the period was cached, which caused the cache to be
2423             # ineffective.
2424              
2425             sub _period {
2426 2     2   6 my $self = shift;
2427 2   33     10 return $self->{&TLE_INIT}{TLE_period} ||= do {
2428 2         23 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
2429             my $temp = 1.5 * SGP_CK2 * (3 * cos ($self->{inclination}) ** 2 - 1) /
2430 2         18 (1 - $self->{eccentricity} * $self->{eccentricity}) ** 1.5;
2431 2         4 my $del1 = $temp / ($a1 * $a1);
2432 2         6 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD +
2433             $del1 * (1 + 134/81 * $del1)));
2434 2         4 my $del0 = $temp / ($a0 * $a0);
2435 2         4 my $xnodp = $self->{meanmotion} / (1 + $del0);
2436 2         59 SGP_TWOPI / $xnodp * SGP_XSCPMN;
2437             };
2438             }
2439              
2440             # Compute period using sgp4r's adjusted mean motion. Yes, I took
2441             # the coward's way out and initialized the model, but we use this
2442             # only if the model is sgp4r (implying that it will be initialized
2443             # anyway) or if the user explicitly asked for it.
2444              
2445             sub _period_r {
2446 50     50   159 my ($self) = @_;
2447 50   66     531 my $parm = $self->{&TLE_INIT}{TLE_sgp4r} ||= $self->_r_sgp4init ();
2448 50         774 return &SGP_TWOPI/$parm->{meanmotion} * 60;
2449             }
2450              
2451             =item $tle = $tle->rebless ($class, \%possible_attributes)
2452              
2453             This method reblesses a TLE object. The class must be either
2454             L or a subclass thereof, as must
2455             the object passed in to be reblessed. If the $tle object has its
2456             C attribute false, it will not be reblessed,
2457             but will be returned unmodified. Before reblessing, the
2458             before_reblessing() method is called. After reblessing, the
2459             after_reblessing() method is called with the \%possible_attributes hash
2460             reference as argument.
2461              
2462             It is possible to omit the $class argument if the \%possible_attributes
2463             argument contains the keys {class} or {type}, taken in that order. If
2464             the $class argument is omitted and the \%possible_attributes hash does
2465             B have the requisite keys, the $tle object is unmodified.
2466              
2467             It is also possible to omit both arguments, in which case the object
2468             will be reblessed according to the content of the internal status
2469             table.
2470              
2471             For convenience, you can pass an alias instead of the full class name. The
2472             following aliases are recognized:
2473              
2474             tle => 'Astro::Coord::ECI::TLE'
2475              
2476             If you install
2477             L it
2478             will define alias
2479              
2480             iridium => 'Astro::Coord::ECI::TLE::Iridium'
2481              
2482             Other aliases may be defined with the alias() static method.
2483              
2484             Note that this method returns the original object (possibly reblessed).
2485             It does not under any circumstances manufacture another object.
2486              
2487             =cut
2488              
2489             sub rebless {
2490 87     87 1 185 my ($tle, @args) = @_;
2491 87 50       242 __instance( $tle, __PACKAGE__ ) or croak <
2492 0         0 Error - You can only rebless an object of class @{[__PACKAGE__]}
2493             or a subclass thereof. The object you are trying to rebless
2494 0         0 is of class @{[ref $tle]}.
2495             eod
2496 87 50       260 $tle->get ('reblessable') or return $tle;
2497 87 50       186 @args or do {
2498 87 50       184 my $id = $tle->get ('id') or return $tle;
2499 87 50       476 $id =~ m/ [^0-9] /smx
2500             or $id = sprintf '%05d', $id;
2501 87   50     387 @args = $status{$id} || 'tle';
2502             };
2503             my $class = HASH_REF eq ref $args[0] ?
2504 87 50 0     273 ($args[0]->{class} || $args[0]->{type}) : shift @args
    50          
2505             or return $tle;
2506 87 50       326 $class = $type_map{$class} if $type_map{$class};
2507 87         244 load_module ($class);
2508 87 50       198 __classisa( $class, __PACKAGE__ ) or croak <
2509 0         0 Error - You can only rebless an object into @{[__PACKAGE__]} or
2510             a subclass thereof. You are trying to rebless the object
2511             into $class.
2512             eod
2513 87         372 $tle->before_reblessing ();
2514 87         153 bless $tle, $class;
2515 87         234 $tle->after_reblessing (@args);
2516 87         172 return $tle;
2517             }
2518              
2519             =item $kilometers = $tle->semimajor();
2520              
2521             This method calculates the semimajor axis of the orbit, using Kepler's
2522             Third Law (Isaac Newton's version) in the form
2523              
2524             T ** 2 / a ** 3 = 4 * pi ** 2 / mu
2525              
2526             where
2527              
2528             T is the orbital period,
2529             a is the semimajor axis of the orbit,
2530             pi is the circle ratio (3.14159 ...), and
2531             mu is the Earth's gravitational constant,
2532             3.986005e5 km ** 3 / sec ** 2
2533              
2534             The calculation is carried out using the period implied by the current
2535             model.
2536              
2537             =cut
2538              
2539             {
2540             my $mu = 3.986005e5; # km ** 3 / sec ** 2 -- for Earth.
2541             sub semimajor {
2542 12     12 1 22 my $self = shift;
2543 12   66     61 return $self->{&TLE_INIT}{TLE_semimajor} ||= do {
2544 4         10 my $to2pi = $self->period / SGP_TWOPI;
2545 4         18 exp (log ($to2pi * $to2pi * $mu) / 3);
2546             };
2547             }
2548             }
2549              
2550             =item $kilometers = $tle->semiminor();
2551              
2552             This method calculates the semiminor axis of the orbit, using the
2553             semimajor axis and the eccentricity, by the equation
2554              
2555             b = a * sqrt(1 - e)
2556              
2557             where a is the semimajor axis and e is the eccentricity.
2558              
2559             =cut
2560              
2561             sub semiminor {
2562 0     0 1 0 my $self = shift;
2563 0   0     0 return $self->{&TLE_INIT}{TLE_semiminor} ||= do {
2564 0         0 my $e = $self->get('eccentricity');
2565 0         0 $self->semimajor() * sqrt(1 - $e * $e);
2566             };
2567             }
2568              
2569             =item $tle->set (attribute => value ...)
2570              
2571             This method sets the values of the various attributes. The changing of
2572             attributes actually used by the orbital models will cause the models to
2573             be reinitialized. This happens transparently, and is no big deal. For
2574             a description of the attributes, see L.
2575              
2576             Because this is a subclass of L,
2577             any attributes of that class can also be set.
2578              
2579             =cut
2580              
2581             sub set {
2582 216     216 1 5086 my ($self, @args) = @_;
2583 216 50       581 @args % 2 and croak "The set method takes an even number of arguments.";
2584 216         388 my ($clear, $extant);
2585 216 50       450 if (ref $self) {
2586 216         368 $extant = \%attrib;
2587             } else {
2588 0         0 $self = $extant = \%static;
2589             }
2590 216         477 while (@args) {
2591 2112         3174 my $name = shift @args;
2592 2112         3317 my $val = shift @args;
2593 2112 100       4172 exists $extant->{$name} or do {
2594 194         671 $self->SUPER::set ($name, $val);
2595 194         449 next;
2596             };
2597 1918 50       3719 defined $attrib{$name} or croak "Attribute $name is read-only.";
2598 1918 100       3426 if ( CODE_REF eq ref $attrib{$name} ) {
2599 684 100       1571 $attrib{$name}->($self, $name, $val) and $clear = 1;
2600             } else {
2601 1234         2372 $self->{$name} = $val;
2602 1234   100     3087 $clear ||= $attrib{$name};
2603             }
2604             }
2605 216 100       581 $clear and delete $self->{&TLE_INIT};
2606 216         427 return $self;
2607             }
2608              
2609             =item Astro::Coord::ECI::TLE->status (command => arguments ...)
2610              
2611             This method maintains the internal status table, which is used by the
2612             parse() method to determine which subclass (if any) to bless the
2613             created object into. The first argument determines what is done to the
2614             status table; subsequent arguments depend on the first argument. Valid
2615             commands and arguments are:
2616              
2617             status (add => $id, $type => $status, $name, $comment) adds an item to
2618             the status table or modifies an existing item. The $id is the NORAD ID
2619             of the body.
2620              
2621             No types are supported out of the box, but if you have installed
2622             L that
2623             or C<'iridium'> will work.
2624              
2625             The $status is 0, 1, 2, or 3 representing in-service, spare, failed, or
2626             decayed respectively. The strings '+' or '' will be interpreted as 0,
2627             'S', 's', or '?' as 1, 'D' as 3, and any other non-numeric string as 2.
2628             The $name and $comment arguments default to empty.
2629              
2630             status ('clear') clears the status table.
2631              
2632             status (clear => 'type') clears all entries of the given type in the
2633             status table. For supported types, see the discussion of 'add',
2634             above.
2635              
2636             status (drop => $id) removes the given NORAD ID from the status table.
2637              
2638             status ('show') returns a list of list references, representing the
2639             'add' commands which would be used to regenerate the status table.
2640              
2641             Initially, the status table is populated with the status as of December
2642             3, 2010.
2643              
2644             =cut
2645              
2646             sub status {
2647 0     0 1 0 my ( undef, $cmd, @arg ) = @_; # Invocant unused
2648 0 0       0 if ($cmd eq 'add') {
    0          
    0          
    0          
    0          
    0          
2649 0         0 my ( $id, $type, $status, $name, $comment ) = @arg;
2650 0 0       0 $id or croak <
2651             Error - The status ('add') call requires a NORAD ID.
2652             eod
2653 0 0       0 $id =~ m/ [^0-9] /smx
2654             or $id = sprintf '%05d', $id;
2655 0 0       0 $type or croak <
2656             Error - The status (add => $id) call requires a type.
2657             eod
2658 0   0     0 my $class = $type_map{$type} || $type;
2659 0 0       0 __classisa( $class, __PACKAGE__ ) or croak <
2660 0         0 Error - $type must specify a subclass of @{[__PACKAGE__]}.
2661             eod
2662 0   0     0 $status ||= 0;
2663 0 0       0 if ( my $code = $class->can( '__decode_operational_status' ) ) {
2664 0         0 $status = $code->( $status );
2665             }
2666 0   0     0 $name ||= '';
2667 0   0     0 $comment ||='';
2668 0         0 $status{$id} = {
2669             comment => $comment,
2670             status => $status,
2671             name => $name,
2672             id => $id,
2673             type => $type,
2674             class => $class,
2675             };
2676             } elsif ($cmd eq 'clear') {
2677 0         0 my ( $type ) = @arg;
2678 0 0       0 if (!defined $type) {
2679 0         0 %status = ();
2680             } else {
2681 0   0     0 my $class = $type_map{$type} || $type;
2682 0 0       0 __classisa( $class, __PACKAGE__ ) or croak <
2683 0         0 Error - $type must specify a subclass of @{[__PACKAGE__]}.
2684             eod
2685 0         0 foreach my $key (keys %status) {
2686 0 0       0 $status{$key}{class} eq $class and delete $status{$key};
2687             }
2688             }
2689             } elsif ($cmd eq 'drop') {
2690 0 0       0 my $id = $arg[0] or croak <
2691             Error - The status ('drop') call requires a NORAD ID.
2692             eod
2693 0         0 delete $status{$id};
2694             } elsif ($cmd eq 'dump') { # <<<< Undocumented!!!
2695             # This functionality is UNDOCUMENTED and UNSUPPORTED. It exists
2696             # for the convenience of the author, who reserves the right to
2697             # change or revoke it without notice.
2698             # If called in void context, prints a Data::Dumper dump of the
2699             # status information; otherwise returns the dump.
2700 0         0 local $Data::Dumper::Terse = 1;
2701 0         0 local $Data::Dumper::Sortkeys = 1;
2702             my $data = @arg ?
2703 0 0       0 +{ map { $_ => $status{$_} } grep { $status{$_} } @arg } :
  0         0  
  0         0  
2704             \%status;
2705             defined wantarray
2706 0 0       0 and return __PACKAGE__ . ' status = ', Dumper( $data );
2707 0         0 print __PACKAGE__, " status = ", Dumper ( $data );
2708             } elsif ($cmd eq 'show') {
2709             return (
2710 0         0 sort { $a->[0] <=> $b->[0] }
2711             map { [ $_->{id}, $_->{type}, $_->{status}, $_->{name},
2712 0         0 $_->{comment} ] }
2713 0 0       0 map { defined $status{$_} ? $status{$_} : () }
  0 0       0  
2714             @arg ? @arg : keys %status
2715             );
2716             } elsif ($cmd eq 'yaml') { # <<<< Undocumented!!!
2717             # This functionality is UNDOCUMENTED and UNSUPPORTED. It exists
2718             # for the convenience of the author, who reserves the right to
2719             # change or revoke it without notice.
2720             # If called in void context, prints a YAML dump of the status
2721             # information; otherwise returns the YAML dump.
2722 0 0       0 load_module( 'YAML' )
2723             or croak 'YAML not available';
2724             my $data = @arg ?
2725 0 0       0 +{ map { $_ => $status{$_} } grep { $status{$_} } @arg } :
  0         0  
  0         0  
2726             \%status;
2727             defined wantarray
2728 0 0       0 and return YAML::Dump( $data );
2729 0         0 print YAML::Dump( $data );
2730             } else {
2731 0         0 croak <
2732             Error - '$cmd' is not a legal status() command.
2733             eod
2734             }
2735 0         0 return;
2736             }
2737              
2738             =item $tle = $tle->sgp($time)
2739              
2740             This method calculates the position of the body described by the TLE
2741             object at the given time, using the SGP model. The universal time of the
2742             object is set to $time, and the 'equinox_dynamical' attribute is set to
2743             to the current value of the 'epoch_dynamical' attribute.
2744              
2745             The result is the original object reference. You need to call one of
2746             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
2747             retrieve the position you just calculated.
2748              
2749             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
2750             model can be used for either near-earth or deep-space orbits, but the
2751             reference implementation they provide dies on an attempt to use this
2752             model for a deep-space object, and I have followed the reference
2753             implementation.
2754              
2755             =cut
2756              
2757             sub sgp {
2758 7     7 1 19 my ($self, $time) = @_;
2759 7         19 my $oid = $self->get('id');
2760 7         20 $self->{model_error} = undef;
2761 7         23 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
2762              
2763             #* Initialization.
2764              
2765             #>>> Rather than use a separate indicator argument to trigger
2766             #>>> initialization of the model, we use the Orcish maneuver to
2767             #>>> retrieve the results of initialization, performing the
2768             #>>> calculations if needed. -- TRW
2769              
2770 7   66     45 my $parm = $self->{&TLE_INIT}{TLE_sgp} ||= do {
2771 2 50       11 $self->is_deep and croak <
2772             Error - The SGP model is not valid for deep space objects.
2773             Use the SDP4, SDP4R, or SDP8 models instead.
2774             EOD
2775 2         7 my $c1 = SGP_CK2 * 1.5;
2776 2         23 my $c2 = SGP_CK2 / 4;
2777 2         5 my $c3 = SGP_CK2 / 2;
2778 2         5 my $c4 = SGP_XJ3 * SGP_AE ** 3 / (4 * SGP_CK2);
2779 2         7 my $cosi0 = cos ($self->{inclination});
2780 2         7 my $sini0 = sin ($self->{inclination});
2781 2         9 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
2782             my $d1 = $c1 / $a1 / $a1 * (3 * $cosi0 * $cosi0 - 1) /
2783 2         16 (1 - $self->{eccentricity} * $self->{eccentricity}) ** 1.5;
2784 2         11 my $a0 = $a1 *
2785             (1 - 1/3 * $d1 - $d1 * $d1 - 134/81 * $d1 * $d1 * $d1);
2786 2         22 my $p0 = $a0 * (1 - $self->{eccentricity} * $self->{eccentricity});
2787 2         6 my $q0 = $a0 * (1 - $self->{eccentricity});
2788             my $xlo = $self->{meananomaly} + $self->{argumentofperigee} +
2789 2         8 $self->{ascendingnode};
2790 2         7 my $d10 = $c3 * $sini0 * $sini0;
2791 2         6 my $d20 = $c2 * (7 * $cosi0 * $cosi0 - 1);
2792 2         5 my $d30 = $c1 * $cosi0;
2793 2         4 my $d40 = $d30 * $sini0;
2794 2         6 my $po2no = $self->{meanmotion} / ($p0 * $p0);
2795 2         19 my $omgdt = $c1 * $po2no * (5 * $cosi0 * $cosi0 - 1);
2796 2         32 my $xnodot = -2 * $d30 * $po2no;
2797 2         43 my $c5 = .5 * $c4 * $sini0 * (3 + 5 * $cosi0) / (1 + $cosi0);
2798 2         7 my $c6 = $c4 * $sini0;
2799 2 50       10 $self->{debug} and warn <
2800             Debug sgp initialization -
2801             A0 = $a0
2802             C5 = $c5
2803             C6 = $c6
2804             D10 = $d10
2805             D20 = $d20
2806             D30 = $d30
2807             D40 = $d40
2808             OMGDT = $omgdt
2809             Q0 = $q0
2810             XLO = $xlo
2811             XNODOT = $xnodot
2812             eod
2813             {
2814 2         46 a0 => $a0,
2815             c5 => $c5,
2816             c6 => $c6,
2817             d10 => $d10,
2818             d20 => $d20,
2819             d30 => $d30,
2820             d40 => $d40,
2821             omgdt => $omgdt,
2822             q0 => $q0,
2823             xlo => $xlo,
2824             xnodot => $xnodot,
2825             };
2826             };
2827              
2828             #* Update for secular gravity and atmospheric drag.
2829              
2830             my $a = $self->{meanmotion} +
2831             (2 * $self->{firstderivative} +
2832 7         29 3 * $self->{secondderivative} * $tsince) * $tsince;
2833             # $a is only magic inside certain constructions, but Perl::Critic
2834             # either does not know this, or does not realize that it is a
2835             # lexical variable here.
2836             $a = ## no critic (RequireLocalizedPunctuationVars)
2837 7         26 $parm->{a0} * ($self->{meanmotion} / $a) ** SGP_TOTHRD;
2838 7 100       27 my $e = $a > $parm->{q0} ? 1 - $parm->{q0} / $a : SGP_E6A;
2839 7         15 my $p = $a * (1 - $e * $e);
2840 7         17 my $xnodes = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
2841 7         16 my $omgas = $self->{argumentofperigee} + $parm->{omgdt} * $tsince;
2842             my $xls = mod2pi ($parm->{xlo} + ($self->{meanmotion} + $parm->{omgdt} +
2843             $parm->{xnodot} + ($self->{firstderivative} +
2844 7         43 $self->{secondderivative} * $tsince) * $tsince) * $tsince);
2845 7 50       22 $self->{debug} and warn <
2846             Debug sgp - atmospheric drag and gravity
2847             TSINCE = $tsince
2848             A = $a
2849             E = $e
2850             P = $p
2851             XNODES = $xnodes
2852             OMGAS = $omgas
2853             XLS = $xls
2854             eod
2855              
2856             #* Long period periodics.
2857              
2858 7         46 my $axnsl = $e * cos ($omgas);
2859 7         22 my $aynsl = $e * sin ($omgas) - $parm->{c6} / $p;
2860 7         24 my $xl = mod2pi ($xls - $parm->{c5} / $p * $axnsl);
2861 7 50       19 $self->{debug} and warn <
2862             Debug sgp - long period periodics
2863             AXNSL = $axnsl
2864             AYNSL = $aynsl
2865             XL = $xl
2866             eod
2867              
2868             #* Solve Kepler's equation.
2869              
2870 7         20 my $u = mod2pi ($xl - $xnodes);
2871 7         21 my ($item3, $eo1, $tem5) = (0, $u, 1);
2872 7         12 my ($sineo1, $coseo1);
2873 7         11 while (1) {
2874 27         46 $sineo1 = sin ($eo1);
2875 27         70 $coseo1 = cos ($eo1);
2876 27 100 66     123 last if abs ($tem5) < SGP_E6A || $item3++ >= 10;
2877 20         37 $tem5 = 1 - $coseo1 * $axnsl - $sineo1 * $aynsl;
2878 20         34 $tem5 = ($u - $aynsl * $coseo1 + $axnsl * $sineo1 - $eo1) / $tem5;
2879 20         32 my $tem2 = abs ($tem5);
2880 20 100       47 $tem2 > 1 and $tem5 = $tem2 / $tem5;
2881 20         41 $eo1 += $tem5;
2882             }
2883 7 50       23 $self->{debug} and warn <
2884             Debug sgp - solve equation of Kepler
2885             U = $u
2886             EO1 = $eo1
2887             SINEO1 = $sineo1
2888             COSEO1 = $coseo1
2889             eod
2890              
2891             #* Short period preliminary quantities.
2892              
2893 7         15 my $ecose = $axnsl * $coseo1 + $aynsl * $sineo1;
2894 7         14 my $esine = $axnsl * $sineo1 - $aynsl * $coseo1;
2895 7         12 my $el2 = $axnsl * $axnsl + $aynsl * $aynsl;
2896             $self->{debug}
2897 7 50       20 and warn "Debug - OID $oid sgp effective eccentricity $el2\n";
2898 7 100       577 $el2 > 1 and croak "Error - OID $oid Sgp effective eccentricity > 1";
2899 5         13 my $pl = $a * (1 - $el2);
2900 5         7 my $pl2 = $pl * $pl;
2901 5         11 my $r = $a * (1 - $ecose);
2902 5         11 my $rdot = SGP_XKE * sqrt ($a) / $r * $esine;
2903 5         11 my $rvdot = SGP_XKE * sqrt ($pl) / $r;
2904 5         12 my $temp = $esine / (1 + sqrt (1 - $el2));
2905 5         41 my $sinu = $a / $r * ($sineo1 - $aynsl - $axnsl * $temp);
2906 5         10 my $cosu = $a / $r * ($coseo1 - $axnsl + $aynsl * $temp);
2907 5         16 my $su = _actan ($sinu, $cosu);
2908 5 50       13 $self->{debug} and warn <
2909             Debug sgp - short period preliminary quantities
2910             PL2 = $pl2
2911             R = $r
2912             RDOT = $rdot
2913             RVDOT = $rvdot
2914             SINU = $sinu
2915             COSU = $cosu
2916             SU = $su
2917             eod
2918              
2919             #* Update for short periodics.
2920              
2921 5         10 my $sin2u = ($cosu + $cosu) * $sinu;
2922 5         11 my $cos2u = 1 - 2 * $sinu * $sinu;
2923 5         13 my $rk = $r + $parm->{d10} / $pl * $cos2u;
2924 5         11 my $uk = $su - $parm->{d20} / $pl2 * $sin2u;
2925 5         13 my $xnodek = $xnodes + $parm->{d30} * $sin2u / $pl2;
2926 5         21 my $xinck = $self->{inclination} + $parm->{d40} / $pl2 * $cos2u;
2927              
2928             #* Orientation vectors.
2929              
2930 5         12 my $sinuk = sin ($uk);
2931 5         11 my $cosuk = cos ($uk);
2932 5         15 my $sinnok = sin ($xnodek);
2933 5         10 my $cosnok = cos ($xnodek);
2934 5         8 my $sinik = sin ($xinck);
2935 5         10 my $cosik = cos ($xinck);
2936 5         10 my $xmx = - $sinnok * $cosik;
2937 5         11 my $xmy = $cosnok * $cosik;
2938 5         10 my $ux = $xmx * $sinuk + $cosnok * $cosuk;
2939 5         11 my $uy = $xmy * $sinuk + $sinnok * $cosuk;
2940 5         7 my $uz = $sinik * $sinuk;
2941 5         9 my $vx = $xmx * $cosuk - $cosnok * $sinuk;
2942 5         10 my $vy = $xmy * $cosuk - $sinnok * $sinuk;
2943 5         10 my $vz = $sinik * $cosuk;
2944              
2945             #* Position and velocity.
2946              
2947 5         9 my $x = $rk * $ux;
2948 5         10 my $y = $rk * $uy;
2949 5         9 my $z = $rk * $uz;
2950 5         9 my $xdot = $rdot * $ux;
2951 5         9 my $ydot = $rdot * $uy;
2952 5         8 my $zdot = $rdot * $uz;
2953 5         9 $xdot = $rvdot * $vx + $xdot;
2954 5         9 $ydot = $rvdot * $vy + $ydot;
2955 5         9 $zdot = $rvdot * $vz + $zdot;
2956              
2957 5         16 return _convert_out($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
2958             }
2959              
2960             =item $tle = $tle->sgp4($time)
2961              
2962             This method calculates the position of the body described by the TLE
2963             object at the given time, using the SGP4 model. The universal time of
2964             the object is set to $time, and the 'equinox_dynamical' attribute is set
2965             to the current value of the 'epoch_dynamical' attribute.
2966              
2967             The result is the original object reference. See the L
2968             heading above for how to retrieve the coordinates you just calculated.
2969              
2970             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
2971             model can be used only for near-earth orbits.
2972              
2973             =cut
2974              
2975             sub sgp4 {
2976 7     7 1 19 my ($self, $time) = @_;
2977 7         19 my $oid = $self->get('id');
2978 7         17 $self->{model_error} = undef;
2979 7         29 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
2980              
2981             #>>> Rather than use a separate indicator argument to trigger
2982             #>>> initialization of the model, we use the Orcish maneuver to
2983             #>>> retrieve the results of initialization, performing the
2984             #>>> calculations if needed. -- TRW
2985              
2986 7   66     43 my $parm = $self->{&TLE_INIT}{TLE_sgp4} ||= do {
2987 2 50       9 $self->is_deep and croak <
2988             Error - The SGP4 model is not valid for deep space objects.
2989             Use the SDP4, SDP4R or SDP8 models instead.
2990             EOD
2991              
2992             #* Recover original mean motion (XNODP) and semimajor axis (AODP)
2993             #* from input elements.
2994              
2995 2         11 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
2996 2         5 my $cosi0 = cos ($self->{inclination});
2997 2         5 my $theta2 = $cosi0 * $cosi0;
2998 2         8 my $x3thm1 = 3 * $theta2 - 1;
2999 2         6 my $eosq = $self->{eccentricity} * $self->{eccentricity};
3000 2         5 my $beta02 = 1 - $eosq;
3001 2         6 my $beta0 = sqrt ($beta02);
3002 2         7 my $del1 = 1.5 * SGP_CK2 * $x3thm1 / ($a1 * $a1 * $beta0 * $beta02);
3003 2         11 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD + $del1 * (1 + 134
3004             / 81 * $del1)));
3005 2         5 my $del0 = 1.5 * SGP_CK2 * $x3thm1 / ($a0 * $a0 * $beta0 * $beta02);
3006 2         5 my $xnodp = $self->{meanmotion} / (1 + $del0);
3007 2         5 my $aodp = $a0 / (1 - $del0);
3008              
3009             #* Initialization
3010              
3011             #* For perigee less than 220 kilometers, the ISIMP flag is set and
3012             #* the equations are truncated to linear variation in sqrt(A) and
3013             #* quadratic variation in mean anomaly. Also, the C3 term, the
3014             #* delta omega term, and the delta M term are dropped.
3015              
3016             #>>> Note that the original code sets ISIMP to 1 or 0, but we just
3017             #>>> set $isimp to true or false. - TRW
3018              
3019 2         7 my $isimp = ($aodp * (1 - $self->{eccentricity}) / SGP_AE) <
3020             (220 / SGP_XKMPER + SGP_AE);
3021              
3022             #* For perigee below 156 KM, the values of
3023             #* S and QOMS2T are altered.
3024              
3025 2         4 my $s4 = SGP_S;
3026 2         6 my $qoms24 = SGP_QOMS2T;
3027 2         6 my $perige = ($aodp * (1 - $self->{eccentricity}) - SGP_AE) *
3028             SGP_XKMPER;
3029 2 50       9 unless ($perige >= 156) {
3030 0 0       0 $s4 = $perige > 98 ? $perige - 78 : 20;
3031 0         0 $qoms24 = ((120 - $s4) * SGP_AE / SGP_XKMPER) ** 4;
3032 0         0 $s4 = $s4 / SGP_XKMPER + SGP_AE;
3033             }
3034 2         34 my $pinvsq = 1 / ($aodp * $aodp * $beta02 * $beta02);
3035 2         5 my $tsi = 1 / ($aodp - $s4);
3036 2         5 my $eta = $aodp * $self->{eccentricity} * $tsi;
3037 2         5 my $etasq = $eta * $eta;
3038 2         6 my $eeta = $self->{eccentricity} * $eta;
3039 2         5 my $psisq = abs (1 - $etasq);
3040 2         6 my $coef = $qoms24 * $tsi ** 4;
3041 2         6 my $coef1 = $coef / $psisq ** 3.5;
3042 2         11 my $c2 = $coef1 * $xnodp * ($aodp * (1 + 1.5 * $etasq + $eeta *
3043             (4 + $etasq)) + .75 * SGP_CK2 * $tsi / $psisq * $x3thm1
3044             * (8 + 3 * $etasq * (8 + $etasq)));
3045 2         6 my $c1 = $self->{bstardrag} * $c2;
3046 2         5 my $sini0 = sin ($self->{inclination});
3047 2         3 my $a3ovk2 = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
3048             my $c3 = $coef * $tsi * $a3ovk2 * $xnodp * SGP_AE * $sini0 /
3049 2         6 $self->{eccentricity};
3050 2         5 my $x1mth2 = 1 - $theta2;
3051             my $c4 = 2 * $xnodp * $coef1 * $aodp * $beta02 * ($eta * (2 + .5
3052             * $etasq) + $self->{eccentricity} * (.5 + 2 * $etasq) -
3053             2 * SGP_CK2 * $tsi / ($aodp * $psisq) * (-3 * $x3thm1 * (1 -
3054             2 * $eeta + $etasq * (1.5 - .5 * $eeta)) + .75 *
3055             $x1mth2 * (2 * $etasq - $eeta * (1 + $etasq)) * cos (2 *
3056 2         27 $self->{argumentofperigee})));
3057 2         7 my $c5 = 2 * $coef1 * $aodp * $beta02 * (1 + 2.75 * ($etasq +
3058             $eeta) + $eeta * $etasq);
3059 2         5 my $theta4 = $theta2 * $theta2;
3060 2         5 my $temp1 = 3 * SGP_CK2 * $pinvsq * $xnodp;
3061 2         5 my $temp2 = $temp1 * SGP_CK2 * $pinvsq;
3062 2         6 my $temp3 = 1.25 * SGP_CK4 * $pinvsq * $pinvsq * $xnodp;
3063 2         9 my $xmdot = $xnodp + .5 * $temp1 * $beta0 * $x3thm1 + .0625 *
3064             $temp2 * $beta0 * (13 - 78 * $theta2 + 137 * $theta4);
3065 2         4 my $x1m5th = 1 - 5 * $theta2;
3066 2         189 my $omgdot = -.5 * $temp1 * $x1m5th + .0625 * $temp2 * (7 - 114
3067             * $theta2 + 395 * $theta4) + $temp3 * (3 - 36 * $theta2 + 49
3068             * $theta4);
3069 2         7 my $xhdot1 = - $temp1 * $cosi0;
3070 2         11 my $xnodot = $xhdot1 + (.5 * $temp2 * (4 - 19 * $theta2) + 2 *
3071             $temp3 * (3 - 7 * $theta2)) * $cosi0;
3072             my $omgcof = $self->{bstardrag} * $c3 * cos
3073 2         9 ($self->{argumentofperigee});
3074 2         7 my $xmcof = - SGP_TOTHRD * $coef * $self->{bstardrag} * SGP_AE / $eeta;
3075 2         7 my $xnodcf = 3.5 * $beta02 * $xhdot1 * $c1;
3076 2         5 my $t2cof = 1.5 * $c1;
3077 2         9 my $xlcof = .125 * $a3ovk2 * $sini0 * (3 + 5 * $cosi0) / (1 + $cosi0);
3078 2         4 my $aycof = .25 * $a3ovk2 * $sini0;
3079 2         8 my $delmo = (1 + $eta * cos ($self->{meananomaly})) ** 3;
3080 2         6 my $sinmo = sin ($self->{meananomaly});
3081 2         5 my $x7thm1 = 7 * $theta2 - 1;
3082 2         6 my ($d2, $d3, $d4, $t3cof, $t4cof, $t5cof);
3083 2 50       6 $isimp or do {
3084 0         0 my $c1sq = $c1 * $c1;
3085 0         0 $d2 = 4 * $aodp * $tsi * $c1sq;
3086 0         0 my $temp = $d2 * $tsi * $c1 / 3;
3087 0         0 $d3 = (17 * $aodp + $s4) * $temp;
3088 0         0 $d4 = .5 * $temp * $aodp * $tsi * (221 * $aodp + 31 * $s4) * $c1;
3089 0         0 $t3cof = $d2 + 2 * $c1sq;
3090 0         0 $t4cof = .25 * (3 * $d3 * $c1 * (12 * $d2 + 10 * $c1sq));
3091 0         0 $t5cof = .2 * (3 * $d4 + 12 * $c1 * $d3 + 6 * $d2 * $d2 + 15
3092             * $c1sq * ( 2 * $d2 + $c1sq));
3093             };
3094 2 50       8 $self->{debug} and print <
3095             Debug SGP4 - Initialize
3096             AODP = $aodp
3097             AYCOF = $aycof
3098             C1 = $c1
3099             C4 = $c4
3100             C5 = $c5
3101             COSIO = $cosi0
3102 0 0       0 D2 = @{[defined $d2 ? $d2 : 'undef']}
3103 0 0       0 D3 = @{[defined $d3 ? $d3 : 'undef']}
3104 0 0       0 D4 = @{[defined $d4 ? $d4 : 'undef']}
3105             DELMO = $delmo
3106             ETA = $eta
3107             ISIMP = $isimp
3108             OMGCOF = $omgcof
3109             OMGDOT = $omgdot
3110             SINIO = $sini0
3111             SINMO = $sinmo
3112 0 0       0 T2COF = @{[defined $t2cof ? $t2cof : 'undef']}
3113 0 0       0 T3COF = @{[defined $t3cof ? $t3cof : 'undef']}
3114 0 0       0 T4COF = @{[defined $t4cof ? $t4cof : 'undef']}
3115 0 0       0 T5COF = @{[defined $t5cof ? $t5cof : 'undef']}
3116             X1MTH2 = $x1mth2
3117             X3THM1 = $x3thm1
3118             X7THM1 = $x7thm1
3119             XLCOF = $xlcof
3120             XMCOF = $xmcof
3121             XMDOT = $xmdot
3122             XNODCF = $xnodcf
3123             XNODOT = $xnodot
3124             XNODP = $xnodp
3125             eod
3126             {
3127 2         63 aodp => $aodp,
3128             aycof => $aycof,
3129             c1 => $c1,
3130             c4 => $c4,
3131             c5 => $c5,
3132             cosi0 => $cosi0,
3133             d2 => $d2,
3134             d3 => $d3,
3135             d4 => $d4,
3136             delmo => $delmo,
3137             eta => $eta,
3138             isimp => $isimp,
3139             omgcof => $omgcof,
3140             omgdot => $omgdot,
3141             sini0 => $sini0,
3142             sinmo => $sinmo,
3143             t2cof => $t2cof,
3144             t3cof => $t3cof,
3145             t4cof => $t4cof,
3146             t5cof => $t5cof,
3147             x1mth2 => $x1mth2,
3148             x3thm1 => $x3thm1,
3149             x7thm1 => $x7thm1,
3150             xlcof => $xlcof,
3151             xmcof => $xmcof,
3152             xmdot => $xmdot,
3153             xnodcf => $xnodcf,
3154             xnodot => $xnodot,
3155             xnodp => $xnodp,
3156             };
3157             };
3158              
3159             #* Update for secular gravity and atmospheric drag.
3160              
3161 7         25 my $xmdf = $self->{meananomaly} + $parm->{xmdot} * $tsince;
3162 7         15 my $omgadf = $self->{argumentofperigee} + $parm->{omgdot} * $tsince;
3163 7         18 my $xnoddf = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
3164 7         13 my $omega = $omgadf;
3165 7         10 my $xmp = $xmdf;
3166 7         17 my $tsq = $tsince * $tsince;
3167 7         17 my $xnode = $xnoddf + $parm->{xnodcf} * $tsq;
3168 7         18 my $tempa = 1 - $parm->{c1} * $tsince;
3169 7         16 my $tempe = $self->{bstardrag} * $parm->{c4} * $tsince;
3170 7         15 my $templ = $parm->{t2cof} * $tsq;
3171 7 50       16 $parm->{isimp} or do {
3172 0         0 my $delomg = $parm->{omgcof} * $tsince;
3173             my $delm = $parm->{xmcof} * ((1 + $parm->{eta} * cos($xmdf)) **
3174 0         0 3 - $parm->{delmo});
3175 0         0 my $temp = $delomg + $delm;
3176 0         0 $xmp = $xmdf + $temp;
3177 0         0 $omega = $omgadf - $temp;
3178 0         0 my $tcube = $tsq * $tsince;
3179 0         0 my $tfour = $tsince * $tcube;
3180             $tempa = $tempa - $parm->{d2} * $tsq - $parm->{d3} * $tcube -
3181 0         0 $parm->{d4} * $tfour;
3182             $tempe = $tempe + $self->{bstardrag} * $parm->{c5} * (sin($xmp)
3183 0         0 - $parm->{sinmo});
3184             $templ = $templ + $parm->{t3cof} * $tcube + $tfour *
3185 0         0 ($parm->{t4cof} + $tsince * $parm->{t5cof});
3186             };
3187 7         51 my $a = $parm->{aodp} * $tempa ** 2;
3188 7         15 my $e = $self->{eccentricity} - $tempe;
3189 7         14 my $xl = $xmp + $omega + $xnode + $parm->{xnodp} * $templ;
3190             $self->{debug}
3191 7 50       26 and warn "Debug - OID $oid sgp4 effective eccentricity $e\n";
3192 7 100 66     37 croak < 1 || $e < -1;
3193             Error - OID $oid Sgp4 effective eccentricity > 1
3194 2         4 Epoch = @{[scalar gmtime $self->get ('epoch')]} GMT
3195             \$self->{bstardrag} = $self->{bstardrag}
3196             \$parm->{c4} = $parm->{c4}
3197             \$tsince = $tsince
3198             \$tempe = \$self->{bstardrag} * \$parm->{c4} * \$tsince
3199             \$tempe = $tempe
3200             \$self->{eccentricity} = $self->{eccentricity}
3201             \$e = \$self->{eccentricity} - \$tempe
3202             \$e = $e
3203             Either this object represents a bad set of elements, or you are
3204             using it beyond its "best by" date ("expiry date" in some dialects
3205             of English).
3206             eod
3207 5         13 my $beta = sqrt(1 - $e * $e);
3208 5 50       14 $self->{debug} and print <
3209             Debug SGP4 - Before xn,
3210 0         0 XKE = @{[SGP_XKE]}
3211             A = $a
3212             TEMPA = $tempa
3213             AODP = $parm->{aodp}
3214             eod
3215 5         12 my $xn = SGP_XKE / $a ** 1.5;
3216              
3217             #* Long period periodics
3218              
3219 5         11 my $axn = $e * cos($omega);
3220 5         10 my $temp = 1 / ($a * $beta * $beta);
3221 5         13 my $xll = $temp * $parm->{xlcof} * $axn;
3222 5         11 my $aynl = $temp * $parm->{aycof};
3223 5         7 my $xlt = $xl + $xll;
3224 5         139 my $ayn = $e * sin($omega) + $aynl;
3225              
3226             #* Solve Kepler's equation.
3227              
3228 5         44 my $capu = mod2pi($xlt - $xnode);
3229 5         9 my $temp2 = $capu;
3230 5         11 my ($temp3, $temp4, $temp5, $temp6, $sinepw, $cosepw);
3231 5         16 for (my $i = 0; $i < 10; $i++) {
3232 10         18 $sinepw = sin($temp2);
3233 10         15 $cosepw = cos($temp2);
3234 10         19 $temp3 = $axn * $sinepw;
3235 10         17 $temp4 = $ayn * $cosepw;
3236 10         13 $temp5 = $axn * $cosepw;
3237 10         15 $temp6 = $ayn * $sinepw;
3238 10         23 my $epw = ($capu - $temp4 + $temp3 - $temp2) / (1 - $temp5 -
3239             $temp6) + $temp2;
3240 10 100       31 abs ($epw - $temp2) <= SGP_E6A and last;
3241 5         15 $temp2 = $epw;
3242             }
3243              
3244             #* Short period preliminary quantities.
3245              
3246 5         9 my $ecose = $temp5 + $temp6;
3247 5         9 my $esine = $temp3 - $temp4;
3248 5         11 my $elsq = $axn * $axn + $ayn * $ayn;
3249 5         11 $temp = 1 - $elsq;
3250 5         7 my $pl = $a * $temp;
3251 5         11 my $r = $a * (1 - $ecose);
3252 5         9 my $temp1 = 1 / $r;
3253 5         10 my $rdot = SGP_XKE * sqrt($a) * $esine * $temp1;
3254 5         11 my $rfdot = SGP_XKE * sqrt($pl) * $temp1;
3255 5         6 $temp2 = $a * $temp1;
3256 5         10 my $betal = sqrt($temp);
3257 5         12 $temp3 = 1 / (1 + $betal);
3258 5         28 my $cosu = $temp2 * ($cosepw - $axn + $ayn * $esine * $temp3);
3259 5         11 my $sinu = $temp2 * ($sinepw - $ayn - $axn * $esine * $temp3);
3260 5         17 my $u = _actan($sinu,$cosu);
3261 5         12 my $sin2u = 2 * $sinu * $cosu;
3262 5         11 my $cos2u = 2 * $cosu * $cosu - 1;
3263 5         10 $temp = 1 / $pl;
3264 5         9 $temp1 = SGP_CK2 * $temp;
3265 5         9 $temp2 = $temp1 * $temp;
3266              
3267             #* Update for short periodics
3268              
3269             my $rk = $r * (1 - 1.5 * $temp2 * $betal * $parm->{x3thm1}) + .5 *
3270 5         44 $temp1 * $parm->{x1mth2} * $cos2u;
3271 5         14 my $uk = $u - .25 * $temp2 * $parm->{x7thm1} * $sin2u;
3272 5         10 my $xnodek = $xnode + 1.5 * $temp2 * $parm->{cosi0} * $sin2u;
3273             my $xinck = $self->{inclination} + 1.5 * $temp2 * $parm->{cosi0} *
3274 5         13 $parm->{sini0} * $cos2u;
3275 5         11 my $rdotk = $rdot - $xn * $temp1 * $parm->{x1mth2} * $sin2u;
3276             my $rfdotk = $rfdot + $xn * $temp1 * ($parm->{x1mth2} * $cos2u + 1.5
3277 5         13 * $parm->{x3thm1});
3278              
3279             #* Orientation vectors
3280              
3281 5         8 my $sinuk = sin ($uk);
3282 5         11 my $cosuk = cos ($uk);
3283 5         9 my $sinik = sin ($xinck);
3284 5         8 my $cosik = cos ($xinck);
3285 5         10 my $sinnok = sin ($xnodek);
3286 5         9 my $cosnok = cos ($xnodek);
3287 5         11 my $xmx = - $sinnok * $cosik;
3288 5         9 my $xmy = $cosnok * $cosik;
3289 5         11 my $ux = $xmx * $sinuk + $cosnok * $cosuk;
3290 5         8 my $uy = $xmy * $sinuk + $sinnok * $cosuk;
3291 5         36 my $uz = $sinik * $sinuk;
3292 5         11 my $vx = $xmx * $cosuk - $cosnok * $sinuk;
3293 5         8 my $vy = $xmy * $cosuk - $sinnok * $sinuk;
3294 5         9 my $vz = $sinik * $cosuk;
3295              
3296             #* Position and velocity
3297              
3298 5         7 my $x = $rk * $ux;
3299 5         10 my $y = $rk * $uy;
3300 5         9 my $z = $rk * $uz;
3301 5         11 my $xdot = $rdotk * $ux + $rfdotk * $vx;
3302 5         10 my $ydot = $rdotk * $uy + $rfdotk * $vy;
3303 5         8 my $zdot = $rdotk * $uz + $rfdotk * $vz;
3304              
3305 5         20 return _convert_out($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
3306             }
3307              
3308             =item $tle = $tle->sdp4($time)
3309              
3310             This method calculates the position of the body described by the TLE
3311             object at the given time, using the SDP4 model. The universal time of
3312             the object is set to $time, and the 'equinox_dynamical' attribute is set
3313             to the current value of the 'epoch_dynamical' attribute.
3314              
3315             The result is the original object reference. You need to call one of
3316             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
3317             retrieve the position you just calculated.
3318              
3319             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
3320             model can be used only for deep-space orbits.
3321              
3322             =cut
3323              
3324             sub sdp4 {
3325 7     7 1 27 my ($self, $time) = @_;
3326 7         43 my $oid = $self->get('id');
3327 7         24 $self->{model_error} = undef;
3328 7         29 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
3329              
3330             #>>> Rather than use a separate indicator argument to trigger
3331             #>>> initialization of the model, we use the Orcish maneuver to
3332             #>>> retrieve the results of initialization, performing the
3333             #>>> calculations if needed. -- TRW
3334              
3335 7   66     56 my $parm = $self->{&TLE_INIT}{TLE_sdp4} ||= do {
3336 2 50       9 $self->is_deep or croak <
3337             Error - The SDP4 model is not valid for near-earth objects.
3338             Use the SGP, SGP4, SGP4R, or SGP8 models instead.
3339             EOD
3340              
3341             #* Recover original mean motion (XNODP) and semimajor axis (AODP)
3342             #* from input elements.
3343              
3344 2         9 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
3345 2         6 my $cosi0 = cos ($self->{inclination});
3346 2         6 my $theta2 = $cosi0 * $cosi0;
3347 2         6 my $x3thm1 = 3 * $theta2 - 1;
3348 2         6 my $eosq = $self->{eccentricity} * $self->{eccentricity};
3349 2         4 my $beta02 = 1 - $eosq;
3350 2         6 my $beta0 = sqrt ($beta02);
3351 2         6 my $del1 = 1.5 * SGP_CK2 * $x3thm1 / ($a1 * $a1 * $beta0 * $beta02);
3352 2         7 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD + $del1 * (1 + 134
3353             / 81 * $del1)));
3354 2         7 my $del0 = 1.5 * SGP_CK2 * $x3thm1 / ($a0 * $a0 * $beta0 * $beta02);
3355 2         5 my $xnodp = $self->{meanmotion} / (1 + $del0);
3356             # no problem here - we know this because AODP is returned.
3357 2         6 my $aodp = $a0 / (1 - $del0);
3358              
3359             #* Initialization
3360              
3361             #* For perigee below 156 KM, the values of
3362             #* S and QOMS2T are altered
3363              
3364 2         4 my $s4 = SGP_S;
3365 2         3 my $qoms24 = SGP_QOMS2T;
3366 2         8 my $perige = ($aodp * (1 - $self->{eccentricity}) - SGP_AE) *
3367             SGP_XKMPER;
3368 2 50       10 unless ($perige >= 156) {
3369 2 50       9 $s4 = $perige > 98 ? $perige - 78 : 20;
3370 2         7 $qoms24 = ((120 - $s4) * SGP_AE / SGP_XKMPER) ** 4;
3371 2         3 $s4 = $s4 / SGP_XKMPER + SGP_AE;
3372             }
3373 2         7 my $pinvsq = 1 / ($aodp * $aodp * $beta02 * $beta02);
3374 2         5 my $sing = sin ($self->{argumentofperigee});
3375 2         6 my $cosg = cos ($self->{argumentofperigee});
3376 2         5 my $tsi = 1 / ($aodp - $s4);
3377 2         5 my $eta = $aodp * $self->{eccentricity} * $tsi;
3378 2         4 my $etasq = $eta * $eta;
3379 2         1782 my $eeta = $self->{eccentricity} * $eta;
3380 2         10 my $psisq = abs (1 - $etasq);
3381 2         5 my $coef = $qoms24 * $tsi ** 4;
3382 2         7 my $coef1 = $coef / $psisq ** 3.5;
3383 2         11 my $c2 = $coef1 * $xnodp * ($aodp * (1 + 1.5 * $etasq + $eeta *
3384             (4 + $etasq)) + .75 * SGP_CK2 * $tsi / $psisq * $x3thm1 *
3385             (8 + 3 * $etasq * (8 + $etasq)));
3386             # minor problem here
3387 2         4 my $c1 = $self->{bstardrag} * $c2;
3388 2         6 my $sini0 = sin ($self->{inclination});
3389 2         5 my $a3ovk2 = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
3390 2         5 my $x1mth2 = 1 - $theta2;
3391             my $c4 = 2 * $xnodp * $coef1 * $aodp * $beta02 * ($eta * (2 + .5 *
3392             $etasq) + $self->{eccentricity} * (.5 + 2 * $etasq) -
3393             2 * SGP_CK2 * $tsi / ($aodp * $psisq) * ( - 3 * $x3thm1 *
3394             (1 - 2 * $eeta + $etasq * (1.5 - .5 * $eeta)) + .75 * $x1mth2 *
3395             (2 * $etasq - $eeta * (1 + $etasq)) *
3396 2         43 cos (2 * $self->{argumentofperigee})));
3397 2         8 my $theta4 = $theta2 * $theta2;
3398 2         4 my $temp1 = 3 * SGP_CK2 * $pinvsq * $xnodp;
3399 2         6 my $temp2 = $temp1 * SGP_CK2 * $pinvsq;
3400 2         13 my $temp3 = 1.25 * SGP_CK4 * $pinvsq * $pinvsq * $xnodp;
3401 2         11 my $xmdot = $xnodp + .5 * $temp1 * $beta0 * $x3thm1 +
3402             .0625 * $temp2 * $beta0 * (13 - 78 * $theta2 + 137 * $theta4);
3403 2         7 my $x1m5th = 1 - 5 * $theta2;
3404 2         12 my $omgdot = - .5 * $temp1 * $x1m5th +
3405             .0625 * $temp2 * (7 - 114 * $theta2 + 395 * $theta4) +
3406             $temp3 * (3 - 36 * $theta2 + 49 * $theta4);
3407 2         6 my $xhdot1 = - $temp1 * $cosi0;
3408 2         26 my $xnodot = $xhdot1 + (.5 * $temp2 * (4 - 19 * $theta2) +
3409             2 * $temp3 * (3 - 7 * $theta2)) * $cosi0;
3410             # problem here (inherited from C1 problem?)
3411 2         13 my $xnodcf = 3.5 * $beta02 * $xhdot1 * $c1;
3412             # problem here (inherited from C1 problem?)
3413 2         6 my $t2cof = 1.5 * $c1;
3414 2         7 my $xlcof = .125 * $a3ovk2 * $sini0 * (3 + 5 * $cosi0) / (1 + $cosi0);
3415 2         5 my $aycof = .25 * $a3ovk2 * $sini0;
3416 2         5 my $x7thm1 = 7 * $theta2 - 1;
3417 2         14 $self->{&TLE_INIT}{TLE_deep} = {$self->_dpinit ($eosq, $sini0, $cosi0, $beta0,
3418             $aodp, $theta2, $sing, $cosg, $beta02, $xmdot, $omgdot,
3419             $xnodot, $xnodp)};
3420              
3421 2 50       19 $self->{debug} and print <
3422             Debug SDP4 - Initialize
3423             AODP = $aodp
3424             AYCOF = $aycof
3425             C1 = $c1 << 2.45532e-06 in test_sgp-c-lib
3426             c2 = $c2 << 0.000171569 in test_sgp-c-lib
3427             C4 = $c4
3428             COSIO = $cosi0
3429             ETA = $eta
3430             OMGDOT = $omgdot
3431             s4 = $s4
3432             SINIO = $sini0
3433 0 0       0 T2COF = @{[defined $t2cof ? $t2cof : 'undef']} << 3.68298e-06 in test_sgp-c-lib
3434             X1MTH2 = $x1mth2
3435             X3THM1 = $x3thm1
3436             X7THM1 = $x7thm1
3437             XLCOF = $xlcof
3438             XMDOT = $xmdot
3439             XNODCF = $xnodcf << -1.40764e-11 in test_sgp-c-lib
3440             XNODOT = $xnodot
3441             XNODP = $xnodp
3442             eod
3443             {
3444 2         29 aodp => $aodp,
3445             aycof => $aycof,
3446             c1 => $c1,
3447             c4 => $c4,
3448             ### c5 => $c5,
3449             cosi0 => $cosi0,
3450             ### d2 => $d2,
3451             ### d3 => $d3,
3452             ### d4 => $d4,
3453             ### delmo => $delmo,
3454             eta => $eta,
3455             ### isimp => $isimp,
3456             ### omgcof => $omgcof,
3457             omgdot => $omgdot,
3458             sini0 => $sini0,
3459             ### sinmo => $sinmo,
3460             t2cof => $t2cof,
3461             ### t3cof => $t3cof,
3462             ### t4cof => $t4cof,
3463             ### t5cof => $t5cof,
3464             x1mth2 => $x1mth2,
3465             x3thm1 => $x3thm1,
3466             x7thm1 => $x7thm1,
3467             xlcof => $xlcof,
3468             ### xmcof => $xmcof,
3469             xmdot => $xmdot,
3470             xnodcf => $xnodcf,
3471             xnodot => $xnodot,
3472             xnodp => $xnodp,
3473             };
3474             };
3475             #>>>trw my $dpsp = $self->{&TLE_INIT}{TLE_deep};
3476              
3477             #* UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG
3478              
3479 7         31 my $xmdf = $self->{meananomaly} + $parm->{xmdot} * $tsince;
3480 7         20 my $omgadf = $self->{argumentofperigee} + $parm->{omgdot} * $tsince;
3481 7         20 my $xnoddf = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
3482 7         16 my $tsq = $tsince * $tsince;
3483 7         18 my $xnode = $xnoddf + $parm->{xnodcf} * $tsq;
3484 7         19 my $tempa = 1 - $parm->{c1} * $tsince;
3485 7         21 my $tempe = $self->{bstardrag} * $parm->{c4} * $tsince;
3486 7         17 my $templ = $parm->{t2cof} * $tsq;
3487 7         142 my $xn = $parm->{xnodp};
3488 7         16 my ($em, $xinc); # Hope this is right.
3489 7         41 $self->_dpsec (\$xmdf, \$omgadf, \$xnode, \$em, \$xinc, \$xn, $tsince);
3490 7         34 my $a = (SGP_XKE / $xn) ** SGP_TOTHRD * $tempa ** 2;
3491 7         25 my $e = $em - $tempe;
3492 7         16 my $xmam = $xmdf + $parm->{xnodp} * $templ;
3493 7         39 $self->_dpper (\$e, \$xinc, \$omgadf, \$xnode, \$xmam, $tsince);
3494 7         18 my $xl = $xmam + $omgadf + $xnode;
3495             $self->{debug}
3496 7 50       21 and warn "Debug - OID $oid sdp4 effective eccentricity $e\n";
3497 7 100 66     505 ($e > 1 || $e < -1)
3498             and croak "Error - OID $oid Sdp4 effective eccentricity > 1";
3499 5         16 my $beta = sqrt (1 - $e * $e);
3500 5         16 $xn = SGP_XKE / $a ** 1.5;
3501              
3502             #* LONG PERIOD PERIODICS
3503              
3504 5         11 my $axn = $e * cos ($omgadf);
3505 5         15 my $temp = 1 / ($a * $beta * $beta);
3506 5         13 my $xll = $temp * $parm->{xlcof} * $axn;
3507 5         12 my $aynl = $temp * $parm->{aycof};
3508 5         13 my $xlt = $xl + $xll;
3509 5         11 my $ayn = $e * sin ($omgadf) + $aynl;
3510              
3511             #* SOLVE KEPLERS EQUATION
3512              
3513 5         44 my $capu = mod2pi ($xlt - $xnode);
3514 5         8 my $temp2 = $capu;
3515 5         15 my ($epw, $sinepw, $cosepw, $temp3, $temp4, $temp5, $temp6);
3516 5         29 for (my $i = 0; $i < 10; $i++) {
3517 23         35 $sinepw = sin ($temp2);
3518 23         40 $cosepw = cos ($temp2);
3519 23         35 $temp3 = $axn * $sinepw;
3520 23         31 $temp4 = $ayn * $cosepw;
3521 23         33 $temp5 = $axn * $cosepw;
3522 23         55 $temp6 = $ayn * $sinepw;
3523 23         48 $epw = ($capu - $temp4 + $temp3 - $temp2) / (1 - $temp5 -
3524             $temp6) + $temp2;
3525 23 100       55 last if (abs ($epw - $temp2) <= SGP_E6A);
3526 18         46 $temp2 = $epw;
3527             }
3528              
3529             #* SHORT PERIOD PRELIMINARY QUANTITIES
3530              
3531 5         11 my $ecose = $temp5 + $temp6;
3532 5         10 my $esine = $temp3 - $temp4;
3533 5         13 my $elsq = $axn * $axn + $ayn * $ayn;
3534 5         11 $temp = 1 - $elsq;
3535 5         11 my $pl = $a * $temp;
3536 5         10 my $r = $a * (1 - $ecose);
3537 5         15 my $temp1 = 1 / $r;
3538 5         17 my $rdot = SGP_XKE * sqrt ($a) * $esine * $temp1;
3539 5         13 my $rfdot = SGP_XKE * sqrt ($pl) * $temp1;
3540 5         12 $temp2 = $a * $temp1;
3541 5         10 my $betal = sqrt ($temp);
3542 5         13 $temp3 = 1 / (1 + $betal);
3543 5         13 my $cosu = $temp2 * ($cosepw - $axn + $ayn * $esine * $temp3);
3544 5         16 my $sinu = $temp2 * ($sinepw - $ayn - $axn * $esine * $temp3);
3545 5         22 my $u = _actan ($sinu,$cosu);
3546 5         14 my $sin2u = 2 * $sinu * $cosu;
3547 5         13 my $cos2u = 2 * $cosu * $cosu - 1;
3548 5         10 $temp = 1 / $pl;
3549 5         12 $temp1 = SGP_CK2 * $temp;
3550 5         24 $temp2 = $temp1 * $temp;
3551              
3552             #* UPDATE FOR SHORT PERIODICS
3553              
3554             my $rk = $r * (1 - 1.5 * $temp2 * $betal * $parm->{x3thm1}) + .5 *
3555 5         27 $temp1 * $parm->{x1mth2} * $cos2u;
3556 5         15 my $uk = $u - .25 * $temp2 * $parm->{x7thm1} * $sin2u;
3557 5         14 my $xnodek = $xnode + 1.5 * $temp2 * $parm->{cosi0} * $sin2u;
3558             my $xinck = $xinc + 1.5 * $temp2 * $parm->{cosi0} * $parm->{sini0} *
3559 5         14 $cos2u;
3560 5         10 my $rdotk = $rdot - $xn * $temp1 * $parm->{x1mth2} * $sin2u;
3561             my $rfdotk = $rfdot + $xn * $temp1 * ($parm->{x1mth2} * $cos2u + 1.5
3562 5         17 * $parm->{x3thm1});
3563              
3564             #* ORIENTATION VECTORS
3565              
3566 5         12 my $sinuk = sin ($uk);
3567 5         10 my $cosuk = cos ($uk);
3568 5         12 my $sinik = sin ($xinck);
3569 5         7 my $cosik = cos ($xinck);
3570 5         11 my $sinnok = sin ($xnodek);
3571 5         10 my $cosnok = cos ($xnodek);
3572 5         12 my $xmx = - $sinnok * $cosik;
3573 5         9 my $xmy = $cosnok * $cosik;
3574 5         13 my $ux = $xmx * $sinuk + $cosnok * $cosuk;
3575 5         12 my $uy = $xmy * $sinuk + $sinnok * $cosuk;
3576 5         10 my $uz = $sinik * $sinuk;
3577 5         19 my $vx = $xmx * $cosuk - $cosnok * $sinuk;
3578 5         12 my $vy = $xmy * $cosuk - $sinnok * $sinuk;
3579 5         9 my $vz = $sinik * $cosuk;
3580              
3581             #* POSITION AND VELOCITY
3582              
3583 5         11 my $x = $rk * $ux;
3584 5         11 my $y = $rk * $uy;
3585 5         9 my $z = $rk * $uz;
3586 5         12 my $xdot = $rdotk * $ux + $rfdotk * $vx;
3587 5         11 my $ydot = $rdotk * $uy + $rfdotk * $vy;
3588 5         11 my $zdot = $rdotk * $uz + $rfdotk * $vz;
3589              
3590 5         23 return _convert_out($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
3591             }
3592              
3593             =item $tle = $tle->sgp8($time)
3594              
3595             This method calculates the position of the body described by the TLE
3596             object at the given time, using the SGP8 model. The universal time of
3597             the object is set to $time, and the 'equinox_dynamical' attribute is set
3598             to the current value of the 'epoch_dynamical' attribute.
3599              
3600             The result is the original object reference. You need to call one of
3601             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
3602             retrieve the position you just calculated.
3603              
3604             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
3605             model can be used only for near-earth orbits.
3606              
3607             =cut
3608              
3609             sub sgp8 {
3610 7     7 1 17 my ($self, $time) = @_;
3611 7         23 my $oid = $self->get('id');
3612 7         20 $self->{model_error} = undef;
3613 7         26 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
3614              
3615             #>>> Rather than use a separate indicator argument to trigger
3616             #>>> initialization of the model, we use the Orcish maneuver to
3617             #>>> retrieve the results of initialization, performing the
3618             #>>> calculations if needed. -- TRW
3619              
3620 7   66     44 my $parm = $self->{&TLE_INIT}{TLE_sgp8} ||= do {
3621 2 50       8 $self->is_deep and croak <
3622             Error - The SGP8 model is not valid for deep space objects.
3623             Use the SDP4, SGP4R, or SDP8 models instead.
3624             EOD
3625              
3626             #* RECOVER ORIGINAL MEAN MOTION (XNODP) AND SEMIMAJOR AXIS (AODP)
3627             #* FROM INPUT ELEMENTS --------- CALCULATE BALLISTIC COEFFICIENT
3628             #* (B TERM) FROM INPUT B* DRAG TERM
3629              
3630 2         12 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
3631 2         5 my $cosi = cos ($self->{inclination});
3632 2         5 my $theta2 = $cosi * $cosi;
3633 2         8 my $tthmun = 3 * $theta2 - 1;
3634 2         5 my $eosq = $self->{eccentricity} * $self->{eccentricity};
3635 2         6 my $beta02 = 1 - $eosq;
3636 2         4 my $beta0 = sqrt ($beta02);
3637 2         7 my $del1 = 1.5 * SGP_CK2 * $tthmun / ($a1 * $a1 * $beta0 * $beta02);
3638 2         9 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD +
3639             $del1 * (1 + 134 / 81 * $del1)));
3640 2         6 my $del0 = 1.5 * SGP_CK2 * $tthmun / ($a0 * $a0 * $beta0 * $beta02);
3641 2         20 my $aodp = $a0 / (1 - $del0);
3642 2         6 my $xnodp = $self->{meanmotion} / (1 + $del0);
3643 2         6 my $b = 2 * $self->{bstardrag} / SGP_RHO;
3644              
3645             #* INITIALIZATION
3646              
3647 2         4 my $isimp = 0;
3648 2         4 my $po = $aodp * $beta02;
3649 2         5 my $pom2 = 1 / ($po * $po);
3650 2         4 my $sini = sin ($self->{inclination});
3651 2         5 my $sing = sin ($self->{argumentofperigee});
3652 2         4 my $cosg = cos ($self->{argumentofperigee});
3653 2         5 my $temp = .5 * $self->{inclination};
3654 2         6 my $sinio2 = sin ($temp);
3655 2         4 my $cosio2 = cos ($temp);
3656 2         5 my $theta4 = $theta2 ** 2;
3657 2         6 my $unm5th = 1 - 5 * $theta2;
3658 2         5 my $unmth2 = 1 - $theta2;
3659 2         6 my $a3cof = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
3660 2         17 my $pardt1 = 3 * SGP_CK2 * $pom2 * $xnodp;
3661 2         4 my $pardt2 = $pardt1 * SGP_CK2 * $pom2;
3662 2         5 my $pardt4 = 1.25 * SGP_CK4 * $pom2 * $pom2 * $xnodp;
3663 2         5 my $xmdt1 = .5 * $pardt1 * $beta0 * $tthmun;
3664 2         4 my $xgdt1 = - .5 * $pardt1 * $unm5th;
3665 2         4 my $xhdt1 = - $pardt1 * $cosi;
3666 2         9 my $xlldot = $xnodp + $xmdt1 + .0625 * $pardt2 * $beta0 *
3667             (13 - 78 * $theta2 + 137 * $theta4);
3668 2         10 my $omgdt = $xgdt1 + .0625 * $pardt2 * (7 - 114 * $theta2 +
3669             395 * $theta4) + $pardt4 * (3 - 36 * $theta2 + 49 * $theta4);
3670 2         8 my $xnodot = $xhdt1 + (.5 * $pardt2 * (4 - 19 * $theta2) +
3671             2 * $pardt4 * (3 - 7 * $theta2)) * $cosi;
3672 2         7 my $tsi = 1 / ($po - SGP_S);
3673 2         6 my $eta = $self->{eccentricity} * SGP_S * $tsi;
3674 2         5 my $eta2 = $eta ** 2;
3675 2         11 my $psim2 = abs (1 / (1 - $eta2));
3676 2         7 my $alpha2 = 1 + $eosq;
3677 2         6 my $eeta = $self->{eccentricity} * $eta;
3678 2         8 my $cos2g = 2 * $cosg ** 2 - 1;
3679 2         6 my $d5 = $tsi * $psim2;
3680 2         6 my $d1 = $d5 / $po;
3681 2         9 my $d2 = 12 + $eta2 * (36 + 4.5 * $eta2);
3682 2         6 my $d3 = $eta2 * (15 + 2.5 * $eta2);
3683 2         6 my $d4 = $eta * (5 + 3.75 * $eta2);
3684 2         6 my $b1 = SGP_CK2 * $tthmun;
3685 2         5 my $b2 = - SGP_CK2 * $unmth2;
3686 2         4 my $b3 = $a3cof * $sini;
3687 2         11 my $c0 = .5 * $b * SGP_RHO * SGP_QOMS2T * $xnodp * $aodp *
3688             $tsi ** 4 * $psim2 ** 3.5 / sqrt ($alpha2);
3689 2         9 my $c1 = 1.5 * $xnodp * $alpha2 ** 2 * $c0;
3690 2         58 my $c4 = $d1 * $d3 * $b2;
3691 2         5 my $c5 = $d5 * $d4 * $b3;
3692 2         9 my $xndt = $c1 * ( (2 + $eta2 * (3 + 34 * $eosq) +
3693             5 * $eeta * (4 + $eta2) + 8.5 * $eosq) + $d1 * $d2 * $b1 +
3694             $c4 * $cos2g + $c5 * $sing);
3695 2         3 my $xndtn = $xndt / $xnodp;
3696              
3697             #* IF DRAG IS VERY SMALL, THE ISIMP FLAG IS SET AND THE
3698             #* EQUATIONS ARE TRUNCATED TO LINEAR VARIATION IN MEAN
3699             #* MOTION AND QUADRATIC VARIATION IN MEAN ANOMALY
3700              
3701             #>>> Note that the simplified version of the code has been swapped
3702             #>>> above the full version to preserve the sense of the comment.
3703              
3704 2         5 my ($ed, $edot, $gamma, $pp, $ovgpp, $qq, $xnd);
3705 2 50       10 if (abs ($xndtn * SGP_XMNPDA) < 2.16e-3) {
3706 2         14 $isimp = 1;
3707 2         8 $edot = - SGP_TOTHRD * $xndtn * (1 - $self->{eccentricity});
3708             } else {
3709 0         0 my $d6 = $eta * (30 + 22.5 * $eta2);
3710 0         0 my $d7 = $eta * (5 + 12.5 * $eta2);
3711 0         0 my $d8 = 1 + $eta2 * (6.75 + $eta2);
3712 0         0 my $c8 = $d1 * $d7 * $b2;
3713 0         0 my $c9 = $d5 * $d8 * $b3;
3714             $edot = - $c0 * ($eta * (4 + $eta2 +
3715             $eosq * (15.5 + 7 * $eta2)) +
3716 0         0 $self->{eccentricity} * (5 + 15 * $eta2) +
3717             $d1 * $d6 * $b1 + $c8 * $cos2g + $c9 * $sing);
3718 0         0 my $d20 = .5 * SGP_TOTHRD * $xndtn;
3719 0         0 my $aldtal = $self->{eccentricity} * $edot / $alpha2;
3720             my $tsdtts = 2 * $aodp * $tsi * ($d20 * $beta02 +
3721 0         0 $self->{eccentricity} * $edot);
3722 0         0 my $etdt = ($edot + $self->{eccentricity} * $tsdtts)
3723             * $tsi * SGP_S;
3724 0         0 my $psdtps = - $eta * $etdt * $psim2;
3725 0         0 my $sin2g = 2 * $sing * $cosg;
3726 0         0 my $c0dtc0 = $d20 + 4 * $tsdtts - $aldtal - 7 * $psdtps;
3727 0         0 my $c1dtc1 = $xndtn + 4 * $aldtal + $c0dtc0;
3728             my $d9 = $eta * (6 + 68 * $eosq) +
3729 0         0 $self->{eccentricity} * (20 + 15 * $eta2);
3730             my $d10 = 5 * $eta * (4 + $eta2) +
3731 0         0 $self->{eccentricity} * (17 + 68 * $eta2);
3732 0         0 my $d11 = $eta * (72 + 18 * $eta2);
3733 0         0 my $d12 = $eta * (30 + 10 * $eta2);
3734 0         0 my $d13 = 5 + 11.25 * $eta2;
3735 0         0 my $d14 = $tsdtts - 2 * $psdtps;
3736 0         0 my $d15 = 2 * ($d20 + $self->{eccentricity} * $edot / $beta02);
3737 0         0 my $d1dt = $d1 * ($d14 + $d15);
3738 0         0 my $d2dt = $etdt * $d11;
3739 0         0 my $d3dt = $etdt * $d12;
3740 0         0 my $d4dt = $etdt * $d13;
3741 0         0 my $d5dt = $d5 * $d14;
3742 0         0 my $c4dt = $b2 * ($d1dt * $d3 + $d1 * $d3dt);
3743 0         0 my $c5dt = $b3 * ($d5dt * $d4 + $d5 * $d4dt);
3744 0         0 my $d16 = $d9 * $etdt + $d10 * $edot +
3745             $b1 * ($d1dt * $d2 + $d1 * $d2dt) + $c4dt * $cos2g +
3746             $c5dt * $sing +
3747             $xgdt1 * ($c5 * $cosg - 2 * $c4 * $sin2g);
3748 0         0 my $xnddt = $c1dtc1 * $xndt + $c1 * $d16;
3749 0         0 my $eddot = $c0dtc0 * $edot -
3750             $c0 * ((4 + 3 * $eta2 + 30 * $eeta +
3751             $eosq * (15.5 + 21 * $eta2)) * $etdt +
3752             (5 + 15 * $eta2 + $eeta * (31 + 14 * $eta2)) * $edot +
3753             $b1 * ($d1dt * $d6 + $d1 * $etdt * (30 + 67.5 *
3754             $eta2)) + $b2 * ($d1dt * $d7 +
3755             $d1 * $etdt * (5 + 37.5 * $eta2)) * $cos2g +
3756             $b3 * ($d5dt * $d8 + $d5 * $etdt * $eta * (13.5 +
3757             4 * $eta2)) * $sing +
3758             $xgdt1 * ($c9 * $cosg - 2 * $c8 * $sin2g));
3759 0         0 my $d25 = $edot ** 2;
3760 0         0 my $d17 = $xnddt / $xnodp - $xndtn ** 2;
3761             my $tsddts = 2 * $tsdtts * ($tsdtts - $d20) + $aodp * $tsi *
3762             (SGP_TOTHRD * $beta02 * $d17 - 4 * $d20 *
3763             $self->{eccentricity} * $edot + 2 *
3764 0         0 ($d25 + $self->{eccentricity} * $eddot));
3765 0         0 my $etddt = ($eddot + 2 * $edot * $tsdtts) * $tsi * SGP_S +
3766             $tsddts * $eta;
3767 0         0 my $d18 = $tsddts - $tsdtts ** 2;
3768 0         0 my $d19 = - $psdtps ** 2 / $eta2 - $eta * $etddt * $psim2 -
3769             $psdtps ** 2;
3770 0         0 my $d23 = $etdt * $etdt;
3771             my $d1ddt = $d1dt * ($d14 + $d15) + $d1 * ($d18 - 2 * $d19 +
3772             SGP_TOTHRD * $d17 + 2 * ($alpha2 * $d25 / $beta02 +
3773 0         0 $self->{eccentricity} * $eddot) / $beta02);
3774             my $xntrdt = $xndt * (2 * SGP_TOTHRD * $d17 + 3 * ($d25 +
3775             $self->{eccentricity} * $eddot) / $alpha2 -
3776             6 * $aldtal ** 2 + 4 * $d18 - 7 * $d19 ) +
3777             $c1dtc1 * $xnddt + $c1 * ($c1dtc1 * $d16 + $d9 * $etddt +
3778             $d10 * $eddot + $d23 * (6 + 30 * $eeta + 68 * $eosq) +
3779             $etdt * $edot * (40 + 30 * $eta2 + 272 * $eeta) +
3780             $d25 * (17 + 68 * $eta2) + $b1 * ($d1ddt * $d2 +
3781             2 * $d1dt * $d2dt + $d1 * ($etddt * $d11 +
3782             $d23 * (72 + 54 * $eta2))) + $b2 * ($d1ddt * $d3 +
3783             2 * $d1dt * $d3dt + $d1 * ($etddt * $d12 +
3784             $d23 * (30 + 30 * $eta2))) * $cos2g +
3785             $b3 * (($d5dt * $d14 + $d5 * ($d18 - 2 * $d19)) * $d4 +
3786             2 * $d4dt * $d5dt + $d5 * ($etddt * $d13 +
3787             22.5 * $eta * $d23)) * $sing + $xgdt1 * ((7 * $d20 +
3788 0         0 4 * $self->{eccentricity} * $edot / $beta02) *
3789             ($c5 * $cosg - 2 * $c4 * $sin2g) + ( (2 * $c5dt * $cosg -
3790             4 * $c4dt * $sin2g) - $xgdt1 * ($c5 * $sing +
3791             4 * $c4 * $cos2g))));
3792 0         0 my $tmnddt = $xnddt * 1.e9;
3793 0         0 my $temp = $tmnddt ** 2 - $xndt * 1.e18 * $xntrdt;
3794 0         0 $pp = ($temp + $tmnddt ** 2) / $temp;
3795 0         0 $gamma = - $xntrdt / ($xnddt * ($pp - 2.));
3796 0         0 $xnd = $xndt / ($pp * $gamma);
3797 0         0 $qq = 1 - $eddot / ($edot * $gamma);
3798 0         0 $ed = $edot / ($qq * $gamma);
3799 0         0 $ovgpp = 1 / ($gamma * ($pp + 1.));
3800             }
3801 2 50       8 $self->{debug} and print <
3802             Debug SGP8 - Initialize
3803 0 0       0 A3COF = @{[defined $a3cof ? $a3cof : 'undef']}
3804 0 0       0 COSI = @{[defined $cosi ? $cosi : 'undef']}
3805 0 0       0 COSIO2 = @{[defined $cosio2 ? $cosio2 : 'undef']}
3806 0 0       0 ED = @{[defined $ed ? $ed : 'undef']}
3807 0 0       0 EDOT = @{[defined $edot ? $edot : 'undef']}
3808 0 0       0 GAMMA = @{[defined $gamma ? $gamma : 'undef']}
3809 0 0       0 ISIMP = @{[defined $isimp ? $isimp : 'undef']}
3810 0 0       0 OMGDT = @{[defined $omgdt ? $omgdt : 'undef']}
3811 0 0       0 OVGPP = @{[defined $ovgpp ? $ovgpp : 'undef']}
3812 0 0       0 PP = @{[defined $pp ? $pp : 'undef']}
3813 0 0       0 QQ = @{[defined $qq ? $qq : 'undef']}
3814 0 0       0 SINI = @{[defined $sini ? $sini : 'undef']}
3815 0 0       0 SINIO2 = @{[defined $sinio2 ? $sinio2 : 'undef']}
3816 0 0       0 THETA2 = @{[defined $theta2 ? $theta2 : 'undef']}
3817 0 0       0 TTHMUN = @{[defined $tthmun ? $tthmun : 'undef']}
3818 0 0       0 UNM5TH = @{[defined $unm5th ? $unm5th : 'undef']}
3819 0 0       0 UNMTH2 = @{[defined $unmth2 ? $unmth2 : 'undef']}
3820 0 0       0 XGDT1 = @{[defined $xgdt1 ? $xgdt1 : 'undef']}
3821 0 0       0 XHDT1 = @{[defined $xhdt1 ? $xhdt1 : 'undef']}
3822 0 0       0 XLLDOT = @{[defined $xlldot ? $xlldot : 'undef']}
3823 0 0       0 XMDT1 = @{[defined $xmdt1 ? $xmdt1 : 'undef']}
3824 0 0       0 XND = @{[defined $xnd ? $xnd : 'undef']}
3825 0 0       0 XNDT = @{[defined $xndt ? $xndt : 'undef']}
3826 0 0       0 XNODOT = @{[defined $xnodot ? $xnodot : 'undef']}
3827 0 0       0 XNODP = @{[defined $xnodp ? $xnodp : 'undef']}
3828             eod
3829             {
3830 2         54 a3cof => $a3cof,
3831             cosi => $cosi,
3832             cosio2 => $cosio2,
3833             ed => $ed,
3834             edot => $edot,
3835             gamma => $gamma,
3836             isimp => $isimp,
3837             omgdt => $omgdt,
3838             ovgpp => $ovgpp,
3839             pp => $pp,
3840             qq => $qq,
3841             sini => $sini,
3842             sinio2 => $sinio2,
3843             theta2 => $theta2,
3844             tthmun => $tthmun,
3845             unm5th => $unm5th,
3846             unmth2 => $unmth2,
3847             xgdt1 => $xgdt1,
3848             xhdt1 => $xhdt1,
3849             xlldot => $xlldot,
3850             xmdt1 => $xmdt1,
3851             xnd => $xnd,
3852             xndt => $xndt,
3853             xnodot => $xnodot,
3854             xnodp => $xnodp,
3855             };
3856             };
3857              
3858             #* UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG
3859              
3860 7         36 my $xmam = mod2pi ($self->{meananomaly} + $parm->{xlldot} * $tsince);
3861 7         18 my $omgasm = $self->{argumentofperigee} + $parm->{omgdt} * $tsince;
3862 7         16 my $xnodes = $self->{ascendingnode} + $parm->{xnodot} * $tsince;
3863              
3864             #>>> The simplified and full logic have been swapped for clarity.
3865              
3866 7         14 my ($xn, $em, $z1);
3867 7 50       19 if ($parm->{isimp}) {
3868 7         14 $xn = $parm->{xnodp} + $parm->{xndt} * $tsince;
3869 7         15 $em = $self->{eccentricity} + $parm->{edot} * $tsince;
3870 7         17 $z1 = .5 * $parm->{xndt} * $tsince * $tsince;
3871             } else {
3872 0         0 my $temp = 1 - $parm->{gamma} * $tsince;
3873 0         0 my $temp1 = $temp ** $parm->{pp};
3874 0         0 $xn = $parm->{xnodp} + $parm->{xnd} * (1 - $temp1);
3875 0         0 $em = $self->{eccentricity} + $parm->{ed} * (1 - $temp ** $parm->{qq});
3876 0         0 $z1 = $parm->{xnd} * ($tsince + $parm->{ovgpp} * ($temp * $temp1 - 1.));
3877             }
3878 7         17 my $z7 = 3.5 * SGP_TOTHRD * $z1 / $parm->{xnodp};
3879 7         18 $xmam = mod2pi ($xmam + $z1 + $z7 * $parm->{xmdt1});
3880 7         14 $omgasm = $omgasm + $z7 * $parm->{xgdt1};
3881 7         21 $xnodes = $xnodes + $z7 * $parm->{xhdt1};
3882              
3883             #* SOLVE KEPLERS EQUATION
3884              
3885 7         35 my $zc2 = $xmam + $em * sin ($xmam) * (1 + $em * cos ($xmam));
3886 7         12 my ($cose, $sine, $zc5);
3887 7         23 for (my $i = 0; $i < 10; $i++) {
3888 25         32 $sine = sin ($zc2);
3889 25         26 $cose = cos ($zc2);
3890 25         34 $zc5 = 1 / (1 - $em * $cose);
3891 25         31 my $cape = ($xmam + $em * $sine - $zc2) * $zc5 + $zc2;
3892 25 100       43 last if (abs ($cape - $zc2) <= SGP_E6A);
3893 20         26 $zc2 = $cape;
3894             }
3895              
3896             #* SHORT PERIOD PRELIMINARY QUANTITIES
3897              
3898 7         18 my $am = (SGP_XKE / $xn) ** SGP_TOTHRD;
3899 7         15 my $beta2m = 1 - $em * $em;
3900             $self->{debug}
3901 7 50       32 and warn "Debug - OID $oid sgp8 effective eccentricity $em\n";
3902 7 100       443 $beta2m < 0
3903             and croak "Error - OID $oid Sgp8 effective eccentricity > 1";
3904 5         12 my $sinos = sin ($omgasm);
3905 5         8 my $cosos = cos ($omgasm);
3906 5         10 my $axnm = $em * $cosos;
3907 5         10 my $aynm = $em * $sinos;
3908 5         7 my $pm = $am * $beta2m;
3909 5         10 my $g1 = 1 / $pm;
3910 5         8 my $g2 = .5 * SGP_CK2 * $g1;
3911 5         9 my $g3 = $g2 * $g1;
3912 5         9 my $beta = sqrt ($beta2m);
3913 5         13 my $g4 = .25 * $parm->{a3cof} * $parm->{sini};
3914 5         10 my $g5 = .25 * $parm->{a3cof} * $g1;
3915 5         11 my $snf = $beta * $sine * $zc5;
3916 5         11 my $csf = ($cose - $em) * $zc5;
3917 5         14 my $fm = _actan ($snf,$csf);
3918 5         11 my $snfg = $snf * $cosos + $csf * $sinos;
3919 5         9 my $csfg = $csf * $cosos - $snf * $sinos;
3920 5         11 my $sn2f2g = 2 * $snfg * $csfg;
3921 5         15 my $cs2f2g = 2 * $csfg ** 2 - 1;
3922 5         10 my $ecosf = $em * $csf;
3923 5         10 my $g10 = $fm - $xmam + $em * $snf;
3924 5         47 my $rm = $pm / (1 + $ecosf);
3925 5         11 my $aovr = $am / $rm;
3926 5         10 my $g13 = $xn * $aovr;
3927 5         11 my $g14 = - $g13 * $aovr;
3928 5         13 my $dr = $g2 * ($parm->{unmth2} * $cs2f2g - 3 * $parm->{tthmun}) -
3929             $g4 * $snfg;
3930 5         12 my $diwc = 3 * $g3 * $parm->{sini} * $cs2f2g - $g5 * $aynm;
3931 5         11 my $di = $diwc * $parm->{cosi};
3932              
3933             #* UPDATE FOR SHORT PERIOD PERIODICS
3934              
3935             my $sni2du = $parm->{sinio2} * ($g3 * (.5 * (1 - 7 * $parm->{theta2}) *
3936             $sn2f2g - 3 * $parm->{unm5th} * $g10) - $g5 * $parm->{sini} *
3937             $csfg * (2 + $ecosf)) - .5 * $g5 * $parm->{theta2} * $axnm /
3938 5         22 $parm->{cosio2};
3939             my $xlamb = $fm + $omgasm + $xnodes + $g3 * (.5 * (1 + 6 *
3940             $parm->{cosi} - 7 * $parm->{theta2}) * $sn2f2g - 3 *
3941             ($parm->{unm5th} + 2 * $parm->{cosi}) * $g10) +
3942             $g5 * $parm->{sini} * ($parm->{cosi} * $axnm /
3943 5         25 (1 + $parm->{cosi}) - (2 + $ecosf) * $csfg);
3944             my $y4 = $parm->{sinio2} * $snfg + $csfg * $sni2du +
3945 5         13 .5 * $snfg * $parm->{cosio2} * $di;
3946             my $y5 = $parm->{sinio2} * $csfg - $snfg * $sni2du +
3947 5         13 .5 * $csfg * $parm->{cosio2} * $di;
3948 5         7 my $r = $rm + $dr;
3949             my $rdot = $xn * $am * $em * $snf / $beta + $g14 *
3950 5         16 (2 * $g2 * $parm->{unmth2} * $sn2f2g + $g4 * $csfg);
3951             my $rvdot = $xn * $am ** 2 * $beta / $rm + $g14 * $dr +
3952 5         13 $am * $g13 * $parm->{sini} * $diwc;
3953              
3954             #* ORIENTATION VECTORS
3955              
3956 5         11 my $snlamb = sin ($xlamb);
3957 5         10 my $cslamb = cos ($xlamb);
3958 5         12 my $temp = 2 * ($y5 * $snlamb - $y4 * $cslamb);
3959 5         11 my $ux = $y4 * $temp + $cslamb;
3960 5         10 my $vx = $y5 * $temp - $snlamb;
3961 5         21 $temp = 2 * ($y5 * $cslamb + $y4 * $snlamb);
3962 5         10 my $uy = - $y4 * $temp + $snlamb;
3963 5         8 my $vy = - $y5 * $temp + $cslamb;
3964 5         12 $temp = 2 * sqrt (1 - $y4 * $y4 - $y5 * $y5);
3965 5         10 my $uz = $y4 * $temp;
3966 5         10 my $vz = $y5 * $temp;
3967              
3968             #* POSITION AND VELOCITY
3969              
3970 5         9 my $x = $r * $ux;
3971 5         8 my $y = $r * $uy;
3972 5         10 my $z = $r * $uz;
3973 5         9 my $xdot = $rdot * $ux + $rvdot * $vx;
3974 5         10 my $ydot = $rdot * $uy + $rvdot * $vy;
3975 5         9 my $zdot = $rdot * $uz + $rvdot * $vz;
3976              
3977 5         17 return _convert_out ($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
3978             }
3979              
3980             =item $tle = $tle->sdp8($time)
3981              
3982             This method calculates the position of the body described by the TLE
3983             object at the given time, using the SDP8 model. The universal time of
3984             the object is set to $time, and the 'equinox_dynamical' attribute is set
3985             to the current value of the 'epoch_dynamical' attribute.
3986              
3987             The result is the original object reference. You need to call one of
3988             the Astro::Coord::ECI methods (e.g. geodetic () or equatorial ()) to
3989             retrieve the position you just calculated.
3990              
3991             "Spacetrack Report Number 3" (see "Acknowledgments") says that this
3992             model can be used only for near-earth orbits.
3993              
3994             =cut
3995              
3996             sub sdp8 {
3997 7     7 1 22 my ($self, $time) = @_;
3998 7         27 my $oid = $self->get('id');
3999 7         44 $self->{model_error} = undef;
4000 7         32 my $tsince = ($time - $self->{epoch}) / 60; # Calc. is in minutes.
4001              
4002             #>>> Rather than use a separate indicator argument to trigger
4003             #>>> initialization of the model, we use the Orcish maneuver to
4004             #>>> retrieve the results of initialization, performing the
4005             #>>> calculations if needed. -- TRW
4006              
4007 7   66     117 my $parm = $self->{&TLE_INIT}{TLE_sdp8} ||= do {
4008 2 50       13 $self->is_deep or croak <
4009             Error - The SDP8 model is not valid for near-earth objects.
4010             Use the SGP, SGP4, SGP4R, or SGP8 models instead.
4011             EOD
4012              
4013             #* RECOVER ORIGINAL MEAN MOTION (XNODP) AND SEMIMAJOR AXIS (AODP)
4014             #* FROM INPUT ELEMENTS --------- CALCULATE BALLISTIC COEFFICIENT
4015             #* (B TERM) FROM INPUT B* DRAG TERM
4016              
4017 2         17 my $a1 = (SGP_XKE / $self->{meanmotion}) ** SGP_TOTHRD;
4018 2         8 my $cosi = cos ($self->{inclination});
4019 2         33 my $theta2 = $cosi * $cosi;
4020 2         10 my $tthmun = 3 * $theta2 - 1;
4021 2         7 my $eosq = $self->{eccentricity} * $self->{eccentricity};
4022 2         8 my $beta02 = 1 - $eosq;
4023 2         6 my $beta0 = sqrt ($beta02);
4024 2         9 my $del1 = 1.5 * SGP_CK2 * $tthmun / ($a1 * $a1 * $beta0 * $beta02);
4025 2         11 my $a0 = $a1 * (1 - $del1 * (.5 * SGP_TOTHRD + $del1 * (1 + 134
4026             / 81 * $del1)));
4027 2         7 my $del0 = 1.5 * SGP_CK2 * $tthmun / ($a0 * $a0 * $beta0 * $beta02);
4028 2         19 my $aodp = $a0 / (1 - $del0);
4029 2         8 my $xnodp = $self->{meanmotion} / (1 + $del0);
4030 2         8 my $b = 2 * $self->{bstardrag} / SGP_RHO;
4031              
4032             #* INITIALIZATION
4033              
4034 2         6 my $po = $aodp * $beta02;
4035 2         7 my $pom2 = 1 / ($po * $po);
4036 2         7 my $sini = sin ($self->{inclination});
4037 2         7 my $sing = sin ($self->{argumentofperigee});
4038 2         8 my $cosg = cos ($self->{argumentofperigee});
4039 2         9 my $temp = .5 * $self->{inclination};
4040 2         5 my $sinio2 = sin ($temp);
4041 2         3 my $cosio2 = cos ($temp);
4042 2         7 my $theta4 = $theta2 ** 2;
4043 2         5 my $unm5th = 1 - 5 * $theta2;
4044 2         6 my $unmth2 = 1 - $theta2;
4045 2         3 my $a3cof = - SGP_XJ3 / SGP_CK2 * SGP_AE ** 3;
4046 2         4 my $pardt1 = 3 * SGP_CK2 * $pom2 * $xnodp;
4047 2         5 my $pardt2 = $pardt1 * SGP_CK2 * $pom2;
4048 2         6 my $pardt4 = 1.25 * SGP_CK4 * $pom2 * $pom2 * $xnodp;
4049 2         5 my $xmdt1 = .5 * $pardt1 * $beta0 * $tthmun;
4050 2         4 my $xgdt1 = - .5 * $pardt1 * $unm5th;
4051 2         4 my $xhdt1 = - $pardt1 * $cosi;
4052 2         10 my $xlldot = $xnodp + $xmdt1 + .0625 * $pardt2 * $beta0 * (13 -
4053             78 * $theta2 + 137 * $theta4);
4054 2         11 my $omgdt = $xgdt1 + .0625 * $pardt2 * (7 - 114 * $theta2 + 395
4055             * $theta4) + $pardt4 * (3 - 36 * $theta2 + 49 * $theta4);
4056 2         10 my $xnodot = $xhdt1 + (.5 * $pardt2 * (4 - 19 * $theta2) + 2 *
4057             $pardt4 * (3 - 7 * $theta2)) * $cosi;
4058 2         5 my $tsi = 1 / ($po - SGP_S);
4059 2         4 my $eta = $self->{eccentricity} * SGP_S * $tsi;
4060 2         5 my $eta2 = $eta ** 2;
4061 2         7 my $psim2 = abs (1 / (1 - $eta2));
4062 2         9 my $alpha2 = 1 + $eosq;
4063 2         5 my $eeta = $self->{eccentricity} * $eta;
4064 2         7 my $cos2g = 2 * $cosg ** 2 - 1;
4065 2         4 my $d5 = $tsi * $psim2;
4066 2         6 my $d1 = $d5 / $po;
4067 2         6 my $d2 = 12 + $eta2 * (36 + 4.5 * $eta2);
4068 2         6 my $d3 = $eta2 * (15 + 2.5 * $eta2);
4069 2         4 my $d4 = $eta * (5 + 3.75 * $eta2);
4070 2         5 my $b1 = SGP_CK2 * $tthmun;
4071 2         5 my $b2 = - SGP_CK2 * $unmth2;
4072 2         5 my $b3 = $a3cof * $sini;
4073 2         27 my $c0 = .5 * $b * SGP_RHO * SGP_QOMS2T * $xnodp * $aodp *
4074             $tsi ** 4 * $psim2 ** 3.5 / sqrt ($alpha2);
4075 2         7 my $c1 = 1.5 * $xnodp * $alpha2 ** 2 * $c0;
4076 2         5 my $c4 = $d1 * $d3 * $b2;
4077 2         5 my $c5 = $d5 * $d4 * $b3;
4078 2         10 my $xndt = $c1 * ( (2 + $eta2 * (3 + 34 * $eosq) +
4079             5 * $eeta * (4 + $eta2) + 8.5 * $eosq) + $d1 * $d2 * $b1 +
4080             $c4 * $cos2g + $c5 * $sing);
4081 2         4 my $xndtn = $xndt / $xnodp;
4082 2         7 my $edot = - SGP_TOTHRD * $xndtn * (1 - $self->{eccentricity});
4083 2         14 $self->{&TLE_INIT}{TLE_deep} = {$self->_dpinit ($eosq, $sini,
4084             $cosi, $beta0, $aodp, $theta2, $sing, $cosg, $beta02,
4085             $xlldot, $omgdt, $xnodot, $xnodp)};
4086             {
4087 2         49 a3cof => $a3cof,
4088             cosi => $cosi,
4089             cosio2 => $cosio2,
4090             ### ed => $ed,
4091             edot => $edot,
4092             ### gamma => $gamma,
4093             ### isimp => $isimp,
4094             omgdt => $omgdt,
4095             ### ovgpp => $ovgpp,
4096             ### pp => $pp,
4097             ### qq => $qq,
4098             sini => $sini,
4099             sinio2 => $sinio2,
4100             theta2 => $theta2,
4101             tthmun => $tthmun,
4102             unm5th => $unm5th,
4103             unmth2 => $unmth2,
4104             xgdt1 => $xgdt1,
4105             xhdt1 => $xhdt1,
4106             xlldot => $xlldot,
4107             xmdt1 => $xmdt1,
4108             ### xnd => $xnd,
4109             xndt => $xndt,
4110             xnodot => $xnodot,
4111             xnodp => $xnodp,
4112             };
4113             };
4114             #>>>trw my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4115              
4116             #* UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG
4117              
4118 7         27 my $z1 = .5 * $parm->{xndt} * $tsince * $tsince;
4119 7         16 my $z7 = 3.5 * SGP_TOTHRD * $z1 / $parm->{xnodp};
4120 7         19 my $xmamdf = $self->{meananomaly} + $parm->{xlldot} * $tsince;
4121             my $omgasm = $self->{argumentofperigee} + $parm->{omgdt} * $tsince +
4122 7         25 $z7 * $parm->{xgdt1};
4123             my $xnodes = $self->{ascendingnode} + $parm->{xnodot} * $tsince +
4124 7         38 $z7 * $parm->{xhdt1};
4125 7         20 my $xn = $parm->{xnodp};
4126 7         11 my ($em, $xinc);
4127 7         43 $self->_dpsec (\$xmamdf, \$omgasm, \$xnodes, \$em, \$xinc, \$xn, $tsince);
4128 7         18 $xn = $xn + $parm->{xndt} * $tsince;
4129 7         22 $em = $em + $parm->{edot} * $tsince;
4130 7         18 my $xmam = $xmamdf + $z1 + $z7 * $parm->{xmdt1};
4131 7         72 $self->_dpper (\$em, \$xinc, \$omgasm, \$xnodes, \$xmam, $tsince);
4132 7         34 $xmam = mod2pi ($xmam);
4133              
4134             #* SOLVE KEPLERS EQUATION
4135              
4136 7         23 my $zc2 = $xmam + $em * sin ($xmam) * (1 + $em * cos ($xmam));
4137 7         15 my ($cose, $sine, $zc5);
4138 7         24 for (my $i = 0; $i < 10; $i++) {
4139 38         54 $sine = sin ($zc2);
4140 38         96 $cose = cos ($zc2);
4141 38         71 $zc5 = 1 / (1 - $em * $cose);
4142 38         63 my $cape = ($xmam + $em * $sine - $zc2) * $zc5 + $zc2;
4143 38 100       82 last if (abs ($cape - $zc2) <= SGP_E6A);
4144 33         80 $zc2 = $cape;
4145             }
4146              
4147             #* SHORT PERIOD PRELIMINARY QUANTITIES
4148              
4149 7         27 my $am = (SGP_XKE / $xn) ** SGP_TOTHRD;
4150 7         37 my $beta2m = 1 - $em * $em;
4151             $self->{debug}
4152 7 50       26 and warn "Debug - OID $oid sdp8 effective eccentricity $em\n";
4153 7 100       610 $beta2m < 0
4154             and croak "Error - OID $oid Sdp8 effective eccentricity > 1";
4155 5         12 my $sinos = sin ($omgasm);
4156 5         14 my $cosos = cos ($omgasm);
4157 5         11 my $axnm = $em * $cosos;
4158 5         10 my $aynm = $em * $sinos;
4159 5         13 my $pm = $am * $beta2m;
4160 5         13 my $g1 = 1 / $pm;
4161 5         9 my $g2 = .5 * SGP_CK2 * $g1;
4162 5         11 my $g3 = $g2 * $g1;
4163 5         10 my $beta = sqrt ($beta2m);
4164 5         14 my $g4 = .25 * $parm->{a3cof} * $parm->{sini};
4165 5         12 my $g5 = .25 * $parm->{a3cof} * $g1;
4166 5         13 my $snf = $beta * $sine * $zc5;
4167 5         12 my $csf = ($cose - $em) * $zc5;
4168 5         19 my $fm = _actan ($snf,$csf);
4169 5         13 my $snfg = $snf * $cosos + $csf * $sinos;
4170 5         10 my $csfg = $csf * $cosos - $snf * $sinos;
4171 5         20 my $sn2f2g = 2 * $snfg * $csfg;
4172 5         17 my $cs2f2g = 2 * $csfg ** 2 - 1;
4173 5         11 my $ecosf = $em * $csf;
4174 5         11 my $g10 = $fm - $xmam + $em * $snf;
4175 5         13 my $rm = $pm / (1 + $ecosf);
4176 5         12 my $aovr = $am / $rm;
4177 5         11 my $g13 = $xn * $aovr;
4178 5         15 my $g14 = - $g13 * $aovr;
4179 5         17 my $dr = $g2 * ($parm->{unmth2} * $cs2f2g - 3 * $parm->{tthmun}) -
4180             $g4 * $snfg;
4181 5         14 my $diwc = 3 * $g3 * $parm->{sini} * $cs2f2g - $g5 * $aynm;
4182 5         11 my $di = $diwc * $parm->{cosi};
4183 5         12 my $sini2 = sin (.5 * $xinc);
4184              
4185             #* UPDATE FOR SHORT PERIOD PERIODICS
4186              
4187             my $sni2du = $parm->{sinio2} * ($g3 * (.5 * (1 - 7 * $parm->{theta2}) *
4188             $sn2f2g - 3 * $parm->{unm5th} * $g10) - $g5 * $parm->{sini} *
4189             $csfg * (2 + $ecosf)) - .5 * $g5 * $parm->{theta2} * $axnm /
4190 5         101 $parm->{cosio2};
4191             my $xlamb = $fm + $omgasm + $xnodes + $g3 * (.5 * (1 +
4192             6 * $parm->{cosi} - 7 * $parm->{theta2}) * $sn2f2g -
4193             3 * ($parm->{unm5th} + 2 * $parm->{cosi}) * $g10) +
4194             $g5 * $parm->{sini} * ($parm->{cosi} * $axnm /
4195 5         42 (1 + $parm->{cosi}) - (2 + $ecosf) * $csfg);
4196             my $y4 = $sini2 * $snfg + $csfg * $sni2du +
4197 5         14 .5 * $snfg * $parm->{cosio2} * $di;
4198             my $y5 = $sini2 * $csfg - $snfg * $sni2du +
4199 5         15 .5 * $csfg * $parm->{cosio2} * $di;
4200 5         8 my $r = $rm + $dr;
4201             my $rdot = $xn * $am * $em * $snf / $beta +
4202 5         18 $g14 * (2 * $g2 * $parm->{unmth2} * $sn2f2g + $g4 * $csfg);
4203             my $rvdot = $xn * $am ** 2 * $beta / $rm + $g14 * $dr +
4204 5         16 $am * $g13 * $parm->{sini} * $diwc;
4205              
4206             #* ORIENTATION VECTORS
4207              
4208 5         10 my $snlamb = sin ($xlamb);
4209 5         11 my $cslamb = cos ($xlamb);
4210 5         13 my $temp = 2 * ($y5 * $snlamb - $y4 * $cslamb);
4211 5         13 my $ux = $y4 * $temp + $cslamb;
4212 5         10 my $vx = $y5 * $temp - $snlamb;
4213 5         11 $temp = 2 * ($y5 * $cslamb + $y4 * $snlamb);
4214 5         11 my $uy = - $y4 * $temp + $snlamb;
4215 5         11 my $vy = - $y5 * $temp + $cslamb;
4216 5         13 $temp = 2 * sqrt (1 - $y4 * $y4 - $y5 * $y5);
4217 5         9 my $uz = $y4 * $temp;
4218 5         13 my $vz = $y5 * $temp;
4219              
4220             #* POSITION AND VELOCITY
4221              
4222 5         10 my $x = $r * $ux;
4223 5         10 my $y = $r * $uy;
4224 5         13 my $z = $r * $uz;
4225 5         12 my $xdot = $rdot * $ux + $rvdot * $vx;
4226 5         14 my $ydot = $rdot * $uy + $rvdot * $vy;
4227 5         10 my $zdot = $rdot * $uz + $rvdot * $vz;
4228              
4229 5         21 return _convert_out ($self, $x, $y, $z, $xdot, $ydot, $zdot, $time);
4230             }
4231              
4232             =item $self->time_set();
4233              
4234             This method sets the coordinates of the object to whatever is
4235             computed by the model specified by the model attribute. The
4236             'equinox_dynamical' attribute is set to the current value of the
4237             'epoch_dynamical' attribute.
4238              
4239             Although there is no reason this method can not be called directly, it
4240             exists to take advantage of the hook in the B
4241             object, to allow the position of the body to be computed when the
4242             time of the object is set.
4243              
4244             =cut
4245              
4246             sub time_set {
4247 18318     18318 1 31513 my $self = shift;
4248 18318 50       54830 my $model = $self->{model} or return;
4249 18318         45540 $self->$model ($self->universal);
4250 18304         45957 return;
4251             }
4252              
4253             #######################################################################
4254              
4255             # The deep-space routines
4256              
4257 16     16   267 use constant DS_ZNS => 1.19459E-5;
  16         67  
  16         1759  
4258 16     16   111 use constant DS_C1SS => 2.9864797E-6;
  16         51  
  16         1166  
4259 16     16   101 use constant DS_ZES => .01675;
  16         36  
  16         1124  
4260 16     16   103 use constant DS_ZNL => 1.5835218E-4;
  16         160  
  16         871  
4261 16     16   119 use constant DS_C1L => 4.7968065E-7;
  16         42  
  16         942  
4262 16     16   97 use constant DS_ZEL => .05490;
  16         55  
  16         991  
4263 16     16   93 use constant DS_ZCOSIS => .91744867;
  16         31  
  16         915  
4264 16     16   88 use constant DS_ZSINIS => .39785416;
  16         32  
  16         961  
4265 16     16   100 use constant DS_ZSINGS => -.98088458;
  16         31  
  16         951  
4266 16     16   91 use constant DS_ZCOSGS => .1945905;
  16         33  
  16         983  
4267 16     16   112 use constant DS_ZCOSHS => 1.0;
  16         62  
  16         843  
4268 16     16   99 use constant DS_ZSINHS => 0.0;
  16         40  
  16         805  
4269 16     16   84 use constant DS_Q22 => 1.7891679E-6;
  16         32  
  16         822  
4270 16     16   90 use constant DS_Q31 => 2.1460748E-6;
  16         32  
  16         960  
4271 16     16   108 use constant DS_Q33 => 2.2123015E-7;
  16         29  
  16         833  
4272 16     16   94 use constant DS_G22 => 5.7686396;
  16         72  
  16         834  
4273 16     16   90 use constant DS_G32 => 0.95240898;
  16         36  
  16         807  
4274 16     16   83 use constant DS_G44 => 1.8014998;
  16         104  
  16         815  
4275 16     16   96 use constant DS_G52 => 1.0508330;
  16         44  
  16         851  
4276 16     16   87 use constant DS_G54 => 4.4108898;
  16         57  
  16         839  
4277 16     16   86 use constant DS_ROOT22 => 1.7891679E-6;
  16         37  
  16         875  
4278 16     16   89 use constant DS_ROOT32 => 3.7393792E-7;
  16         55  
  16         931  
4279 16     16   104 use constant DS_ROOT44 => 7.3636953E-9;
  16         49  
  16         896  
4280 16     16   94 use constant DS_ROOT52 => 1.1428639E-7;
  16         39  
  16         929  
4281 16     16   102 use constant DS_ROOT54 => 2.1765803E-9;
  16         42  
  16         865  
4282 16     16   83 use constant DS_THDT => 4.3752691E-3;
  16         47  
  16         116639  
4283              
4284             # _dpinit
4285             #
4286             # the corresponding FORTRAN IV simply leaves values in variables
4287             # for the use of the other deep-space routines. For the Perl
4288             # translation, we figure out which ones are actually used, and
4289             # return a list of key/value pairs to be added to the pre-
4290             # computed model parameters. -- TRW
4291              
4292             sub _dpinit {
4293 4     4   23 my ($self, $eqsq, $siniq, $cosiq, $rteqsq, $a0, $cosq2, $sinomo,
4294             $cosomo, $bsq, $xlldot, $omgdt, $xnodot, $xnodp) = @_;
4295              
4296 4         47 my $thgr = thetag ($self->{epoch});
4297 4         11 my $eq = $self->{eccentricity};
4298 4         26 my $xnq = $xnodp;
4299 4         10 my $aqnv = 1 / $a0;
4300 4         12 my $xqncl = $self->{inclination};
4301 4         11 my $xmao = $self->{meananomaly};
4302 4         10 my $xpidot = $omgdt + $xnodot;
4303 4         11 my $sinq = sin ($self->{ascendingnode});
4304 4         8 my $cosq = cos ($self->{ascendingnode});
4305              
4306             #* Initialize lunar & solar terms
4307              
4308 4         11 my $day = $self->{ds50} + 18261.5;
4309              
4310             #>>> The original code contained here a comparison of DAY to
4311             #>>> uninitialized variable PREEP, and "optimized out" the
4312             #>>> following if they were equal. This works naturally in
4313             #>>> FORTRAN, which has a different concept of variable scoping.
4314             #>>> Rather than make this work in Perl, I have removed the
4315             #>>> test. As I understand the FORTRAN, it's only used if
4316             #>>> consecutive data sets have exactly the same epoch. Given
4317             #>>> that this is initialization code, the optimization is
4318             #>>> (I hope!) not that important, and given the mess that
4319             #>>> follows, its absence will not (I hope!) be noticable. - TRW
4320              
4321 4         10 my $xnodce = 4.5236020 - 9.2422029E-4 * $day;
4322 4         6 my $stem = sin ($xnodce);
4323 4         9 my $ctem = cos ($xnodce);
4324 4         9 my $zcosil = .91375164 - .03568096 * $ctem;
4325 4         9 my $zsinil = sqrt (1 - $zcosil * $zcosil);
4326 4         10 my $zsinhl = .089683511 * $stem / $zsinil;
4327 4         8 my $zcoshl = sqrt (1 - $zsinhl * $zsinhl);
4328 4         9 my $c = 4.7199672 + .22997150 * $day;
4329 4         7 my $gam = 5.8351514 + .0019443680 * $day;
4330 4         14 my $zmol = mod2pi ($c - $gam);
4331 4         9 my $zx = .39785416 * $stem / $zsinil;
4332 4         15 my $zy = $zcoshl * $ctem + 0.91744867 * $zsinhl * $stem;
4333 4         18 $zx = _actan ($zx, $zy);
4334 4         9 $zx = $gam + $zx - $xnodce;
4335 4         10 my $zcosgl = cos ($zx);
4336 4         8 my $zsingl = sin ($zx);
4337 4         22 my $zmos = mod2pi (6.2565837 + .017201977 * $day);
4338              
4339             #>>> Here endeth the optimization - only it isn't one any more
4340             #>>> since I removed it. - TRW
4341              
4342             #>>> The following loop replaces some spaghetti involving an
4343             #>>> assigned goto which essentially executes the same big chunk
4344             #>>> of obscure code twice: once for the Sun, and once for the Moon.
4345             #>>> The comments "Do Solar terms" and "Do Lunar terms" in the
4346             #>>> original apply to the first and second iterations of the loop,
4347             #>>> respectively. The "my" variables declared just before the "for"
4348             #>>> are those values computed inside the loop that are used outside
4349             #>>> the loop. Accumulators are set to zero. -- TRW
4350              
4351             #>>>trw my $savtsn = 1.0E20;
4352 4         9 my $xnoi = 1 / $xnq;
4353 4         12 my ($sse, $ssi, $ssl, $ssh, $ssg) = (0, 0, 0, 0, 0);
4354 4         14 my ($se2, $ee2, $si2, $xi2, $sl2, $xl2, $sgh2, $xgh2, $sh2, $xh2, $se3,
4355             $e3, $si3, $xi3, $sl3, $xl3, $sgh3, $xgh3, $sh3, $xh3, $sl4, $xl4,
4356             $sgh4, $xgh4);
4357              
4358 4         34 foreach my $inputs (
4359             [DS_ZCOSGS, DS_ZSINGS, DS_ZCOSIS, DS_ZSINIS, $cosq, $sinq,
4360             DS_C1SS, DS_ZNS, DS_ZES, $zmos, 0],
4361             [$zcosgl, $zsingl, $zcosil, $zsinil,
4362             $zcoshl * $cosq + $zsinhl * $sinq,
4363             $sinq * $zcoshl - $cosq * $zsinhl, DS_C1L, DS_ZNL,
4364             DS_ZEL, $zmol, 1],
4365             ) {
4366              
4367             #>>> Pick off the terms specific to the body being covered by this
4368             #>>> iteration. The $lunar flag was not in the original FORTRAN, but
4369             #>>> was added to help convert the assigned GOTOs and associated
4370             #>>> code into a loop. -- TRW
4371              
4372             #>>>trw my ($zcosg, $zsing, $zcosi, $zsini, $zcosh, $zsinh, $cc, $zn, $ze,
4373             #>>>trw $zmo, $lunar) = @$inputs;
4374 8         26 my ($zcosg, $zsing, $zcosi, $zsini, $zcosh, $zsinh, $cc, $zn, $ze,
4375             undef, $lunar) = @$inputs;
4376              
4377             #>>> From here until the next comment of mine is essentialy
4378             #>>> verbatim from the original FORTRAN - or as verbatim as
4379             #>>> is reasonable considering that the following is Perl. -- TRW
4380              
4381 8         16 my $a1 = $zcosg * $zcosh + $zsing * $zcosi * $zsinh;
4382 8         18 my $a3 = - $zsing * $zcosh + $zcosg * $zcosi * $zsinh;
4383 8         16 my $a7 = - $zcosg * $zsinh + $zsing * $zcosi * $zcosh;
4384 8         13 my $a8 = $zsing * $zsini;
4385 8         11 my $a9 = $zsing * $zsinh + $zcosg * $zcosi * $zcosh;
4386 8         12 my $a10 = $zcosg * $zsini;
4387 8         14 my $a2 = $cosiq * $a7 + $siniq * $a8;
4388 8         13 my $a4 = $cosiq * $a9 + $siniq * $a10;
4389 8         14 my $a5 = - $siniq * $a7 + $cosiq * $a8;
4390 8         15 my $a6 = - $siniq * $a9 + $cosiq * $a10;
4391             #C
4392 8         12 my $x1 = $a1 * $cosomo + $a2 * $sinomo;
4393 8         12 my $x2 = $a3 * $cosomo + $a4 * $sinomo;
4394 8         13 my $x3 = - $a1 * $sinomo + $a2 * $cosomo;
4395 8         13 my $x4 = - $a3 * $sinomo + $a4 * $cosomo;
4396 8         10 my $x5 = $a5 * $sinomo;
4397 8         13 my $x6 = $a6 * $sinomo;
4398 8         10 my $x7 = $a5 * $cosomo;
4399 8         15 my $x8 = $a6 * $cosomo;
4400             #C
4401 8         16 my $z31 = 12 * $x1 * $x1 - 3 * $x3 * $x3;
4402 8         18 my $z32 = 24 * $x1 * $x2 - 6 * $x3 * $x4;
4403 8         21 my $z33 = 12 * $x2 * $x2 - 3 * $x4 * $x4;
4404 8         15 my $z1 = 3 * ($a1 * $a1 + $a2 * $a2) + $z31 * $eqsq;
4405 8         14 my $z2 = 6 * ($a1 * $a3 + $a2 * $a4) + $z32 * $eqsq;
4406 8         25 my $z3 = 3 * ($a3 * $a3 + $a4 * $a4) + $z33 * $eqsq;
4407 8         20 my $z11 = - 6 * $a1 * $a5 + $eqsq * ( - 24 * $x1 * $x7 - 6 * $x3 * $x5);
4408 8         25 my $z12 = - 6 * ($a1 * $a6 + $a3 * $a5) + $eqsq *
4409             ( - 24 * ($x2 * $x7 + $x1 * $x8) - 6 * ($x3 * $x6 + $x4 * $x5));
4410 8         18 my $z13 = - 6 * $a3 * $a6 + $eqsq * ( - 24 * $x2 * $x8 - 6 * $x4 * $x6);
4411 8         16 my $z21 = 6 * $a2 * $a5 + $eqsq * (24 * $x1 * $x5 - 6 * $x3 * $x7);
4412 8         26 my $z22 = 6 * ($a4 * $a5 + $a2 * $a6) + $eqsq *
4413             (24 * ($x2 * $x5 + $x1 * $x6) - 6 * ($x4 * $x7 + $x3 * $x8));
4414 8         18 my $z23 = 6 * $a4 * $a6 + $eqsq * (24 * $x2 * $x6 - 6 * $x4 * $x8);
4415 8         14 $z1 = $z1 + $z1 + $bsq * $z31;
4416 8         41 $z2 = $z2 + $z2 + $bsq * $z32;
4417 8         13 $z3 = $z3 + $z3 + $bsq * $z33;
4418 8         13 my $s3 = $cc * $xnoi;
4419 8         14 my $s2 = - .5 * $s3 / $rteqsq;
4420 8         13 my $s4 = $s3 * $rteqsq;
4421 8         12 my $s1 = - 15 * $eq * $s4;
4422 8         23 my $s5 = $x1 * $x3 + $x2 * $x4;
4423 8         14 my $s6 = $x2 * $x3 + $x1 * $x4;
4424 8         15 my $s7 = $x2 * $x4 - $x1 * $x3;
4425 8         13 my $se = $s1 * $zn * $s5;
4426 8         19 my $si = $s2 * $zn * ($z11 + $z13);
4427 8         20 my $sl = - $zn * $s3 * ($z1 + $z3 - 14 - 6 * $eqsq);
4428 8         14 my $sgh = $s4 * $zn * ($z31 + $z33 - 6.);
4429 8 50       23 my $sh = $xqncl < 5.2359877E-2 ? 0 : - $zn * $s2 * ($z21 + $z23);
4430 8         14 $ee2 = 2 * $s1 * $s6;
4431 8         12 $e3 = 2 * $s1 * $s7;
4432 8         12 $xi2 = 2 * $s2 * $z12;
4433 8         14 $xi3 = 2 * $s2 * ($z13 - $z11);
4434 8         14 $xl2 = - 2 * $s3 * $z2;
4435 8         13 $xl3 = - 2 * $s3 * ($z3 - $z1);
4436 8         18 $xl4 = - 2 * $s3 * ( - 21 - 9 * $eqsq) * $ze;
4437 8         11 $xgh2 = 2 * $s4 * $z32;
4438 8         15 $xgh3 = 2 * $s4 * ($z33 - $z31);
4439 8         12 $xgh4 = - 18 * $s4 * $ze;
4440 8         22 $xh2 = - 2 * $s2 * $z22;
4441 8         11 $xh3 = - 2 * $s2 * ($z23 - $z21);
4442              
4443             #>>> The following intermediate values are used outside the loop.
4444             #>>> We save off the Solar values. The Lunar values remain after
4445             #>>> the second iteration, and are used in situ. -- TRW
4446              
4447 8 100       21 unless ($lunar) {
4448 4         7 $se2 = $ee2;
4449 4         5 $si2 = $xi2;
4450 4         7 $sl2 = $xl2;
4451 4         6 $sgh2 = $xgh2;
4452 4         7 $sh2 = $xh2;
4453 4         7 $se3 = $e3;
4454 4         6 $si3 = $xi3;
4455 4         8 $sl3 = $xl3;
4456 4         7 $sgh3 = $xgh3;
4457 4         5 $sh3 = $xh3;
4458 4         7 $sl4 = $xl4;
4459 4         6 $sgh4 = $xgh4;
4460             }
4461              
4462             #>>> Okay, now we accumulate everything that needs accumulating.
4463             #>>> The Lunar calculation is slightly different from the solar
4464             #>>> one, a problem we fix up using the introduced $lunar flag.
4465             #>>> -- TRW
4466              
4467 8         13 $sse = $sse + $se;
4468 8         20 $ssi = $ssi + $si;
4469 8         13 $ssl = $ssl + $sl;
4470 8         15 $ssh = $ssh + $sh / $siniq;
4471 8 100       35 $ssg = $ssg + $sgh - ($lunar ? $cosiq / $siniq * $sh : $cosiq * $ssh);
4472              
4473             }
4474              
4475             #>>> The only substantial modification in the following is the
4476             #>>> swapping of 24-hour and 12-hour calculations for clarity.
4477             #>>> -- TRW
4478              
4479 4         11 my $iresfl = 0;
4480 4         8 my $isynfl = 0;
4481 4         16 my ($bfact, $xlamo);
4482 4         0 my ($d2201, $d2211, $d3210, $d3222, $d4410, $d4422,
4483             $d5220, $d5232, $d5421, $d5433,
4484             $del1, $del2, $del3, $fasx2, $fasx4, $fasx6);
4485              
4486 4 50 33     59 if ($xnq < .0052359877 && $xnq > .0034906585) {
    50 33        
      33        
4487              
4488             #* Synchronous resonance terms initialization.
4489              
4490 0         0 $iresfl = 1;
4491 0         0 $isynfl = 1;
4492 0         0 my $g200 = 1.0 + $eqsq * ( - 2.5 + .8125 * $eqsq);
4493 0         0 my $g310 = 1.0 + 2.0 * $eqsq;
4494 0         0 my $g300 = 1.0 + $eqsq * ( - 6.0 + 6.60937 * $eqsq);
4495 0         0 my $f220 = .75 * (1 + $cosiq) * (1 + $cosiq);
4496 0         0 my $f311 = .9375 * $siniq * $siniq * (1 + 3 * $cosiq) - .75 * (1
4497             + $cosiq);
4498 0         0 my $f330 = 1 + $cosiq;
4499 0         0 $f330 = 1.875 * $f330 * $f330 * $f330;
4500 0         0 $del1 = 3 * $xnq * $xnq * $aqnv * $aqnv;
4501 0         0 $del2 = 2 * $del1 * $f220 * $g200 * DS_Q22;
4502 0         0 $del3 = 3 * $del1 * $f330 * $g300 * DS_Q33 * $aqnv;
4503 0         0 $del1 = $del1 * $f311 * $g310 * DS_Q31 * $aqnv;
4504 0         0 $fasx2 = .13130908;
4505 0         0 $fasx4 = 2.8843198;
4506 0         0 $fasx6 = .37448087;
4507             $xlamo = $xmao + $self->{ascendingnode} +
4508 0         0 $self->{argumentofperigee} - $thgr;
4509 0         0 $bfact = $xlldot + $xpidot - DS_THDT;
4510 0         0 $bfact = $bfact + $ssl + $ssg + $ssh;
4511             } elsif ($xnq < 8.26E-3 || $xnq > 9.24E-3 || $eq < 0.5) {
4512              
4513             #>>> Do nothing. The original code returned from this point,
4514             #>>> leaving atime, step2, stepn, stepp, xfact, xli, and xni
4515             #>>> uninitialized. It's a minor bit of wasted motion to
4516             #>>> compute these when they're not used, but this way the
4517             #>>> method returns from only one point, which makes the
4518             #>>> provision of debug output easier.
4519              
4520             } else {
4521              
4522             #* Geopotential resonance initialization for 12 hour orbits
4523              
4524 0         0 $iresfl = 1;
4525 0         0 my $eoc = $eq * $eqsq;
4526 0         0 my $g201 = - .306 - ($eq - .64) * .440;
4527 0         0 my ($g211, $g310, $g322, $g410, $g422, $g520);
4528 0 0       0 if ($eq <= .65) {
4529 0         0 $g211 = 3.616 - 13.247 * $eq + 16.290 * $eqsq;
4530 0         0 $g310 = - 19.302 + 117.390 * $eq - 228.419 * $eqsq + 156.591
4531             * $eoc;
4532 0         0 $g322 = - 18.9068 + 109.7927 * $eq - 214.6334 * $eqsq +
4533             146.5816 * $eoc;
4534 0         0 $g410 = - 41.122 + 242.694 * $eq - 471.094 * $eqsq + 313.953
4535             * $eoc;
4536 0         0 $g422 = - 146.407 + 841.880 * $eq - 1629.014 * $eqsq +
4537             1083.435 * $eoc;
4538 0         0 $g520 = - 532.114 + 3017.977 * $eq - 5740 * $eqsq + 3708.276
4539             * $eoc;
4540             } else {
4541 0         0 $g211 = - 72.099 + 331.819 * $eq - 508.738 * $eqsq +
4542             266.724 * $eoc;
4543 0         0 $g310 = - 346.844 + 1582.851 * $eq - 2415.925 * $eqsq +
4544             1246.113 * $eoc;
4545 0         0 $g322 = - 342.585 + 1554.908 * $eq - 2366.899 * $eqsq +
4546             1215.972 * $eoc;
4547 0         0 $g410 = - 1052.797 + 4758.686 * $eq - 7193.992 * $eqsq +
4548             3651.957 * $eoc;
4549 0         0 $g422 = - 3581.69 + 16178.11 * $eq - 24462.77 * $eqsq +
4550             12422.52 * $eoc;
4551 0 0       0 $g520 = $eq > .715 ?
4552             -5149.66 + 29936.92 * $eq - 54087.36 * $eqsq + 31324.56 * $eoc :
4553             1464.74 - 4664.75 * $eq + 3763.64 * $eqsq;
4554             }
4555 0         0 my ($g533, $g521, $g532);
4556 0 0       0 if ($eq < .7) {
4557 0         0 $g533 = - 919.2277 + 4988.61 * $eq - 9064.77 * $eqsq +
4558             5542.21 * $eoc;
4559 0         0 $g521 = - 822.71072 + 4568.6173 * $eq - 8491.4146 * $eqsq +
4560             5337.524 * $eoc;
4561 0         0 $g532 = - 853.666 + 4690.25 * $eq - 8624.77 * $eqsq +
4562             5341.4 * $eoc;
4563             } else {
4564 0         0 $g533 = - 37995.78 + 161616.52 * $eq - 229838.2 * $eqsq +
4565             109377.94 * $eoc;
4566 0         0 $g521 = - 51752.104 + 218913.95 * $eq - 309468.16 * $eqsq +
4567             146349.42 * $eoc;
4568 0         0 $g532 = - 40023.88 + 170470.89 * $eq - 242699.48 * $eqsq +
4569             115605.82 * $eoc;
4570             }
4571              
4572 0         0 my $sini2 = $siniq * $siniq;
4573 0         0 my $f220 = .75 * (1 + 2 * $cosiq + $cosq2);
4574 0         0 my $f221 = 1.5 * $sini2;
4575 0         0 my $f321 = 1.875 * $siniq * (1 - 2 * $cosiq - 3 * $cosq2);
4576 0         0 my $f322 = - 1.875 * $siniq * (1 + 2 * $cosiq - 3 * $cosq2);
4577 0         0 my $f441 = 35 * $sini2 * $f220;
4578 0         0 my $f442 = 39.3750 * $sini2 * $sini2;
4579 0         0 my $f522 = 9.84375 * $siniq * ($sini2 * (1 - 2 * $cosiq - 5 * $cosq2) +
4580             .33333333 * ( - 2 + 4 * $cosiq + 6 * $cosq2));
4581 0         0 my $f523 = $siniq * (4.92187512 * $sini2 * ( - 2 - 4 * $cosiq +
4582             10 * $cosq2) + 6.56250012 * (1 + 2 * $cosiq - 3 * $cosq2));
4583 0         0 my $f542 = 29.53125 * $siniq * (2 - 8 * $cosiq + $cosq2 * ( - 12 +
4584             8 * $cosiq + 10 * $cosq2));
4585 0         0 my $f543 = 29.53125 * $siniq * ( - 2 - 8 * $cosiq + $cosq2 * (12 +
4586             8 * $cosiq - 10 * $cosq2));
4587 0         0 my $xno2 = $xnq * $xnq;
4588 0         0 my $ainv2 = $aqnv * $aqnv;
4589 0         0 my $temp1 = 3 * $xno2 * $ainv2;
4590 0         0 my $temp = $temp1 * DS_ROOT22;
4591 0         0 $d2201 = $temp * $f220 * $g201;
4592 0         0 $d2211 = $temp * $f221 * $g211;
4593 0         0 $temp1 = $temp1 * $aqnv;
4594 0         0 $temp = $temp1 * DS_ROOT32;
4595 0         0 $d3210 = $temp * $f321 * $g310;
4596 0         0 $d3222 = $temp * $f322 * $g322;
4597 0         0 $temp1 = $temp1 * $aqnv;
4598 0         0 $temp = 2 * $temp1 * DS_ROOT44;
4599 0         0 $d4410 = $temp * $f441 * $g410;
4600 0         0 $d4422 = $temp * $f442 * $g422;
4601 0         0 $temp1 = $temp1 * $aqnv;
4602 0         0 $temp = $temp1 * DS_ROOT52;
4603 0         0 $d5220 = $temp * $f522 * $g520;
4604 0         0 $d5232 = $temp * $f523 * $g532;
4605 0         0 $temp = 2 * $temp1 * DS_ROOT54;
4606 0         0 $d5421 = $temp * $f542 * $g521;
4607 0         0 $d5433 = $temp * $f543 * $g533;
4608             $xlamo = $xmao + $self->{ascendingnode} + $self->{ascendingnode} -
4609 0         0 $thgr - $thgr;
4610 0         0 $bfact = $xlldot + $xnodot + $xnodot - DS_THDT - DS_THDT;
4611 0         0 $bfact = $bfact + $ssl + $ssh + $ssh;
4612             }
4613              
4614             # $bfact won't be defined unless we're a 12- or 24-hour orbit.
4615 4         8 my $xfact;
4616 4 50       13 defined $bfact and $xfact = $bfact - $xnq;
4617             #C
4618             #C INITIALIZE INTEGRATOR
4619             #C
4620 4         8 my $xli = $xlamo;
4621 4         8 my $xni = $xnq;
4622 4         12 my $atime = 0;
4623 4         6 my $stepp = 720;
4624 4         7 my $stepn = -720;
4625 4         9 my $step2 = 259200;
4626              
4627 4 50       15 $self->{debug} and do {
4628 0         0 local $Data::Dumper::Terse = 1;
4629 0         0 print <
4630             Debug _dpinit -
4631 0 0       0 atime = @{[defined $atime ? $atime : q{undef}]}
4632 0 0       0 cosiq = @{[defined $cosiq ? $cosiq : q{undef}]}
4633 0 0       0 d2201 = @{[defined $d2201 ? $d2201 : q{undef}]}
4634 0 0       0 d2211 = @{[defined $d2211 ? $d2211 : q{undef}]}
4635 0 0       0 d3210 = @{[defined $d3210 ? $d3210 : q{undef}]}
4636 0 0       0 d3222 = @{[defined $d3222 ? $d3222 : q{undef}]}
4637 0 0       0 d4410 = @{[defined $d4410 ? $d4410 : q{undef}]}
4638 0 0       0 d4422 = @{[defined $d4422 ? $d4422 : q{undef}]}
4639 0 0       0 d5220 = @{[defined $d5220 ? $d5220 : q{undef}]}
4640 0 0       0 d5232 = @{[defined $d5232 ? $d5232 : q{undef}]}
4641 0 0       0 d5421 = @{[defined $d5421 ? $d5421 : q{undef}]}
4642 0 0       0 d5433 = @{[defined $d5433 ? $d5433 : q{undef}]}
4643 0 0       0 del1 = @{[defined $del1 ? $del1 : q{undef}]}
4644 0 0       0 del2 = @{[defined $del2 ? $del2 : q{undef}]}
4645 0 0       0 del3 = @{[defined $del3 ? $del3 : q{undef}]}
4646 0 0       0 e3 = @{[defined $e3 ? $e3 : q{undef}]}
4647 0 0       0 ee2 = @{[defined $ee2 ? $ee2 : q{undef}]}
4648 0 0       0 fasx2 = @{[defined $fasx2 ? $fasx2 : q{undef}]}
4649 0 0       0 fasx4 = @{[defined $fasx4 ? $fasx4 : q{undef}]}
4650 0 0       0 fasx6 = @{[defined $fasx6 ? $fasx6 : q{undef}]}
4651 0 0       0 iresfl = @{[defined $iresfl ? $iresfl : q{undef}]}
4652 0 0       0 isynfl = @{[defined $isynfl ? $isynfl : q{undef}]}
4653 0 0       0 omgdt = @{[defined $omgdt ? $omgdt : q{undef}]}
4654 0 0       0 se2 = @{[defined $se2 ? $se2 : q{undef}]}
4655 0 0       0 se3 = @{[defined $se3 ? $se3 : q{undef}]}
4656 0 0       0 sgh2 = @{[defined $sgh2 ? $sgh2 : q{undef}]}
4657 0 0       0 sgh3 = @{[defined $sgh3 ? $sgh3 : q{undef}]}
4658 0 0       0 sgh4 = @{[defined $sgh4 ? $sgh4 : q{undef}]}
4659 0 0       0 sh2 = @{[defined $sh2 ? $sh2 : q{undef}]}
4660 0 0       0 sh3 = @{[defined $sh3 ? $sh3 : q{undef}]}
4661 0 0       0 si2 = @{[defined $si2 ? $si2 : q{undef}]}
4662 0 0       0 si3 = @{[defined $si3 ? $si3 : q{undef}]}
4663 0 0       0 siniq = @{[defined $siniq ? $siniq : q{undef}]}
4664 0 0       0 sl2 = @{[defined $sl2 ? $sl2 : q{undef}]}
4665 0 0       0 sl3 = @{[defined $sl3 ? $sl3 : q{undef}]}
4666 0 0       0 sl4 = @{[defined $sl4 ? $sl4 : q{undef}]}
4667 0 0       0 sse = @{[defined $sse ? $sse : q{undef}]}
4668 0 0       0 ssg = @{[defined $ssg ? $ssg : q{undef}]} << 9.4652e-09 in test_sgp-c-lib
4669 0 0       0 ssh = @{[defined $ssh ? $ssh : q{undef}]}
4670 0 0       0 ssi = @{[defined $ssi ? $ssi : q{undef}]}
4671 0 0       0 ssl = @{[defined $ssl ? $ssl : q{undef}]}
4672 0 0       0 step2 = @{[defined $step2 ? $step2 : q{undef}]}
4673 0 0       0 stepn = @{[defined $stepn ? $stepn : q{undef}]}
4674 0 0       0 stepp = @{[defined $stepp ? $stepp : q{undef}]}
4675 0 0       0 thgr = @{[defined $thgr ? $thgr : q{undef}]} << 1.26513 in test_sgp-c-lib
4676 0 0       0 xfact = @{[defined $xfact ? $xfact : q{undef}]}
4677 0 0       0 xgh2 = @{[defined $xgh2 ? $xgh2 : q{undef}]}
4678 0 0       0 xgh3 = @{[defined $xgh3 ? $xgh3 : q{undef}]}
4679 0 0       0 xgh4 = @{[defined $xgh4 ? $xgh4 : q{undef}]}
4680 0 0       0 xh2 = @{[defined $xh2 ? $xh2 : q{undef}]}
4681 0 0       0 xh3 = @{[defined $xh3 ? $xh3 : q{undef}]}
4682 0 0       0 xi2 = @{[defined $xi2 ? $xi2 : q{undef}]}
4683 0 0       0 xi3 = @{[defined $xi3 ? $xi3 : q{undef}]}
4684 0 0       0 xl2 = @{[defined $xl2 ? $xl2 : q{undef}]}
4685 0 0       0 xl3 = @{[defined $xl3 ? $xl3 : q{undef}]}
4686 0 0       0 xl4 = @{[defined $xl4 ? $xl4 : q{undef}]}
4687 0 0       0 xlamo = @{[defined $xlamo ? $xlamo : q{undef}]}
4688 0 0       0 xli = @{[defined $xli ? $xli : q{undef}]}
4689 0 0       0 xni = @{[defined $xni ? $xni : q{undef}]}
4690 0 0       0 xnq = @{[defined $xnq ? $xnq : q{undef}]}
4691 0 0       0 zmol = @{[defined $zmol ? $zmol : q{undef}]}
4692 0 0       0 zmos = @{[defined $zmos ? $zmos : q{undef}]}
4693             eod
4694             };
4695              
4696             return (
4697 4         311 atime => $atime,
4698             cosiq => $cosiq,
4699             d2201 => $d2201,
4700             d2211 => $d2211,
4701             d3210 => $d3210,
4702             d3222 => $d3222,
4703             d4410 => $d4410,
4704             d4422 => $d4422,
4705             d5220 => $d5220,
4706             d5232 => $d5232,
4707             d5421 => $d5421,
4708             d5433 => $d5433,
4709             del1 => $del1,
4710             del2 => $del2,
4711             del3 => $del3,
4712             e3 => $e3,
4713             ee2 => $ee2,
4714             fasx2 => $fasx2,
4715             fasx4 => $fasx4,
4716             fasx6 => $fasx6,
4717             iresfl => $iresfl,
4718             isynfl => $isynfl,
4719             omgdt => $omgdt,
4720             se2 => $se2,
4721             se3 => $se3,
4722             sgh2 => $sgh2,
4723             sgh3 => $sgh3,
4724             sgh4 => $sgh4,
4725             sh2 => $sh2,
4726             sh3 => $sh3,
4727             si2 => $si2,
4728             si3 => $si3,
4729             siniq => $siniq,
4730             sl2 => $sl2,
4731             sl3 => $sl3,
4732             sl4 => $sl4,
4733             sse => $sse,
4734             ssg => $ssg,
4735             ssh => $ssh,
4736             ssi => $ssi,
4737             ssl => $ssl,
4738             step2 => $step2,
4739             stepn => $stepn,
4740             stepp => $stepp,
4741             thgr => $thgr,
4742             xfact => $xfact,
4743             xgh2 => $xgh2,
4744             xgh3 => $xgh3,
4745             xgh4 => $xgh4,
4746             xh2 => $xh2,
4747             xh3 => $xh3,
4748             xi2 => $xi2,
4749             xi3 => $xi3,
4750             xl2 => $xl2,
4751             xl3 => $xl3,
4752             xl4 => $xl4,
4753             xlamo => $xlamo,
4754             xli => $xli,
4755             xni => $xni,
4756             xnq => $xnq,
4757             zmol => $zmol,
4758             zmos => $zmos,
4759             );
4760             }
4761              
4762             # _dpsec
4763              
4764             # Compute deep space secular effects.
4765              
4766             # The corresponding FORTRAN was a goodly plate of spaghetti, with
4767             # a couple chunks of code being executed via assigned GOTOs. Not
4768             # only that, but most of the arguments get modified, and
4769             # therefore need to be passed by reference. So the corresponding
4770             # PERL may not end up corresponding very closely.
4771              
4772             # In fact, at this point in the code the only argument that is
4773             # NOT modified is T.
4774              
4775             sub _dpsec {
4776 14     14   49 my ($self, @args) = @_;
4777 14         50 my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4778 14         47 my ($xll, $omgasm, $xnodes, $em, $xinc, $xn, $t) = @args;
4779 14         23 my @orig;
4780             $self->{debug}
4781 0 0       0 and @orig = map {defined $_ ? $_ : 'undef'}
4782 14 0       49 map { SCALAR_REF eq ref $_ ? $$_ : $_} @args;
  0 50       0  
4783              
4784             #* ENTRANCE FOR DEEP SPACE SECULAR EFFECTS
4785              
4786 14         45 $$xll = $$xll + $dpsp->{ssl} * $t;
4787 14         45 $$omgasm = $$omgasm + $dpsp->{ssg} * $t;
4788 14         34 $$xnodes = $$xnodes + $dpsp->{ssh} * $t;
4789 14         48 $$em = $self->{eccentricity} + $dpsp->{sse} * $t;
4790 14 100       61 ($$xinc = $self->{inclination} + $dpsp->{ssi} * $t) < 0 and do {
4791 4         7 $$xinc = - $$xinc;
4792 4         6 $$xnodes = $$xnodes + SGP_PI;
4793 4         6 $$omgasm = $$omgasm - SGP_PI;
4794             };
4795              
4796 14 50       43 $dpsp->{iresfl} and do {
4797              
4798 0         0 my ($delt);
4799 0         0 while (1) {
4800             (!$dpsp->{atime} || $t >= 0 && $dpsp->{atime} < 0 ||
4801 0 0 0     0 $t < 0 && $dpsp->{atime} >= 0) and do {
      0        
      0        
      0        
4802              
4803             #C
4804             #C EPOCH RESTART
4805             #C
4806              
4807 0 0       0 $delt = $t >= 0 ? $dpsp->{stepp} : $dpsp->{stepn};
4808 0         0 $dpsp->{atime} = 0;
4809 0         0 $dpsp->{xni} = $dpsp->{xnq};
4810 0         0 $dpsp->{xli} = $dpsp->{xlamo};
4811 0         0 last;
4812             };
4813 0 0       0 abs ($t) >= abs ($dpsp->{atime}) and do {
4814 0 0       0 $delt = $t > 0 ? $dpsp->{stepp} : $dpsp->{stepn};
4815 0         0 last;
4816             };
4817 0 0       0 $delt = $t > 0 ? $dpsp->{stepn} : $dpsp->{stepp};
4818 0         0 $self->_dps_dot ($delt); # Calc. dot terms and integrate.
4819             }
4820              
4821 0         0 while (abs ($t - $dpsp->{atime}) >= $dpsp->{stepp}) {
4822 0         0 $self->_dps_dot ($delt); # Calc. dot terms and integrate.
4823             }
4824 0         0 my $ft = $t - $dpsp->{atime};
4825 0         0 my ($xldot, $xndot, $xnddt) = $self->_dps_dot (); # Calc. dot terms.
4826 0         0 $$xn = $dpsp->{xni} + $xndot * $ft + $xnddt * $ft * $ft * 0.5;
4827 0         0 my $xl = $dpsp->{xli} + $xldot * $ft + $xndot * $ft * $ft * 0.5;
4828 0         0 my $temp = - $$xnodes + $dpsp->{thgr} + $t * DS_THDT;
4829 0 0       0 $$xll = $dpsp->{isynfl} ? $xl - $$omgasm + $temp : $xl + $temp + $temp;
4830             };
4831              
4832 14 50       51 $self->{debug} and print <
4833             Debug _dpsec -
4834             xll : $orig[0] -> $$xll
4835             omgasm : $orig[1] -> $$omgasm
4836             xnodes : $orig[2] -> $$xnodes
4837             em : $orig[3] -> $$em
4838             xinc : $orig[4] -> $$xinc
4839             xn : $orig[5] -> $$xn
4840             t : $t
4841             eod
4842 14         48 return;
4843             }
4844              
4845             # _dps_dot
4846              
4847             # Calculate the dot terms for the secular effects.
4848              
4849             # In the original FORTRAN, this was a chunk of code followed
4850             # by an assigned GOTO. But here it has transmogrified into a
4851             # method. If an argument is passed, it is taken to be the delta
4852             # for an iteration of the integration step, which is done. It
4853             # returns xldot, xndot, and xnddt
4854              
4855             sub _dps_dot {
4856 0     0   0 my ($self, $delt) = @_;
4857 0         0 my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4858              
4859             #C
4860             #C DOT TERMS CALCULATED
4861             #C
4862              
4863             # We get here from either:
4864             # - an explicit GOTO below line 130;
4865             # - an explicit GOTO below line 160, which is reached from below 110 or 125.
4866             # This is the only reference to line 152.
4867             # XNDOT, XNDDT, and XLDOT come out of this.
4868             #150:
4869 0         0 my ($xndot, $xnddt);
4870 0 0       0 if ($dpsp->{isynfl}) {
4871             $xndot = $dpsp->{del1} * sin ($dpsp->{xli} - $dpsp->{fasx2}) +
4872             $dpsp->{del2} * sin (2 * ($dpsp->{xli} - $dpsp->{fasx4})) +
4873 0         0 $dpsp->{del3} * sin (3 * ($dpsp->{xli} - $dpsp->{fasx6}));
4874             $xnddt = $dpsp->{del1} * cos ($dpsp->{xli} - $dpsp->{fasx2}) +
4875             2 * $dpsp->{del2} * cos (2 * ($dpsp->{xli} - $dpsp->{fasx4})) +
4876 0         0 3 * $dpsp->{del3} * cos (3 * ($dpsp->{xli} - $dpsp->{fasx6}));
4877             } else {
4878             my $xomi = $self->{argumentofperigee} +
4879 0         0 $dpsp->{omgdt} * $dpsp->{atime};
4880 0         0 my $x2omi = $xomi + $xomi;
4881 0         0 my $x2li = $dpsp->{xli} + $dpsp->{xli};
4882             $xndot = $dpsp->{d2201} * sin ($x2omi + $dpsp->{xli} - DS_G22) +
4883             $dpsp->{d2211} * sin ($dpsp->{xli} - DS_G22) +
4884             $dpsp->{d3210} * sin ($xomi + $dpsp->{xli} - DS_G32) +
4885             $dpsp->{d3222} * sin ( - $xomi + $dpsp->{xli} - DS_G32) +
4886             $dpsp->{d4410} * sin ($x2omi + $x2li - DS_G44) +
4887             $dpsp->{d4422} * sin ($x2li - DS_G44) +
4888             $dpsp->{d5220} * sin ($xomi + $dpsp->{xli} - DS_G52) +
4889             $dpsp->{d5232} * sin ( - $xomi + $dpsp->{xli} - DS_G52) +
4890             $dpsp->{d5421} * sin ($xomi + $x2li - DS_G54) +
4891 0         0 $dpsp->{d5433} * sin ( - $xomi + $x2li - DS_G54);
4892             $xnddt = $dpsp->{d2201} * cos ($x2omi + $dpsp->{xli} - DS_G22) +
4893             $dpsp->{d2211} * cos ($dpsp->{xli} - DS_G22) +
4894             $dpsp->{d3210} * cos ($xomi + $dpsp->{xli} - DS_G32) +
4895             $dpsp->{d3222} * cos ( - $xomi + $dpsp->{xli} - DS_G32) +
4896             $dpsp->{d5220} * cos ($xomi + $dpsp->{xli} - DS_G52) +
4897             $dpsp->{d5232} * cos ( - $xomi + $dpsp->{xli} - DS_G52) +
4898             2 * ($dpsp->{d4410} * cos ($x2omi + $x2li - DS_G44) +
4899             $dpsp->{d4422} * cos ($x2li - DS_G44) +
4900             $dpsp->{d5421} * cos ($xomi + $x2li - DS_G54) +
4901 0         0 $dpsp->{d5433} * cos ( - $xomi + $x2li - DS_G54));
4902             }
4903 0         0 my $xldot = $dpsp->{xni} + $dpsp->{xfact};
4904 0         0 $xnddt = $xnddt * $xldot;
4905              
4906             #C
4907             #C INTEGRATOR
4908             #C
4909              
4910 0 0       0 defined $delt and do {
4911 0         0 $dpsp->{xli} = $dpsp->{xli} + $xldot * $delt + $xndot * $dpsp->{step2};
4912 0         0 $dpsp->{xni} = $dpsp->{xni} + $xndot * $delt + $xnddt * $dpsp->{step2};
4913 0         0 $dpsp->{atime} = $dpsp->{atime} + $delt;
4914             };
4915              
4916 0         0 return ($xldot, $xndot, $xnddt);
4917             }
4918              
4919             # _dpper
4920              
4921             # Calculate solar/lunar periodics.
4922              
4923             # Note that T must also be passed.
4924              
4925             # Note also that EM, XINC, OMGASM, XNODES, and XLL must be passed
4926             # by reference, since they get modified. Sigh.
4927              
4928             sub _dpper {
4929 14     14   43 my ($self, @args) = @_;
4930 14         50 my $dpsp = $self->{&TLE_INIT}{TLE_deep};
4931 14         41 my ($em, $xinc, $omgasm, $xnodes, $xll, $t) = @args;
4932 14         21 my @orig;
4933             $self->{debug}
4934 0 0       0 and @orig = map {defined $_ ? $_ : 'undef'}
4935 14 0       46 map { SCALAR_REF eq ref $_ ? $$_ : $_} @args;
  0 50       0  
4936              
4937             #C
4938             #C ENTRANCES FOR LUNAR-SOLAR PERIODICS
4939             #C
4940             #C
4941             #ENTRY DPPER(EM,XINC,OMGASM,XNODES,XLL)
4942              
4943 14         36 my $sinis = sin ($$xinc);
4944 14         32 my $cosis = cos ($$xinc);
4945              
4946             # The following is an optimization that
4947             # skips a bunch of calculations if the
4948             # current time is within 30 (minutes) of
4949             # the previous.
4950             # This is the only reference to line 210
4951              
4952 14 100 100     128 unless (defined $dpsp->{savtsn} && abs ($dpsp->{savtsn} - $t) < 30) {
4953 12         30 $dpsp->{savtsn} = $t;
4954 12         37 my $zm = $dpsp->{zmos} + DS_ZNS * $t;
4955 12         32 my $zf = $zm + 2 * DS_ZES * sin ($zm);
4956 12         24 my $sinzf = sin ($zf);
4957 12         30 my $f2 = .5 * $sinzf * $sinzf - .25;
4958 12         66 my $f3 = - .5 * $sinzf * cos ($zf);
4959 12         34 my $ses = $dpsp->{se2} * $f2 + $dpsp->{se3} * $f3;
4960 12         35 my $sis = $dpsp->{si2} * $f2 + $dpsp->{si3} * $f3;
4961             my $sls = $dpsp->{sl2} * $f2 + $dpsp->{sl3} * $f3 +
4962 12         33 $dpsp->{sl4} * $sinzf;
4963             $dpsp->{sghs} = $dpsp->{sgh2} * $f2 + $dpsp->{sgh3} * $f3 +
4964 12         41 $dpsp->{sgh4} * $sinzf;
4965 12         35 $dpsp->{shs} = $dpsp->{sh2} * $f2 + $dpsp->{sh3} * $f3;
4966 12         118 $zm = $dpsp->{zmol} + DS_ZNL * $t;
4967 12         43 $zf = $zm + 2 * DS_ZEL * sin ($zm);
4968 12         23 $sinzf = sin ($zf);
4969 12         31 $f2 = .5 * $sinzf * $sinzf - .25;
4970 12         26 $f3 = - .5 * $sinzf * cos ($zf);
4971 12         33 my $sel = $dpsp->{ee2} * $f2 + $dpsp->{e3} * $f3;
4972 12         64 my $sil = $dpsp->{xi2} * $f2 + $dpsp->{xi3} * $f3;
4973 12         45 my $sll = $dpsp->{xl2} * $f2 + $dpsp->{xl3} * $f3 + $dpsp->{xl4} * $sinzf;
4974 12         47 $dpsp->{sghl} = $dpsp->{xgh2} * $f2 + $dpsp->{xgh3} * $f3 + $dpsp->{xgh4} * $sinzf;
4975 12         30 $dpsp->{shl} = $dpsp->{xh2} * $f2 + $dpsp->{xh3} * $f3;
4976 12         27 $dpsp->{pe} = $ses + $sel;
4977 12         26 $dpsp->{pinc} = $sis + $sil;
4978 12         34 $dpsp->{pl} = $sls + $sll;
4979             }
4980              
4981 14         29 my $pgh = $dpsp->{sghs} + $dpsp->{sghl};
4982 14         30 my $ph = $dpsp->{shs} + $dpsp->{shl};
4983 14         29 $$xinc = $$xinc + $dpsp->{pinc};
4984 14         30 $$em = $$em + $dpsp->{pe};
4985              
4986 14 50       49 if ($self->{inclination} >= .2) {
4987              
4988             #C
4989             #C APPLY PERIODICS DIRECTLY
4990             #C
4991             #218:
4992              
4993 14         48 my $ph = $ph / $dpsp->{siniq};
4994 14         51 my $pgh = $pgh - $dpsp->{cosiq} * $ph;
4995 14         30 $$omgasm = $$omgasm + $pgh;
4996 14         42 $$xnodes = $$xnodes + $ph;
4997 14         33 $$xll = $$xll + $dpsp->{pl};
4998             } else {
4999              
5000             #C
5001             #C APPLY PERIODICS WITH LYDDANE MODIFICATION
5002             #C
5003             #220:
5004 0         0 my $sinok = sin ($$xnodes);
5005 0         0 my $cosok = cos ($$xnodes);
5006 0         0 my $alfdp = $sinis * $sinok;
5007 0         0 my $betdp = $sinis * $cosok;
5008 0         0 my $dalf = $ph * $cosok + $dpsp->{pinc} * $cosis * $sinok;
5009 0         0 my $dbet = - $ph * $sinok + $dpsp->{pinc} * $cosis * $cosok;
5010 0         0 $alfdp = $alfdp + $dalf;
5011 0         0 $betdp = $betdp + $dbet;
5012 0         0 my $xls = $$xll + $$omgasm + $cosis * $$xnodes;
5013 0         0 my $dls = $dpsp->{pl} + $pgh - $dpsp->{pinc} * $$xnodes * $sinis;
5014 0         0 $xls = $xls + $dls;
5015 0         0 $$xnodes = _actan ($alfdp,$betdp);
5016 0         0 $$xll = $$xll + $dpsp->{pl};
5017 0         0 $$omgasm = $xls - $$xll - cos ($$xinc) * $$xnodes;
5018             }
5019              
5020 14 50       41 $self->{debug} and print <
5021             Debug _dpper -
5022             em : $orig[0] -> $$em
5023             xinc : $orig[1] -> $$xinc
5024             omgasm : $orig[2] -> $$omgasm
5025             xnodes : $orig[3] -> $$xnodes
5026             xll : $orig[4] -> $$xll
5027             t : $t
5028             eod
5029              
5030 14         45 return;
5031             }
5032              
5033             #######################################################################
5034              
5035             # All "Revisiting Spacetrack Report #3" code
5036              
5037             =item $tle = $tle->sgp4r($time)
5038              
5039             This method calculates the position of the body described by the TLE
5040             object at the given time, using the revised SGP4 model. The universal
5041             time of the object is set to $time, and the 'equinox_dynamical'
5042             attribute is set to the current value of the 'epoch_dynamical'
5043             attribute.
5044              
5045             The result is the original object reference. See the L
5046             heading above for how to retrieve the coordinates you just calculated.
5047              
5048             The algorithm for this model comes from "Revisiting Spacetrack Report
5049             Number 3" (see L). That report
5050             considers the algorithm to be a correction and extension of SGP4
5051             (merging it with SDP4), and simply calls the algorithm SGP4. I have
5052             appended the "r" (for 'revised' or 'revisited', take your pick) because
5053             I have preserved the original algorithm as well.
5054              
5055             B that this algorithm depends on the setting of the
5056             'gravconst_r' attribute. The default setting of that attribute in this
5057             module is 84, but the test data that comes with "Revisiting Spacetrack
5058             Report #3" uses 72.
5059              
5060             This algorithm is also (currently) the only one that returns a useful
5061             value in the model_error attribute, as follows:
5062              
5063             0 = success
5064             1 = mean eccentricity < 0 or > 1, or a < .95
5065             2 = mean motion < 0.0
5066             3 = instantaneous eccentricity < 0 or > 1
5067             4 = semi-latus rectum < 0
5068             5 = epoch elements are sub-orbital
5069             6 = satellite has decayed
5070              
5071             These errors are dualvars if your Scalar::Util supports these. That is,
5072             they are interpreted as numbers in numeric context and the
5073             corresponding string in string context. The string is generally the
5074             explanation, except for 0, which is '' in string context. If your
5075             Scalar::Util does not support dualvar, the numeric value is returned.
5076              
5077             Currently, errors 1 through 4 cause an explicit exception to be thrown
5078             after setting the model_error attribute. Exceptions will also be thrown
5079             if the TLE eccentricity is negative or greater than one, or the TLE mean
5080             motion is negative.
5081              
5082             Errors 5 and 6 look more like informational errors to me. Error 5
5083             indicates that the perigee is less than the radius of the earth. This
5084             could very well happen if the TLE represents a coasting arc of a
5085             spacecraft being launched or preparing for re-entry. Error 6 means the
5086             actual computed position was underground. Maybe this should be an
5087             exception, though I have never needed this kind of exception previously.
5088              
5089             B that this first release of the 'Revisiting Spacetrack Report #3'
5090             functionality should be considered alpha code. That is to say, I may
5091             need to change the way it behaves, especially in the matter of what is
5092             an exception and what is not.
5093              
5094             =cut
5095              
5096             # What follows (down to, but not including, the 'end sgp4unit.for'
5097             # comment) is the Fortran code from sgp4unit.for, translated into
5098             # Perl by the custom for2pl script, with conversion specification
5099             # sgp4unit.spec. No hand-edits have been applied. The preferred
5100             # way to modify this code is to enhance for2pl (which is _not_
5101             # included in the CPAN kit) or to modify sgp4unit.for (ditto),
5102             # since that way further modifications can be easily incorporated
5103             # into this module.
5104             #
5105             # Comments in the included file are those from the original
5106             # Fortran unless preceded by '>>>>trw'. The latter are comments
5107             # introduced by the conversion program to remove unwanted Fortran.
5108             #
5109             # IMPLEMENTATION NOTES:
5110             #
5111             # The original Space Track Report Number 3 code used a custom
5112             # function called FMOD2P to reduce an angle to the range 0 <=
5113             # angle < 2*PI. This is translated to Astro::Coord::ECI::Utils
5114             # function mod2pi. But the Revisiting Spacetrack Report #3 code
5115             # used the Fortran intrinsic function DMOD, which produces
5116             # negative results for a negative divisor. So instead of using
5117             # mod2pi, sgp4r() and related code use the POSIX fmod function,
5118             # which has the same behaviour.
5119             #
5120             # Similarly, the original code used a custom function ACTAN to
5121             # produce an arc in the range 0 <= arc < 2*PI from its two
5122             # arguments and the single-argument ATAN intrinsic. The
5123             # translation into Perl ended up with an _actan function at that
5124             # point. But the revised code simply uses atan2.
5125             #
5126             # The included file processed from sgp4unit.for begins here.
5127              
5128 16     16   188 use constant SGP4R_ERROR_0 => dualvar (0, ''); # guaranteed false
  16         36  
  16         1724  
5129 16         1314 use constant SGP4R_ERROR_MEAN_ECCEN =>
5130 16     16   108 'Sgp4r 1: Mean eccentricity < 0 or > 1, or a < .95';
  16         38  
5131 16     16   119 use constant SGP4R_ERROR_1 => dualvar (1, SGP4R_ERROR_MEAN_ECCEN);
  16         50  
  16         1033  
5132 16         1106 use constant SGP4R_ERROR_MEAN_MOTION =>
5133 16     16   107 'Sgp4r 2: Mean motion < 0.0';
  16         38  
5134 16     16   154 use constant SGP4R_ERROR_2 => dualvar (2, SGP4R_ERROR_MEAN_MOTION);
  16         56  
  16         1100  
5135 16         1044 use constant SGP4R_ERROR_INST_ECCEN =>
5136 16     16   140 'Sgp4r 3: Instantaneous eccentricity < 0 or > 1';
  16         57  
5137 16     16   137 use constant SGP4R_ERROR_3 => dualvar (3, SGP4R_ERROR_INST_ECCEN);
  16         33  
  16         946  
5138 16         976 use constant SGP4R_ERROR_LATUSRECTUM =>
5139 16     16   128 'Sgp4r 4: Semi-latus rectum < 0';
  16         37  
5140 16     16   98 use constant SGP4R_ERROR_4 => dualvar (4, SGP4R_ERROR_LATUSRECTUM);
  16         31  
  16         1018  
5141 16         1671 use constant SGP4R_ERROR_5 => dualvar (5,
5142 16     16   86 'Sgp4r 5: Epoch elements are sub-orbital');
  16         35  
5143 16         305977 use constant SGP4R_ERROR_6 => dualvar (6,
5144 16     16   92 'Sgp4r 6: Satellite has decayed');
  16         32  
5145              
5146             #* -------------------------------------------------------------------
5147             #*
5148             #* sgp4unit.for
5149             #*
5150             #* this file contains the sgp4 procedures for analytical propagation
5151             #* of a satellite. the code was originally released in the 1980 and 1986
5152             #* spacetrack papers. a detailed discussion of the theory and history
5153             #* may be found in the 2006 aiaa paper by vallado, crawford, hujsak,
5154             #* and kelso.
5155             #*
5156             #* companion code for
5157             #* fundamentals of astrodynamics and applications
5158             #* 2007
5159             #* by david vallado
5160             #*
5161             #* (w) 719-573-2600, email dvallado@agi.com
5162             #*
5163             #* current :
5164             #* 2 apr 07 david vallado
5165             #* misc fixes for constants
5166             #* changes :
5167             #* 14 aug 06 david vallado
5168             #* chg lyddane choice back to strn3, constants,
5169             #* separate debug and writes, misc doc
5170             #* 26 jul 05 david vallado
5171             #* fixes for paper
5172             #* note that each fix is preceded by a
5173             #* comment with "sgp4fix" and an explanation of
5174             #* what was changed
5175             #* 10 aug 04 david vallado
5176             #* 2nd printing baseline working
5177             #* 14 may 01 david vallado
5178             #* 2nd edition baseline
5179             #* 80 norad
5180             #* original baseline
5181             #*
5182             #* *****************************************************************
5183             #* Files :
5184             #* Unit 14 - sgp4test.dbg debug output file
5185              
5186             #* -----------------------------------------------------------------------------
5187             #*
5188             #* SUBROUTINE DPPER
5189             #*
5190             #* This Subroutine provides deep space long period periodic contributions
5191             #* to the mean elements. by design, these periodics are zero at epoch.
5192             #* this used to be dscom which included initialization, but it's really a
5193             #* recurring function.
5194             #*
5195             #* author : david vallado 719-573-2600 28 jun 2005
5196             #*
5197             #* inputs :
5198             #* e3 -
5199             #* ee2 -
5200             #* peo -
5201             #* pgho -
5202             #* pho -
5203             #* pinco -
5204             #* plo -
5205             #* se2 , se3 , Sgh2, Sgh3, Sgh4, Sh2, Sh3, Si2, Si3, Sl2, Sl3, Sl4 -
5206             #* t -
5207             #* xh2, xh3, xi2, xi3, xl2, xl3, xl4 -
5208             #* zmol -
5209             #* zmos -
5210             #* ep - eccentricity 0.0 - 1.0
5211             #* inclo - inclination - needed for lyddane modification
5212             #* nodep - right ascension of ascending node
5213             #* argpp - argument of perigee
5214             #* mp - mean anomaly
5215             #*
5216             #* outputs :
5217             #* ep - eccentricity 0.0 - 1.0
5218             #* inclp - inclination
5219             #* nodep - right ascension of ascending node
5220             #* argpp - argument of perigee
5221             #* mp - mean anomaly
5222             #*
5223             #* locals :
5224             #* alfdp -
5225             #* betdp -
5226             #* cosip , sinip , cosop , sinop ,
5227             #* dalf -
5228             #* dbet -
5229             #* dls -
5230             #* f2, f3 -
5231             #* pe -
5232             #* pgh -
5233             #* ph -
5234             #* pinc -
5235             #* pl -
5236             #* sel , ses , sghl , sghs , shl , shs , sil , sinzf , sis ,
5237             #* sll , sls
5238             #* xls -
5239             #* xnoh -
5240             #* zf -
5241             #* zm -
5242             #*
5243             #* coupling :
5244             #* none.
5245             #*
5246             #* references :
5247             #* hoots, roehrich, norad spacetrack report #3 1980
5248             #* hoots, norad spacetrack report #6 1986
5249             #* hoots, schumacher and glover 2004
5250             #* vallado, crawford, hujsak, kelso 2006
5251             #*------------------------------------------------------------------------------
5252              
5253             sub _r_dpper {
5254 418     418   1246 my ($self, $t, $eccp, $inclp, $nodep, $argpp, $mp) = @_;
5255             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
5256 418 50       1979 or confess "Programming error - Sgp4r not initialized";
5257              
5258             #* -------------------------- Local Variables --------------------------
5259 418         1869 my ($alfdp, $betdp, $cosip, $cosop, $dalf, $dbet, $dls, $f2, $f3,
5260             $pe, $pgh, $ph, $pinc, $pl, $sel, $ses, $sghl, $sghs, $shl,
5261             $shs, $sil, $sinip, $sinop, $sinzf, $sis, $sll, $sls, $xls,
5262             $xnoh, $zf, $zm);
5263 418         0 my ($zel, $zes, $znl, $zns);
5264             #>>>>trw INCLUDE 'ASTMATH.CMN'
5265              
5266             #* ----------------------------- Constants -----------------------------
5267 418         678 $zes= 0.01675;
5268 418         780 $zel= 0.0549;
5269 418         575 $zns= 1.19459e-05;
5270              
5271 418         644 $znl= 0.00015835218;
5272             #* ------------------- CALCULATE TIME VARYING PERIODICS ----------------
5273              
5274 418         986 $zm= $parm->{zmos}+ $zns*$t;
5275 418 100       1342 if ($parm->{init}) {
5276             $zm= $parm->{zmos}
5277 23         60 }
5278 418         1266 $zf= $zm+ 2*$zes*sin($zm);
5279 418         695 $sinzf= sin($zf);
5280 418         866 $f2= 0.5*$sinzf*$sinzf- 0.25;
5281 418         814 $f3= -0.5*$sinzf*cos($zf);
5282 418         1088 $ses= $parm->{se2}*$f2+ $parm->{se3}*$f3;
5283 418         1056 $sis= $parm->{si2}*$f2+ $parm->{si3}*$f3;
5284 418         1258 $sls= $parm->{sl2}*$f2+ $parm->{sl3}*$f3+ $parm->{sl4}*$sinzf;
5285 418         1136 $sghs= $parm->{sgh2}*$f2+ $parm->{sgh3}*$f3+ $parm->{sgh4}*$sinzf;
5286 418         1003 $shs= $parm->{sh2}*$f2+ $parm->{sh3}*$f3;
5287              
5288 418         861 $zm= $parm->{zmol}+ $znl*$t;
5289 418 100       1080 if ($parm->{init}) {
5290             $zm= $parm->{zmol}
5291 23         60 }
5292 418         753 $zf= $zm+ 2*$zel*sin($zm);
5293 418         649 $sinzf= sin($zf);
5294 418         792 $f2= 0.5*$sinzf*$sinzf- 0.25;
5295 418         786 $f3= -0.5*$sinzf*cos($zf);
5296 418         1028 $sel= $parm->{ee2}*$f2+ $parm->{e3}*$f3;
5297 418         945 $sil= $parm->{xi2}*$f2+ $parm->{xi3}*$f3;
5298 418         1257 $sll= $parm->{xl2}*$f2+ $parm->{xl3}*$f3+ $parm->{xl4}*$sinzf;
5299 418         1020 $sghl= $parm->{xgh2}*$f2+ $parm->{xgh3}*$f3+ $parm->{xgh4}*$sinzf;
5300 418         837 $shl= $parm->{xh2}*$f2+ $parm->{xh3}*$f3;
5301 418         582 $pe= $ses+ $sel;
5302 418         551 $pinc= $sis+ $sil;
5303 418         553 $pl= $sls+ $sll;
5304 418         705 $pgh= $sghs+ $sghl;
5305              
5306 418         637 $ph= $shs+ $shl;
5307 418 100       1295 if ( ! $parm->{init}) {
5308 395         734 $pe= $pe- $parm->{peo};
5309 395         780 $pinc= $pinc- $parm->{pinco};
5310 395         683 $pl= $pl- $parm->{plo};
5311 395         628 $pgh= $pgh- $parm->{pgho};
5312 395         630 $ph= $ph- $parm->{pho};
5313 395         785 $$inclp= $$inclp+ $pinc;
5314 395         758 $$eccp= $$eccp+ $pe;
5315 395         716 $sinip= sin($$inclp);
5316              
5317 395         634 $cosip= cos($$inclp);
5318             #* ------------------------- APPLY PERIODICS DIRECTLY ------------------
5319             #c sgp4fix for lyddane choice
5320             #c strn3 used original inclination - this is technically feasible
5321             #c gsfc used perturbed inclination - also technically feasible
5322             #c probably best to readjust the 0.2 limit value and limit discontinuity
5323             #c 0.2 rad = 11.45916 deg
5324             #c use next line for original strn3 approach and original inclination
5325             #c IF (inclo.ge.0.2D0) THEN
5326             #c use next line for gsfc version and perturbed inclination
5327              
5328 395 100       1264 if ($$inclp >= 0.2) {
5329 232         506 $ph= $ph/$sinip;
5330 232         566 $pgh= $pgh- $cosip*$ph;
5331 232         483 $$argpp= $$argpp+ $pgh;
5332 232         477 $$nodep= $$nodep+ $ph;
5333 232         504 $$mp= $$mp+ $pl;
5334              
5335             } else {
5336             #* ----------------- APPLY PERIODICS WITH LYDDANE MODIFICATION ---------
5337 163         277 $sinop= sin($$nodep);
5338 163         280 $cosop= cos($$nodep);
5339 163         256 $alfdp= $sinip*$sinop;
5340 163         240 $betdp= $sinip*$cosop;
5341 163         340 $dalf= $ph*$cosop+ $pinc*$cosip*$sinop;
5342 163         401 $dbet= -$ph*$sinop+ $pinc*$cosip*$cosop;
5343 163         307 $alfdp= $alfdp+ $dalf;
5344 163         749 $betdp= $betdp+ $dbet;
5345 163         606 $$nodep= fmod($$nodep, &SGP_TWOPI);
5346 163         388 $xls= $$mp+ $$argpp+ $cosip*$$nodep;
5347 163         320 $dls= $pl+ $pgh- $pinc*$$nodep*$sinip;
5348 163         232 $xls= $xls+ $dls;
5349 163         251 $xnoh= $$nodep;
5350 163         489 $$nodep= atan2($alfdp, $betdp);
5351 163 100       584 if (abs($xnoh-$$nodep) > &SGP_PI) {
5352 57 50       125 if ($$nodep < $xnoh) {
5353 57         172 $$nodep= $$nodep+&SGP_TWOPI;
5354             } else {
5355 0         0 $$nodep= $$nodep-&SGP_TWOPI;
5356             }
5357             }
5358 163         322 $$mp= $$mp+ $pl;
5359 163         374 $$argpp= $xls- $$mp- $cosip*$$nodep;
5360             }
5361              
5362             }
5363             #c INCLUDE 'debug1.for'
5364              
5365 418         1091 return;
5366             }
5367              
5368             #* -----------------------------------------------------------------------------
5369             #*
5370             #* SUBROUTINE DSCOM
5371             #*
5372             #* This Subroutine provides deep space common items used by both the secular
5373             #* and periodics subroutines. input is provided as shown. this routine
5374             #* used to be called dpper, but the functions inside weren't well organized.
5375             #*
5376             #* author : david vallado 719-573-2600 28 jun 2005
5377             #*
5378             #* inputs :
5379             #* epoch -
5380             #* ep - eccentricity
5381             #* argpp - argument of perigee
5382             #* tc -
5383             #* inclp - inclination
5384             #* nodep - right ascension of ascending node
5385             #* np - mean motion
5386             #*
5387             #* outputs :
5388             #* sinim , cosim , sinomm , cosomm , snodm , cnodm
5389             #* day -
5390             #* e3 -
5391             #* ee2 -
5392             #* em - eccentricity
5393             #* emsq - eccentricity squared
5394             #* gam -
5395             #* peo -
5396             #* pgho -
5397             #* pho -
5398             #* pinco -
5399             #* plo -
5400             #* rtemsq -
5401             #* se2, se3 -
5402             #* sgh2, sgh3, sgh4 -
5403             #* sh2, sh3, si2, si3, sl2, sl3, sl4 -
5404             #* s1, s2, s3, s4, s5, s6, s7 -
5405             #* ss1, ss2, ss3, ss4, ss5, ss6, ss7, sz1, sz2, sz3 -
5406             #* sz11, sz12, sz13, sz21, sz22, sz23, sz31, sz32, sz33 -
5407             #* xgh2, xgh3, xgh4, xh2, xh3, xi2, xi3, xl2, xl3, xl4 -
5408             #* nm - mean motion
5409             #* z1, z2, z3, z11, z12, z13, z21, z22, z23, z31, z32, z33 -
5410             #* zmol -
5411             #* zmos -
5412             #*
5413             #* locals :
5414             #* a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 -
5415             #* betasq -
5416             #* cc -
5417             #* ctem, stem -
5418             #* x1, x2, x3, x4, x5, x6, x7, x8 -
5419             #* xnodce -
5420             #* xnoi -
5421             #* zcosg , zsing , zcosgl , zsingl , zcosh , zsinh , zcoshl , zsinhl ,
5422             #* zcosi , zsini , zcosil , zsinil ,
5423             #* zx -
5424             #* zy -
5425             #*
5426             #* coupling :
5427             #* none.
5428             #*
5429             #* references :
5430             #* hoots, roehrich, norad spacetrack report #3 1980
5431             #* hoots, norad spacetrack report #6 1986
5432             #* hoots, schumacher and glover 2004
5433             #* vallado, crawford, hujsak, kelso 2006
5434             #*------------------------------------------------------------------------------
5435              
5436             sub _r_dscom {
5437 23     23   75 my ($self, $tc) = @_;
5438             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
5439 23 50       141 or confess "Programming error - Sgp4r not initialized";
5440             my $init = $parm->{init}
5441 23 50       83 or confess "Programming error - Sgp4r initialization not in progress";
5442              
5443             #* -------------------------- Local Variables --------------------------
5444 23         159 my ($c1ss, $c1l, $zcosis, $zsinis, $zsings, $zcosgs, $zes, $zel);
5445              
5446 23         0 my ($a1, $a2, $a3, $a4, $a5, $a6, $a7, $a8, $a9, $a10, $betasq, $cc,
5447             $ctem, $stem, $x1, $x2, $x3, $x4, $x5, $x6, $x7, $x8, $xnodce,
5448             $xnoi, $zcosg, $zcosgl, $zcosh, $zcoshl, $zcosi, $zcosil,
5449             $zsing, $zsingl, $zsinh, $zsinhl, $zsini, $zsinil, $zx, $zy);
5450             #>>>>trw INCLUDE 'ASTMATH.CMN'
5451              
5452             #* ------------------------------ Constants ----------------------------
5453 23         40 $zes= 0.01675;
5454 23         53 $zel= 0.0549;
5455 23         72 $c1ss= 2.9864797e-06;
5456 23         67 $c1l= 4.7968065e-07;
5457 23         60 $zsinis= 0.39785416;
5458 23         40 $zcosis= 0.91744867;
5459 23         40 $zcosgs= 0.1945905;
5460              
5461 23         40 $zsings= -0.98088458;
5462             #* ----------------- DEEP SPACE PERIODICS INITIALIZATION ---------------
5463 23         79 $init->{xn}= $parm->{meanmotion};
5464 23         59 $init->{eccm}= $parm->{eccentricity};
5465 23         72 $init->{snodm}= sin($parm->{ascendingnode});
5466 23         60 $init->{cnodm}= cos($parm->{ascendingnode});
5467 23         82 $init->{sinomm}= sin($parm->{argumentofperigee});
5468 23         59 $init->{cosomm}= cos($parm->{argumentofperigee});
5469 23         86 $init->{sinim}= sin($parm->{inclination});
5470 23         57 $init->{cosim}= cos($parm->{inclination});
5471 23         134 $init->{emsq}= $init->{eccm}*$init->{eccm};
5472 23         64 $betasq= 1-$init->{emsq};
5473              
5474 23         64 $init->{rtemsq}= sqrt($betasq);
5475             #* --------------------- INITIALIZE LUNAR SOLAR TERMS ------------------
5476 23         97 $parm->{peo}= 0;
5477 23         82 $parm->{pinco}= 0;
5478 23         61 $parm->{plo}= 0;
5479 23         59 $parm->{pgho}= 0;
5480 23         88 $parm->{pho}= 0;
5481 23         101 $init->{day}= $self->{ds50}+ 18261.5 + $tc/1440;
5482 23         112 $xnodce= fmod(4.523602 - 0.00092422029*$init->{day}, &SGP_TWOPI);
5483 23         50 $stem= sin($xnodce);
5484 23         45 $ctem= cos($xnodce);
5485 23         70 $zcosil= 0.91375164 - 0.03568096*$ctem;
5486 23         56 $zsinil= sqrt(1 - $zcosil*$zcosil);
5487 23         57 $zsinhl= 0.089683511*$stem/ $zsinil;
5488 23         49 $zcoshl= sqrt(1 - $zsinhl*$zsinhl);
5489 23         68 $init->{gam}= 5.8351514 + 0.001944368*$init->{day};
5490 23         64 $zx= 0.39785416*$stem/$zsinil;
5491 23         95 $zy= $zcoshl*$ctem+ 0.91744867*$zsinhl*$stem;
5492 23         94 $zx= atan2($zx, $zy);
5493 23         53 $zx= $init->{gam}+ $zx- $xnodce;
5494 23         47 $zcosgl= cos($zx);
5495              
5496 23         59 $zsingl= sin($zx);
5497             #* ---------------------------- DO SOLAR TERMS -------------------------
5498 23         48 $zcosg= $zcosgs;
5499 23         49 $zsing= $zsings;
5500 23         46 $zcosi= $zcosis;
5501 23         66 $zsini= $zsinis;
5502 23         56 $zcosh= $init->{cnodm};
5503 23         50 $zsinh= $init->{snodm};
5504 23         63 $cc= $c1ss;
5505              
5506 23         70 $xnoi= 1 / $init->{xn};
5507 23         95 foreach my $lsflg (1 .. 2) {
5508 46         106 $a1= $zcosg*$zcosh+ $zsing*$zcosi*$zsinh;
5509 46         114 $a3= -$zsing*$zcosh+ $zcosg*$zcosi*$zsinh;
5510 46         96 $a7= -$zcosg*$zsinh+ $zsing*$zcosi*$zcosh;
5511 46         77 $a8= $zsing*$zsini;
5512 46         75 $a9= $zsing*$zsinh+ $zcosg*$zcosi*$zcosh;
5513 46         65 $a10= $zcosg*$zsini;
5514 46         139 $a2= $init->{cosim}*$a7+ $init->{sinim}*$a8;
5515 46         95 $a4= $init->{cosim}*$a9+ $init->{sinim}*$a10;
5516 46         118 $a5= -$init->{sinim}*$a7+ $init->{cosim}*$a8;
5517              
5518 46         88 $a6= -$init->{sinim}*$a9+ $init->{cosim}*$a10;
5519 46         87 $x1= $a1*$init->{cosomm}+ $a2*$init->{sinomm};
5520 46         107 $x2= $a3*$init->{cosomm}+ $a4*$init->{sinomm};
5521 46         228 $x3= -$a1*$init->{sinomm}+ $a2*$init->{cosomm};
5522 46         103 $x4= -$a3*$init->{sinomm}+ $a4*$init->{cosomm};
5523 46         74 $x5= $a5*$init->{sinomm};
5524 46         66 $x6= $a6*$init->{sinomm};
5525 46         76 $x7= $a5*$init->{cosomm};
5526              
5527 46         69 $x8= $a6*$init->{cosomm};
5528 46         183 $init->{z31}= 12*$x1*$x1- 3*$x3*$x3;
5529 46         119 $init->{z32}= 24*$x1*$x2- 6*$x3*$x4;
5530 46         119 $init->{z33}= 12*$x2*$x2- 3*$x4*$x4;
5531             $init->{z1}= 3* ($a1*$a1+ $a2*$a2) +
5532 46         127 $init->{z31}*$init->{emsq};
5533             $init->{z2}= 6* ($a1*$a3+ $a2*$a4) +
5534 46         125 $init->{z32}*$init->{emsq};
5535             $init->{z3}= 3* ($a3*$a3+ $a4*$a4) +
5536 46         172 $init->{z33}*$init->{emsq};
5537             $init->{z11}= -6*$a1*$a5+ $init->{emsq}*
5538 46         155 (-24*$x1*$x7-6*$x3*$x5);
5539             $init->{z12}= -6* ($a1*$a6+ $a3*$a5) + $init->{emsq}* (
5540 46         155 -24*($x2*$x7+$x1*$x8) - 6*($x3*$x6+$x4*$x5) );
5541 46         144 $init->{z13}= -6*$a3*$a6+ $init->{emsq}*(-24*$x2*$x8-
5542             6*$x4*$x6);
5543 46         122 $init->{z21}= 6*$a2*$a5+ $init->{emsq}*(24*$x1*$x5-6*$x3*$x7);
5544             $init->{z22}= 6* ($a4*$a5+ $a2*$a6) + $init->{emsq}* (
5545 46         167 24*($x2*$x5+$x1*$x6) - 6*($x4*$x7+$x3*$x8) );
5546 46         161 $init->{z23}= 6*$a4*$a6+ $init->{emsq}*(24*$x2*$x6- 6*$x4*$x8);
5547 46         108 $init->{z1}= $init->{z1}+ $init->{z1}+ $betasq*$init->{z31};
5548 46         144 $init->{z2}= $init->{z2}+ $init->{z2}+ $betasq*$init->{z32};
5549 46         139 $init->{z3}= $init->{z3}+ $init->{z3}+ $betasq*$init->{z33};
5550 46         94 $init->{s3}= $cc*$xnoi;
5551 46         129 $init->{s2}= -0.5*$init->{s3}/ $init->{rtemsq};
5552 46         1726 $init->{s4}= $init->{s3}*$init->{rtemsq};
5553 46         133 $init->{s1}= -15*$init->{eccm}*$init->{s4};
5554 46         97 $init->{s5}= $x1*$x3+ $x2*$x4;
5555 46         103 $init->{s6}= $x2*$x3+ $x1*$x4;
5556              
5557 46         190 $init->{s7}= $x2*$x4- $x1*$x3;
5558             #* ------------------------------ DO LUNAR TERMS -----------------------
5559 46 100       148 if ($lsflg == 1) {
5560 23         96 $init->{ss1}= $init->{s1};
5561 23         67 $init->{ss2}= $init->{s2};
5562 23         49 $init->{ss3}= $init->{s3};
5563 23         61 $init->{ss4}= $init->{s4};
5564 23         76 $init->{ss5}= $init->{s5};
5565 23         51 $init->{ss6}= $init->{s6};
5566 23         59 $init->{ss7}= $init->{s7};
5567 23         50 $init->{sz1}= $init->{z1};
5568 23         55 $init->{sz2}= $init->{z2};
5569 23         62 $init->{sz3}= $init->{z3};
5570 23         65 $init->{sz11}= $init->{z11};
5571 23         60 $init->{sz12}= $init->{z12};
5572 23         68 $init->{sz13}= $init->{z13};
5573 23         53 $init->{sz21}= $init->{z21};
5574 23         52 $init->{sz22}= $init->{z22};
5575 23         53 $init->{sz23}= $init->{z23};
5576 23         81 $init->{sz31}= $init->{z31};
5577 23         56 $init->{sz32}= $init->{z32};
5578 23         64 $init->{sz33}= $init->{z33};
5579 23         42 $zcosg= $zcosgl;
5580 23         56 $zsing= $zsingl;
5581 23         54 $zcosi= $zcosil;
5582 23         50 $zsini= $zsinil;
5583 23         73 $zcosh= $zcoshl*$init->{cnodm}+$zsinhl*$init->{snodm};
5584 23         58 $zsinh= $init->{snodm}*$zcoshl-$init->{cnodm}*$zsinhl;
5585 23         58 $cc= $c1l;
5586             }
5587              
5588             }
5589             $parm->{zmol}= fmod(4.7199672 + 0.2299715*$init->{day}-$init->{gam},
5590 23         165 &SGP_TWOPI);
5591              
5592             $parm->{zmos}= fmod(6.2565837 + 0.017201977*$init->{day},
5593 23         118 &SGP_TWOPI);
5594             #* ---------------------------- DO SOLAR TERMS -------------------------
5595 23         235 $parm->{se2}= 2*$init->{ss1}*$init->{ss6};
5596 23         90 $parm->{se3}= 2*$init->{ss1}*$init->{ss7};
5597 23         99 $parm->{si2}= 2*$init->{ss2}*$init->{sz12};
5598 23         81 $parm->{si3}= 2*$init->{ss2}*($init->{sz13}-$init->{sz11});
5599 23         109 $parm->{sl2}= -2*$init->{ss3}*$init->{sz2};
5600 23         83 $parm->{sl3}= -2*$init->{ss3}*($init->{sz3}-$init->{sz1});
5601 23         79 $parm->{sl4}= -2*$init->{ss3}*(-21-9*$init->{emsq})*$zes;
5602 23         79 $parm->{sgh2}= 2*$init->{ss4}*$init->{sz32};
5603 23         77 $parm->{sgh3}= 2*$init->{ss4}*($init->{sz33}-$init->{sz31});
5604 23         66 $parm->{sgh4}= -18*$init->{ss4}*$zes;
5605 23         90 $parm->{sh2}= -2*$init->{ss2}*$init->{sz22};
5606              
5607 23         75 $parm->{sh3}= -2*$init->{ss2}*($init->{sz23}-$init->{sz21});
5608             #* ---------------------------- DO LUNAR TERMS -------------------------
5609 23         71 $parm->{ee2}= 2*$init->{s1}*$init->{s6};
5610 23         64 $parm->{e3}= 2*$init->{s1}*$init->{s7};
5611 23         62 $parm->{xi2}= 2*$init->{s2}*$init->{z12};
5612 23         73 $parm->{xi3}= 2*$init->{s2}*($init->{z13}-$init->{z11});
5613 23         4045 $parm->{xl2}= -2*$init->{s3}*$init->{z2};
5614 23         72 $parm->{xl3}= -2*$init->{s3}*($init->{z3}-$init->{z1});
5615 23         84 $parm->{xl4}= -2*$init->{s3}*(-21-9*$init->{emsq})*$zel;
5616 23         86 $parm->{xgh2}= 2*$init->{s4}*$init->{z32};
5617 23         65 $parm->{xgh3}= 2*$init->{s4}*($init->{z33}-$init->{z31});
5618 23         86 $parm->{xgh4}= -18*$init->{s4}*$zel;
5619 23         99 $parm->{xh2}= -2*$init->{s2}*$init->{z22};
5620              
5621 23         80 $parm->{xh3}= -2*$init->{s2}*($init->{z23}-$init->{z21});
5622             #c INCLUDE 'debug2.for'
5623              
5624 23         71 return;
5625             }
5626              
5627             #* -----------------------------------------------------------------------------
5628             #*
5629             #* SUBROUTINE DSINIT
5630             #*
5631             #* This Subroutine provides Deep Space contributions to Mean Motion Dot due
5632             #* to geopotential resonance with half day and one day orbits.
5633             #*
5634             #* Inputs :
5635             #* Cosim, Sinim-
5636             #* Emsq - Eccentricity squared
5637             #* Argpo - Argument of Perigee
5638             #* S1, S2, S3, S4, S5 -
5639             #* Ss1, Ss2, Ss3, Ss4, Ss5 -
5640             #* Sz1, Sz3, Sz11, Sz13, Sz21, Sz23, Sz31, Sz33 -
5641             #* T - Time
5642             #* Tc -
5643             #* GSTo - Greenwich sidereal time rad
5644             #* Mo - Mean Anomaly
5645             #* MDot - Mean Anomaly dot (rate)
5646             #* No - Mean Motion
5647             #* nodeo - right ascension of ascending node
5648             #* nodeDot - right ascension of ascending node dot (rate)
5649             #* XPIDOT -
5650             #* Z1, Z3, Z11, Z13, Z21, Z23, Z31, Z33 -
5651             #* Eccm - Eccentricity
5652             #* Argpm - Argument of perigee
5653             #* Inclm - Inclination
5654             #* Mm - Mean Anomaly
5655             #* Xn - Mean Motion
5656             #* nodem - right ascension of ascending node
5657             #*
5658             #* Outputs :
5659             #* Eccm - Eccentricity
5660             #* Argpm - Argument of perigee
5661             #* Inclm - Inclination
5662             #* Mm - Mean Anomaly
5663             #* Xn - Mean motion
5664             #* nodem - right ascension of ascending node
5665             #* IRez - Resonance flags 0-none, 1-One day, 2-Half day
5666             #* Atime -
5667             #* D2201, D2211, D3210, D3222, D4410, D4422, D5220, D5232, D5421, D5433 -
5668             #* Dedt -
5669             #* Didt -
5670             #* DMDT -
5671             #* DNDT -
5672             #* DNODT -
5673             #* DOMDT -
5674             #* Del1, Del2, Del3 -
5675             #* Ses , Sghl , Sghs , Sgs , Shl , Shs , Sis , Sls
5676             #* THETA -
5677             #* Xfact -
5678             #* Xlamo -
5679             #* Xli -
5680             #* Xni
5681             #*
5682             #* Locals :
5683             #* ainv2 -
5684             #* aonv -
5685             #* cosisq -
5686             #* eoc -
5687             #* f220, f221, f311, f321, f322, f330, f441, f442, f522, f523, f542, f543 -
5688             #* g200, g201, g211, g300, g310, g322, g410, g422, g520, g521, g532, g533 -
5689             #* sini2 -
5690             #* temp, temp1 -
5691             #* Theta -
5692             #* xno2 -
5693             #*
5694             #* Coupling :
5695             #* getgravconst-
5696             #*
5697             #* references :
5698             #* hoots, roehrich, norad spacetrack report #3 1980
5699             #* hoots, norad spacetrack report #6 1986
5700             #* hoots, schumacher and glover 2004
5701             #* vallado, crawford, hujsak, kelso 2006
5702             #*------------------------------------------------------------------------------
5703              
5704             sub _r_dsinit {
5705 23     23   61 my ($self, $t, $tc) = @_;
5706             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
5707 23 50       114 or confess "Programming error - Sgp4r not initialized";
5708             my $init = $parm->{init}
5709 23 50       102 or confess "Programming error - Sgp4r initialization not in progress";
5710              
5711             #* -------------------------- Local Variables --------------------------
5712 23         125 my ($ainv2, $aonv, $cosisq, $eoc, $f220, $f221, $f311, $f321, $f322,
5713             $f330, $f441, $f442, $f522, $f523, $f542, $f543, $g200, $g201,
5714             $g211, $g300, $g310, $g322, $g410, $g422, $g520, $g521, $g532,
5715             $g533, $ses, $sgs, $sghl, $sghs, $shs, $shl, $sis, $sini2, $sls,
5716             $temp, $temp1, $theta, $xno2);
5717              
5718 23         0 my ($q22, $q31, $q33, $root22, $root44, $root54, $rptim, $root32,
5719             $root52, $znl, $zns, $emo, $emsqo);
5720             #>>>>trw INCLUDE 'ASTMATH.CMN'
5721              
5722 23         34 $q22= 1.7891679e-06;
5723 23         33 $q31= 2.1460748e-06;
5724 23         51 $q33= 2.2123015e-07;
5725 23         37 $root22= 1.7891679e-06;
5726 23         65 $root44= 7.3636953e-09;
5727 23         35 $root54= 2.1765803e-09;
5728 23         39 $rptim= 0.0043752690880113;
5729 23         39 $root32= 3.7393792e-07;
5730 23         51 $root52= 1.1428639e-07;
5731             #>>>>trw X2o3 = 2.0D0 / 3.0D0
5732 23         37 $znl= 0.00015835218;
5733              
5734 23         50 $zns= 1.19459e-05;
5735              
5736             #>>>>trw CALL getgravconst( whichconst, tumin, mu, radiusearthkm, xke, j2, j3, j4, j3oj2 )
5737             #* ------------------------ DEEP SPACE INITIALIZATION ------------------
5738 23         78 $parm->{irez}= 0;
5739 23 100 100     119 if (($init->{xn} < 0.0052359877) && ($init->{xn} > 0.0034906585)) {
5740 6         14 $parm->{irez}= 1;
5741             }
5742 23 100 100     168 if (($init->{xn} >= 0.00826) && ($init->{xn} <= 0.00924) &&
      100        
5743             ($init->{eccm} >= 0.5)) {
5744 5         13 $parm->{irez}= 2;
5745              
5746             }
5747             #* ---------------------------- DO SOLAR TERMS -------------------------
5748 23         67 $ses= $init->{ss1}*$zns*$init->{ss5};
5749 23         88 $sis= $init->{ss2}*$zns*($init->{sz11}+ $init->{sz13});
5750             $sls= -$zns*$init->{ss3}*($init->{sz1}+ $init->{sz3}- 14 -
5751 23         123 6*$init->{emsq});
5752 23         104 $sghs= $init->{ss4}*$zns*($init->{sz31}+ $init->{sz33}- 6);
5753 23         93 $shs= -$zns*$init->{ss2}*($init->{sz21}+ $init->{sz23});
5754             #c sgp4fix for 180 deg incl
5755 23 100 66     161 if (($init->{inclm} < 0.052359877) || ($init->{inclm} >
5756             &SGP_PI-0.052359877)) {
5757 3         6 $shs= 0;
5758             }
5759 23 50       76 if ($init->{sinim} != 0) {
5760 23         63 $shs= $shs/$init->{sinim};
5761             }
5762              
5763 23         49 $sgs= $sghs- $init->{cosim}*$shs;
5764             #* ----------------------------- DO LUNAR TERMS ------------------------
5765 23         77 $parm->{dedt}= $ses+ $init->{s1}*$znl*$init->{s5};
5766 23         74 $parm->{didt}= $sis+ $init->{s2}*$znl*($init->{z11}+ $init->{z13});
5767             $parm->{dmdt}= $sls- $znl*$init->{s3}*($init->{z1}+ $init->{z3}- 14
5768 23         133 - 6*$init->{emsq});
5769 23         67 $sghl= $init->{s4}*$znl*($init->{z31}+ $init->{z33}- 6);
5770 23         77 $shl= -$znl*$init->{s2}*($init->{z21}+ $init->{z23});
5771             #c sgp4fix for 180 deg incl
5772 23 100 66     183 if (($init->{inclm} < 0.052359877) || ($init->{inclm} >
5773             &SGP_PI-0.052359877)) {
5774 3         4 $shl= 0;
5775             }
5776 23         57 $parm->{domdt}= $sgs+$sghl;
5777 23         47 $parm->{dnodt}= $shs;
5778 23 50       77 if ($init->{sinim} != 0) {
5779             $parm->{domdt}=
5780 23         86 $parm->{domdt}-$init->{cosim}/$init->{sinim}*$shl;
5781 23         64 $parm->{dnodt}= $parm->{dnodt}+$shl/$init->{sinim};
5782              
5783             }
5784             #* --------------- CALCULATE DEEP SPACE RESONANCE EFFECTS --------------
5785 23         62 $init->{dndt}= 0;
5786 23         118 $theta= fmod($parm->{gsto}+ $tc*$rptim, &SGP_TWOPI);
5787 23         76 $init->{eccm}= $init->{eccm}+ $parm->{dedt}*$t;
5788 23         77 $init->{emsq}= $init->{eccm}**2;
5789 23         60 $init->{inclm}= $init->{inclm}+ $parm->{didt}*$t;
5790 23         75 $init->{argpm}= $init->{argpm}+ $parm->{domdt}*$t;
5791 23         108 $init->{nodem}= $init->{nodem}+ $parm->{dnodt}*$t;
5792 23         72 $init->{mm}= $init->{mm}+ $parm->{dmdt}*$t;
5793             #c sgp4fix for negative inclinations
5794             #c the following if statement should be commented out
5795             #c IF(Inclm .lt. 0.0D0) THEN
5796             #c Inclm = -Inclm
5797             #c Argpm = Argpm-PI
5798             #c nodem = nodem+PI
5799             #c ENDIF
5800              
5801             #* ------------------ Initialize the resonance terms -------------------
5802 23 100       90 if ($parm->{irez} != 0) {
5803              
5804 11         43 $aonv= ($init->{xn}/$parm->{xke})**&SGP_TOTHRD;
5805             #* -------------- GEOPOTENTIAL RESONANCE FOR 12 HOUR ORBITS ------------
5806 11 100       51 if ($parm->{irez} == 2) {
5807 5         17 $cosisq= $init->{cosim}*$init->{cosim};
5808 5         15 $emo= $init->{eccm};
5809 5         12 $emsqo= $init->{emsq};
5810 5         11 $init->{eccm}= $parm->{eccentricity};
5811 5         11 $init->{emsq}= $init->{eccsq};
5812 5         13 $eoc= $init->{eccm}*$init->{emsq};
5813 5         16 $g201= -0.306-($init->{eccm}-0.64)*0.44;
5814 5 100       26 if ($init->{eccm} <= 0.65) {
5815             $g211= 3.616 - 13.247*$init->{eccm}+
5816 1         6 16.29*$init->{emsq};
5817             $g310= -19.302 + 117.39*$init->{eccm}-
5818 1         3 228.419*$init->{emsq}+ 156.591*$eoc;
5819             $g322= -18.9068+ 109.7927*$init->{eccm}-
5820 1         4 214.6334*$init->{emsq}+ 146.5816*$eoc;
5821             $g410= -41.122 + 242.694*$init->{eccm}-
5822 1         2 471.094*$init->{emsq}+ 313.953*$eoc;
5823             $g422=-146.407 + 841.88*$init->{eccm}-
5824 1         3 1629.014*$init->{emsq}+ 1083.435*$eoc;
5825             $g520=-532.114 + 3017.977*$init->{eccm}-
5826 1         3 5740.032*$init->{emsq}+ 3708.276*$eoc;
5827             } else {
5828             $g211= -72.099 + 331.819*$init->{eccm}-
5829 4         17 508.738*$init->{emsq}+ 266.724*$eoc;
5830             $g310= -346.844 + 1582.851*$init->{eccm}-
5831 4         18 2415.925*$init->{emsq}+ 1246.113*$eoc;
5832             $g322= -342.585 + 1554.908*$init->{eccm}-
5833 4         13 2366.899*$init->{emsq}+ 1215.972*$eoc;
5834             $g410=-1052.797 + 4758.686*$init->{eccm}-
5835 4         15 7193.992*$init->{emsq}+ 3651.957*$eoc;
5836             $g422=-3581.69 + 16178.11*$init->{eccm}-
5837 4         11 24462.77*$init->{emsq}+ 12422.52*$eoc;
5838 4 100       31 if ($init->{eccm} > 0.715) {
5839             $g520=-5149.66 +
5840             29936.92*$init->{eccm}-54087.36*$init->{emsq}+
5841 2         11 31324.56*$eoc;
5842             } else {
5843             $g520= 1464.74 - 4664.75*$init->{eccm}+
5844 2         8 3763.64*$init->{emsq};
5845             }
5846             }
5847 5 100       20 if ($init->{eccm} < 0.7) {
5848             $g533= -919.2277 +
5849             4988.61*$init->{eccm}-9064.77*$init->{emsq}+
5850 2         8 5542.21*$eoc;
5851             $g521= -822.71072 +
5852             4568.6173*$init->{eccm}-8491.4146*$init->{emsq}+
5853 2         6 5337.524*$eoc;
5854             $g532= -853.666 +
5855             4690.25*$init->{eccm}-8624.77*$init->{emsq}+
5856 2         7 5341.4*$eoc;
5857             } else {
5858             $g533=-37995.78 +
5859             161616.52*$init->{eccm}-229838.2*$init->{emsq}+
5860 3         15 109377.94*$eoc;
5861             $g521=-51752.104 +
5862             218913.95*$init->{eccm}-309468.16*$init->{emsq}+
5863 3         11 146349.42*$eoc;
5864             $g532=-40023.88 +
5865             170470.89*$init->{eccm}-242699.48*$init->{emsq}+
5866 3         12 115605.82*$eoc;
5867             }
5868 5         15 $sini2= $init->{sinim}*$init->{sinim};
5869 5         15 $f220= 0.75* (1+2*$init->{cosim}+$cosisq);
5870 5         9 $f221= 1.5*$sini2;
5871             $f321= 1.875*$init->{sinim}*
5872 5         20 (1-2*$init->{cosim}-3*$cosisq);
5873             $f322= -1.875*$init->{sinim}*
5874 5         16 (1+2*$init->{cosim}-3*$cosisq);
5875 5         38 $f441= 35*$sini2*$f220;
5876 5         11 $f442= 39.375*$sini2*$sini2;
5877             $f522= 9.84375*$init->{sinim}* ($sini2*
5878             (1-2*$init->{cosim}- 5*$cosisq)+0.33333333 *
5879 5         41 (-2+4*$init->{cosim}+ 6*$cosisq) );
5880             $f523= $init->{sinim}* (4.92187512*$sini2*
5881             (-2-4*$init->{cosim}+ 10*$cosisq) + 6.56250012*
5882 5         28 (1+2*$init->{cosim}-3*$cosisq));
5883             $f542= 29.53125*$init->{sinim}*
5884             (2-8*$init->{cosim}+$cosisq*
5885 5         22 (-12+8*$init->{cosim}+10*$cosisq) );
5886              
5887             $f543= 29.53125*$init->{sinim}*
5888             (-2-8*$init->{cosim}+$cosisq*
5889 5         19 (12+8*$init->{cosim}-10*$cosisq) );
5890 5         10 $xno2= $init->{xn}* $init->{xn};
5891 5         10 $ainv2= $aonv* $aonv;
5892 5         11 $temp1= 3*$xno2*$ainv2;
5893 5         12 $temp= $temp1*$root22;
5894 5         77 $parm->{d2201}= $temp*$f220*$g201;
5895 5         18 $parm->{d2211}= $temp*$f221*$g211;
5896 5         11 $temp1= $temp1*$aonv;
5897 5         9 $temp= $temp1*$root32;
5898 5         18 $parm->{d3210}= $temp*$f321*$g310;
5899 5         18 $parm->{d3222}= $temp*$f322*$g322;
5900 5         8 $temp1= $temp1*$aonv;
5901 5         14 $temp= 2*$temp1*$root44;
5902 5         58 $parm->{d4410}= $temp*$f441*$g410;
5903 5         19 $parm->{d4422}= $temp*$f442*$g422;
5904 5         9 $temp1= $temp1*$aonv;
5905 5         8 $temp= $temp1*$root52;
5906 5         13 $parm->{d5220}= $temp*$f522*$g520;
5907 5         19 $parm->{d5232}= $temp*$f523*$g532;
5908 5         15 $temp= 2*$temp1*$root54;
5909 5         32 $parm->{d5421}= $temp*$f542*$g521;
5910 5         20 $parm->{d5433}= $temp*$f543*$g533;
5911             $parm->{xlamo}=
5912 5         37 fmod($parm->{meananomaly}+$parm->{ascendingnode}+$parm->{ascendingnode}-$theta-$theta,
5913             &SGP_TWOPI);
5914              
5915             $parm->{xfact}= $parm->{mdot}+ $parm->{dmdt}+ 2 *
5916             ($parm->{nodedot}+$parm->{dnodt}-$rptim) -
5917 5         33 $parm->{meanmotion};
5918 5         12 $init->{eccm}= $emo;
5919 5         15 $init->{emsq}= $emsqo;
5920              
5921             }
5922 11 100       37 if ($parm->{irez} == 1) {
5923             #* -------------------- SYNCHRONOUS RESONANCE TERMS --------------------
5924 6         23 $g200= 1 + $init->{emsq}* (-2.5+0.8125*$init->{emsq});
5925 6         17 $g310= 1 + 2*$init->{emsq};
5926 6         17 $g300= 1 + $init->{emsq}* (-6+6.60937*$init->{emsq});
5927 6         17 $f220= 0.75 * (1+$init->{cosim}) * (1+$init->{cosim});
5928             $f311= 0.9375*$init->{sinim}*$init->{sinim}*
5929 6         22 (1+3*$init->{cosim}) - 0.75*(1+$init->{cosim});
5930 6         8 $f330= 1+$init->{cosim};
5931 6         14 $f330= 1.875*$f330*$f330*$f330;
5932 6         19 $parm->{del1}= 3*$init->{xn}*$init->{xn}*$aonv*$aonv;
5933 6         17 $parm->{del2}= 2*$parm->{del1}*$f220*$g200*$q22;
5934 6         20 $parm->{del3}= 3*$parm->{del1}*$f330*$g300*$q33*$aonv;
5935 6         13 $parm->{del1}= $parm->{del1}*$f311*$g310*$q31*$aonv;
5936             $parm->{xlamo}=
5937 6         64 fmod($parm->{meananomaly}+$parm->{ascendingnode}+$parm->{argumentofperigee}-$theta,
5938             &SGP_TWOPI);
5939             $parm->{xfact}= $parm->{mdot}+ $init->{xpidot}- $rptim+
5940             $parm->{dmdt}+ $parm->{domdt}+ $parm->{dnodt}-
5941 6         28 $parm->{meanmotion};
5942              
5943             }
5944             #* ---------------- FOR SGP4, INITIALIZE THE INTEGRATOR ----------------
5945 11         104 $parm->{xli}= $parm->{xlamo};
5946 11         38 $parm->{xni}= $parm->{meanmotion};
5947 11         37 $parm->{atime}= 0;
5948 11         37 $init->{xn}= $parm->{meanmotion}+ $init->{dndt};
5949              
5950             }
5951             #c INCLUDE 'debug3.for'
5952              
5953 23         69 return;
5954             }
5955              
5956             #* -----------------------------------------------------------------------------
5957             #*
5958             #* SUBROUTINE DSPACE
5959             #*
5960             #* This Subroutine provides deep space contributions to mean elements for
5961             #* perturbing third body. these effects have been averaged over one
5962             #* revolution of the sun and moon. for earth resonance effects, the
5963             #* effects have been averaged over no revolutions of the satellite.
5964             #* (mean motion)
5965             #*
5966             #* author : david vallado 719-573-2600 28 jun 2005
5967             #*
5968             #* inputs :
5969             #* d2201, d2211, d3210, d3222, d4410, d4422, d5220, d5232, d5421, d5433 -
5970             #* dedt -
5971             #* del1, del2, del3 -
5972             #* didt -
5973             #* dmdt -
5974             #* dnodt -
5975             #* domdt -
5976             #* irez - flag for resonance 0-none, 1-one day, 2-half day
5977             #* argpo - argument of perigee
5978             #* argpdot - argument of perigee dot (rate)
5979             #* t - time
5980             #* tc -
5981             #* gsto - gst
5982             #* xfact -
5983             #* xlamo -
5984             #* no - mean motion
5985             #* atime -
5986             #* em - eccentricity
5987             #* ft -
5988             #* argpm - argument of perigee
5989             #* inclm - inclination
5990             #* xli -
5991             #* mm - mean anomaly
5992             #* xni - mean motion
5993             #* nodem - right ascension of ascending node
5994             #*
5995             #* outputs :
5996             #* atime -
5997             #* em - eccentricity
5998             #* argpm - argument of perigee
5999             #* inclm - inclination
6000             #* xli -
6001             #* mm - mean anomaly
6002             #* xni -
6003             #* nodem - right ascension of ascending node
6004             #* dndt -
6005             #* nm - mean motion
6006             #*
6007             #* locals :
6008             #* delt -
6009             #* ft -
6010             #* theta -
6011             #* x2li -
6012             #* x2omi -
6013             #* xl -
6014             #* xldot -
6015             #* xnddt -
6016             #* xndt -
6017             #* xomi -
6018             #*
6019             #* coupling :
6020             #* none -
6021             #*
6022             #* references :
6023             #* hoots, roehrich, norad spacetrack report #3 1980
6024             #* hoots, norad spacetrack report #6 1986
6025             #* hoots, schumacher and glover 2004
6026             #* vallado, crawford, hujsak, kelso 2006
6027             #*------------------------------------------------------------------------------
6028              
6029             sub _r_dspace {
6030 397     397   1741 my ($self, $t, $tc, $atime, $eccm, $argpm, $inclm, $xli, $mm, $xni,
6031             $nodem, $dndt, $xn) = @_;
6032             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
6033 397 50       1910 or confess "Programming error - Sgp4r not initialized";
6034              
6035             #* -------------------------- Local Variables --------------------------
6036 397         2080 my ($iretn, $iret);
6037 397         0 my ($delt, $ft, $theta, $x2li, $x2omi, $xl, $xldot, $xnddt, $xndt,
6038             $xomi);
6039              
6040 397         0 my ($g22, $g32, $g44, $g52, $g54, $fasx2, $fasx4, $fasx6, $rptim,
6041             $step2, $stepn, $stepp);
6042             #>>>>trw INCLUDE 'ASTMATH.CMN'
6043              
6044             #* ----------------------------- Constants -----------------------------
6045 397         691 $fasx2= 0.13130908;
6046 397         692 $fasx4= 2.8843198;
6047 397         624 $fasx6= 0.37448087;
6048 397         617 $g22= 5.7686396;
6049 397         531 $g32= 0.95240898;
6050 397         769 $g44= 1.8014998;
6051 397         758 $g52= 1.050833;
6052 397         650 $g54= 4.4108898;
6053 397         686 $rptim= 0.0043752690880113;
6054 397         705 $stepp= 720;
6055 397         602 $stepn= -720;
6056              
6057 397         692 $step2= 259200;
6058             #* --------------- CALCULATE DEEP SPACE RESONANCE EFFECTS --------------
6059 397         1088 $$dndt= 0;
6060 397         2355 $theta= fmod($parm->{gsto}+ $tc*$rptim, &SGP_TWOPI);
6061              
6062 397         1261 $$eccm= $$eccm+ $parm->{dedt}*$t;
6063 397         853 $$inclm= $$inclm+ $parm->{didt}*$t;
6064 397         1073 $$argpm= $$argpm+ $parm->{domdt}*$t;
6065 397         892 $$nodem= $$nodem+ $parm->{dnodt}*$t;
6066              
6067 397         975 $$mm= $$mm+ $parm->{dmdt}*$t;
6068             #c sgp4fix for negative inclinations
6069             #c the following if statement should be commented out
6070             #c IF(Inclm .lt. 0.0D0) THEN
6071             #c Inclm = -Inclm
6072             #c Argpm = Argpm-PI
6073             #c nodem = nodem+PI
6074             #c ENDIF
6075              
6076             #c sgp4fix for propagator problems
6077             #c the following integration works for negative time steps and periods
6078             #c the specific changes are unknown because the original code was so convoluted
6079 397         813 $ft= 0;
6080              
6081 397         779 $$atime= 0;
6082 397 100       1242 if ($parm->{irez} != 0) {
6083             #* ----- UPDATE RESONANCES : NUMERICAL (EULER-MACLAURIN) INTEGRATION ---
6084             #* ---------------------------- EPOCH RESTART --------------------------
6085 220 0 0     1042 if ( ($$atime == 0) || (($t >= 0) && ($$atime < 0)) ||
      33        
      0        
      0        
6086             (($t < 0) && ($$atime >= 0)) ) {
6087 220 100       851 if ($t >= 0) {
6088 195         385 $delt= $stepp;
6089             } else {
6090 25         63 $delt= $stepn;
6091             }
6092 220         563 $$atime= 0;
6093 220         516 $$xni= $parm->{meanmotion};
6094 220         629 $$xli= $parm->{xlamo};
6095             }
6096 220         414 $iretn= 381;
6097 220         361 $iret= 0;
6098 220         646 while ($iretn == 381) {
6099 544 50 33     2158 if ( (abs($t) < abs($$atime)) || ($iret == 351) ) {
6100 0 0       0 if ($t >= 0) {
6101 0         0 $delt= $stepn;
6102             } else {
6103 0         0 $delt= $stepp;
6104             }
6105 0         0 $iret= 351;
6106 0         0 $iretn= 381;
6107             } else {
6108 544 100       1107 if ($t > 0) {
6109 485         878 $delt= $stepp;
6110             } else {
6111 59         111 $delt= $stepn;
6112             }
6113 544 100       1112 if (abs($t-$$atime) >= $stepp) {
6114 324         515 $iret= 0;
6115 324         625 $iretn= 381;
6116             } else {
6117 220         316 $ft= $t-$$atime;
6118 220         394 $iretn= 0;
6119             }
6120              
6121             }
6122             #* --------------------------- DOT TERMS CALCULATED --------------------
6123             #* ------------------- NEAR - SYNCHRONOUS RESONANCE TERMS --------------
6124 544 100       1189 if ($parm->{irez} != 2) {
6125             $xndt= $parm->{del1}*sin($$xli-$fasx2) +
6126             $parm->{del2}*sin(2*($$xli-$fasx4)) +
6127 219         863 $parm->{del3}*sin(3*($$xli-$fasx6));
6128 219         358 $xldot= $$xni+ $parm->{xfact};
6129             $xnddt= $parm->{del1}*cos($$xli-$fasx2) +
6130             2*$parm->{del2}*cos(2*($$xli-$fasx4)) +
6131 219         796 3*$parm->{del3}*cos(3*($$xli-$fasx6));
6132 219         379 $xnddt= $xnddt*$xldot;
6133              
6134             } else {
6135             #* --------------------- NEAR - HALF-DAY RESONANCE TERMS ---------------
6136             $xomi= $parm->{argumentofperigee}+
6137 325         630 $parm->{argpdot}*$$atime;
6138 325         462 $x2omi= $xomi+ $xomi;
6139 325         532 $x2li= $$xli+ $$xli;
6140             $xndt= $parm->{d2201}*sin($x2omi+$$xli-$g22) +
6141             $parm->{d2211}*sin($$xli-$g22) +
6142             $parm->{d3210}*sin($xomi+$$xli-$g32) +
6143             $parm->{d3222}*sin(-$xomi+$$xli-$g32) +
6144             $parm->{d4410}*sin($x2omi+$x2li-$g44)+
6145             $parm->{d4422}*sin($x2li-$g44)+
6146             $parm->{d5220}*sin($xomi+$$xli-$g52) +
6147             $parm->{d5232}*sin(-$xomi+$$xli-$g52) +
6148             $parm->{d5421}*sin($xomi+$x2li-$g54)+
6149 325         2288 $parm->{d5433}*sin(-$xomi+$x2li-$g54);
6150 325         540 $xldot= $$xni+$parm->{xfact};
6151             $xnddt= $parm->{d2201}*cos($x2omi+$$xli-$g22) +
6152             $parm->{d2211}*cos($$xli-$g22)+
6153             $parm->{d3210}*cos($xomi+$$xli-$g32) +
6154             $parm->{d3222}*cos(-$xomi+$$xli-$g32) +
6155             $parm->{d5220}*cos($xomi+$$xli-$g52) +
6156             $parm->{d5232}*cos(-$xomi+$$xli-$g52) +
6157             2*($parm->{d4410}*cos($x2omi+$x2li-$g44) +
6158             $parm->{d4422}*cos($x2li-$g44) +
6159             $parm->{d5421}*cos($xomi+$x2li-$g54) +
6160 325         1926 $parm->{d5433}*cos(-$xomi+$x2li-$g54));
6161 325         495 $xnddt= $xnddt*$xldot;
6162              
6163             }
6164             #* ------------------------------- INTEGRATOR --------------------------
6165 544 100       1440 if ($iretn == 381) {
6166 324         742 $$xli= $$xli+ $xldot*$delt+ $xndt*$step2;
6167 324         629 $$xni= $$xni+ $xndt*$delt+ $xnddt*$step2;
6168 324         784 $$atime= $$atime+ $delt;
6169              
6170             }
6171              
6172             }
6173 220         625 $$xn= $$xni+ $xndt*$ft+ $xnddt*$ft*$ft*0.5;
6174 220         666 $xl= $$xli+ $xldot*$ft+ $xndt*$ft*$ft*0.5;
6175 220 100       611 if ($parm->{irez} != 1) {
6176 125         262 $$mm= $xl-2*$$nodem+2*$theta;
6177 125         278 $$dndt= $$xn-$parm->{meanmotion};
6178             } else {
6179 95         238 $$mm= $xl-$$nodem-$$argpm+$theta;
6180 95         206 $$dndt= $$xn-$parm->{meanmotion};
6181              
6182             }
6183 220         596 $$xn= $parm->{meanmotion}+ $$dndt;
6184              
6185             }
6186             #c INCLUDE 'debug4.for'
6187              
6188 397         1175 return;
6189             }
6190              
6191             #* -----------------------------------------------------------------------------
6192             #*
6193             #* SUBROUTINE INITL
6194             #*
6195             #* this subroutine initializes the spg4 propagator. all the initialization is
6196             #* consolidated here instead of having multiple loops inside other routines.
6197             #*
6198             #* author : david vallado 719-573-2600 28 jun 2005
6199             #*
6200             #* inputs :
6201             #* ecco - eccentricity 0.0 - 1.0
6202             #* epoch - epoch time in days from jan 0, 1950. 0 hr
6203             #* inclo - inclination of satellite
6204             #* no - mean motion of satellite
6205             #* satn - satellite number
6206             #*
6207             #* outputs :
6208             #* ainv - 1.0 / a
6209             #* ao - semi major axis
6210             #* con41 -
6211             #* con42 - 1.0 - 5.0 cos(i)
6212             #* cosio - cosine of inclination
6213             #* cosio2 - cosio squared
6214             #* eccsq - eccentricity squared
6215             #* method - flag for deep space 'd', 'n'
6216             #* omeosq - 1.0 - ecco * ecco
6217             #* posq - semi-parameter squared
6218             #* rp - radius of perigee
6219             #* rteosq - square root of (1.0 - ecco*ecco)
6220             #* sinio - sine of inclination
6221             #* gsto - gst at time of observation rad
6222             #* no - mean motion of satellite
6223             #*
6224             #* locals :
6225             #* ak -
6226             #* d1 -
6227             #* del -
6228             #* adel -
6229             #* po -
6230             #*
6231             #* coupling :
6232             #* getgravconst-
6233             #*
6234             #* references :
6235             #* hoots, roehrich, norad spacetrack report #3 1980
6236             #* hoots, norad spacetrack report #6 1986
6237             #* hoots, schumacher and glover 2004
6238             #* vallado, crawford, hujsak, kelso 2006
6239             #*------------------------------------------------------------------------------
6240              
6241             sub _r_initl {
6242 35     35   98 my ($self) = @_;
6243             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
6244 35 50       163 or confess "Programming error - Sgp4r not initialized";
6245             my $init = $parm->{init}
6246 35 50       121 or confess "Programming error - Sgp4r initialization not in progress";
6247              
6248             #* -------------------------- Local Variables --------------------------
6249             #cdav old way
6250             #c integer ids70
6251             #c real*8 ts70, ds70, tfrac, c1, thgr70, fk5r, c1p2p, thgr, thgro,
6252             #c & twopi
6253             #>>>>trw INCLUDE 'ASTMATH.CMN'
6254              
6255             #* ------------------------ WGS-72 EARTH CONSTANTS ---------------------
6256              
6257             #>>>>trw X2o3 = 2.0D0/3.0D0
6258              
6259             #>>>>trw CALL getgravconst( whichconst, tumin, mu, radiusearthkm, xke, j2, j3, j4, j3oj2 )
6260             #* ----------------- CALCULATE AUXILLARY EPOCH QUANTITIES --------------
6261 35         163 $init->{eccsq}= $parm->{eccentricity}*$parm->{eccentricity};
6262 35         99 $init->{omeosq}= 1 - $init->{eccsq};
6263 35         112 $init->{rteosq}= sqrt($init->{omeosq});
6264 35         109 $init->{cosio}= cos($parm->{inclination});
6265              
6266 35         101 $init->{cosio2}= $init->{cosio}*$init->{cosio};
6267             #* ---------------------- UN-KOZAI THE MEAN MOTION ---------------------
6268 35         151 my $ak= ($parm->{xke}/$parm->{meanmotion})**&SGP_TOTHRD;
6269             my $d1= 0.75*$parm->{j2}* (3*$init->{cosio2}-1) /
6270 35         153 ($init->{rteosq}*$init->{omeosq});
6271 35         81 my $del= $d1/($ak*$ak);
6272 35         132 my $adel= $ak* ( 1 - $del*$del- $del* (1/3 + 134*$del*$del/ 81) );
6273 35         65 $del= $d1/($adel*$adel);
6274              
6275 35         98 $parm->{meanmotion}= $parm->{meanmotion}/(1 + $del);
6276 35         149 $init->{ao}= ($parm->{xke}/$parm->{meanmotion})**&SGP_TOTHRD;
6277 35         102 $init->{sinio}= sin($parm->{inclination});
6278 35         76 my $po= $init->{ao}*$init->{omeosq};
6279 35         121 $init->{con42}= 1-5*$init->{cosio2};
6280 35         158 $parm->{con41}= -$init->{con42}-$init->{cosio2}-$init->{cosio2};
6281 35         189 $init->{ainv}= 1/$init->{ao};
6282 35         161 $init->{posq}= $po*$po;
6283 35         152 $init->{rp}= $init->{ao}*(1-$parm->{eccentricity});
6284              
6285 35         71 $parm->{deep_space}=0;
6286             #* ----------------- CALCULATE GREENWICH LOCATION AT EPOCH -------------
6287             #cdav new approach using JD
6288 35         125 my $radperday= &SGP_TWOPI* 1.0027379093508;
6289              
6290 35         83 my $temp= $self->{ds50}+ 2433281.5;
6291 35         140 my $tut1= ( int($temp-0.5) + 0.5 - 2451545 ) / 36525;
6292              
6293 35         179 $parm->{gsto}= 1.75336855923327 + 628.331970688841*$tut1+
6294             6.77071394490334e-06*$tut1*$tut1-
6295             4.50876723431868e-10*$tut1*$tut1*$tut1+ $radperday*(
6296             $temp-0.5-int($temp-0.5) );
6297 35         175 $parm->{gsto}= fmod($parm->{gsto}, &SGP_TWOPI);
6298 35 100       109 if ( $parm->{gsto} < 0 ) {
6299 9         34 $parm->{gsto}= $parm->{gsto}+ &SGP_TWOPI;
6300              
6301             }
6302             #* CALCULATE NUMBER OF INTEGER DAYS SINCE 0 JAN 1970.
6303             #cdav old way
6304             #c TS70 =EPOCH-7305.D0
6305             #c IDS70=TS70 + 1.D-8
6306             #c DS70 =IDS70
6307             #c TFRAC=TS70-DS70
6308             #* CALCULATE GREENWICH LOCATION AT EPOCH
6309             #c C1 = 1.72027916940703639D-2
6310             #c THGR70= 1.7321343856509374D0
6311             #c FK5R = 5.07551419432269442D-15
6312             #c twopi = 6.283185307179586D0
6313             #c C1P2P = C1+TWOPI
6314             #c THGR = DMOD(THGR70+C1*DS70+C1P2P*TFRAC+TS70*TS70*FK5R,twopi)
6315             #c THGRO = DMOD(THGR,twopi)
6316             #c gsto = thgro
6317             #c write(*,*) Satn,' gst delta ', gsto-gsto1
6318              
6319             #c INCLUDE 'debug5.for'
6320              
6321 35         72 return;
6322             }
6323              
6324             #* -----------------------------------------------------------------------------
6325             #*
6326             #* SUBROUTINE SGP4INIT
6327             #*
6328             #* This subroutine initializes variables for SGP4.
6329             #*
6330             #* author : david vallado 719-573-2600 28 jun 2005
6331             #*
6332             #* inputs :
6333             #* satn - satellite number
6334             #* bstar - sgp4 type drag coefficient kg/m2er
6335             #* ecco - eccentricity
6336             #* epoch - epoch time in days from jan 0, 1950. 0 hr
6337             #* argpo - argument of perigee (output if ds)
6338             #* inclo - inclination
6339             #* mo - mean anomaly (output if ds)
6340             #* no - mean motion
6341             #* nodeo - right ascension of ascending node
6342             #*
6343             #* outputs :
6344             #* satrec - common block values for subsequent calls
6345             #* return code - non-zero on error.
6346             #* 1 - mean elements, ecc >= 1.0 or ecc < -0.001 or a < 0.95 er
6347             #* 2 - mean motion less than 0.0
6348             #* 3 - pert elements, ecc < 0.0 or ecc > 1.0
6349             #* 4 - semi-latus rectum < 0.0
6350             #* 5 - epoch elements are sub-orbital
6351             #* 6 - satellite has decayed
6352             #*
6353             #* locals :
6354             #* CNODM , SNODM , COSIM , SINIM , COSOMM , SINOMM
6355             #* Cc1sq , Cc2 , Cc3
6356             #* Coef , Coef1
6357             #* cosio4 -
6358             #* day -
6359             #* dndt -
6360             #* em - eccentricity
6361             #* emsq - eccentricity squared
6362             #* eeta -
6363             #* etasq -
6364             #* gam -
6365             #* argpm - argument of perigee
6366             #* ndem -
6367             #* inclm - inclination
6368             #* mm - mean anomaly
6369             #* nm - mean motion
6370             #* perige - perigee
6371             #* pinvsq -
6372             #* psisq -
6373             #* qzms24 -
6374             #* rtemsq -
6375             #* s1, s2, s3, s4, s5, s6, s7 -
6376             #* sfour -
6377             #* ss1, ss2, ss3, ss4, ss5, ss6, ss7 -
6378             #* sz1, sz2, sz3
6379             #* sz11, sz12, sz13, sz21, sz22, sz23, sz31, sz32, sz33 -
6380             #* tc -
6381             #* temp -
6382             #* temp1, temp2, temp3 -
6383             #* tsi -
6384             #* xpidot -
6385             #* xhdot1 -
6386             #* z1, z2, z3 -
6387             #* z11, z12, z13, z21, z22, z23, z31, z32, z33 -
6388             #*
6389             #* coupling :
6390             #* getgravconst-
6391             #* initl -
6392             #* dscom -
6393             #* dpper -
6394             #* dsinit -
6395             #*
6396             #* references :
6397             #* hoots, roehrich, norad spacetrack report #3 1980
6398             #* hoots, norad spacetrack report #6 1986
6399             #* hoots, schumacher and glover 2004
6400             #* vallado, crawford, hujsak, kelso 2006
6401             #* ---------------------------------------------------------------------------- }
6402              
6403             sub _r_sgp4init {
6404 35     35   89 my ($self) = @_;
6405 35         111 my $oid = $self->get('id');
6406 35         203 my $parm = $self->{&TLE_INIT}{TLE_sgp4r} = {};
6407 35         112 my $init = $parm->{init} = {};
6408             # The following is modified in _r_initl
6409 35         127 $parm->{meanmotion} = $self->{meanmotion};
6410             # The following may be modified for deep space
6411 35         113 $parm->{eccentricity} = $self->{eccentricity};
6412 35         111 $parm->{inclination} = $self->{inclination};
6413 35         122 $parm->{ascendingnode} = $self->{ascendingnode};
6414 35         88 $parm->{argumentofperigee} = $self->{argumentofperigee};
6415 35         108 $parm->{meananomaly} = $self->{meananomaly};
6416              
6417             #>>>>trw my ($t, @r, @v);
6418 35         89 my ($t);
6419             #>>>>trw INCLUDE 'SGP4.CMN'
6420              
6421             #* -------------------------- Local Variables --------------------------
6422              
6423 35         144 my ($cc1sq, $cc2, $cc3, $coef, $coef1, $cosio4, $eeta, $etasq,
6424             $perige, $pinvsq, $psisq, $qzms24, $sfour, $tc, $temp, $temp1,
6425             $temp2, $temp3, $tsi, $xhdot1);
6426 35         0 my ($qzms2t, $ss, $temp4);
6427             #>>>>trw INCLUDE 'ASTMATH.CMN'
6428              
6429             #* ---------------------------- INITIALIZATION -------------------------
6430 35         115 $parm->{deep_space}=0;
6431             #c clear sgp4 flag
6432              
6433 35         142 $self->{model_error}= &SGP4R_ERROR_0;
6434             #c sgp4fix - note the following variables are also passed directly via sgp4 common.
6435             #c it is possible to streamline the sgp4init call by deleting the "x"
6436             #c variables, but the user would need to set the common values first. we
6437             #c include the additional assignment in case twoline2rv is not used.
6438              
6439             #>>>>trw bstar = xbstar
6440             #>>>>trw ecco = xecco
6441             #>>>>trw argpo = xargpo
6442             #>>>>trw inclo = xinclo
6443             #>>>>trw mo = xmo
6444             #>>>>trw no = xno
6445              
6446             #>>>>trw nodeo = xnodeo
6447              
6448 35         252 $self->_r_getgravconst();
6449 35         111 $ss= 78/$parm->{radiusearthkm}+ 1;
6450 35         100 $qzms2t= ((120-78)/$parm->{radiusearthkm}) ** 4;
6451             #>>>>trw X2o3 = 2.0D0 / 3.0D0
6452              
6453 35         155 $temp4= 1 + cos(&SGP_PI-1e-09);
6454             #>>>>trw Init = 'y'
6455              
6456 35         181 $t= 0;
6457              
6458 35 50       177 $self->{eccentricity} > 1
6459             and croak "Error - OID $oid Sgp4r TLE eccentricity > 1";
6460 35 50       172 $self->{eccentricity} < 0
6461             and croak "Error - OID $oid Sgp4r TLE eccentricity < 0";
6462 35 50       122 $self->{meanmotion} < 0
6463             and croak "Error - OID $oid Sgp4r TLE mean motion < 0";
6464 35         210 $self->_r_initl();
6465 35 100       123 if ($init->{rp} < 1) {
6466             #c Write(*,*) '# *** SATN',Satn,' EPOCH ELTS SUB-ORBITAL *** '
6467 1         4 $self->{model_error}= &SGP4R_ERROR_5;
6468              
6469             }
6470 35 50 33     155 if ($init->{omeosq} >= 0 || $parm->{meanmotion} >= 0) {
6471 35         91 $parm->{isimp}= 0;
6472 35 100       123 if ($init->{rp} < (220/$parm->{radiusearthkm}+1)) {
6473 16         33 $parm->{isimp}= 1;
6474             }
6475 35         79 $sfour= $ss;
6476 35         91 $qzms24= $qzms2t;
6477              
6478 35         89 $perige= ($init->{rp}-1)*$parm->{radiusearthkm};
6479             #* ----------- For perigees below 156 km, S and Qoms2t are altered -----
6480 35 100       102 if ($perige < 156) {
6481 9         24 $sfour= $perige-78;
6482 9 100       38 if ($perige <= 98) {
6483 3         6 $sfour= 20;
6484             }
6485 9         49 $qzms24= ( (120-$sfour)/$parm->{radiusearthkm})**4;
6486 9         25 $sfour= $sfour/$parm->{radiusearthkm}+ 1;
6487             }
6488              
6489 35         106 $pinvsq= 1/$init->{posq};
6490 35         86 $tsi= 1/($init->{ao}-$sfour);
6491 35         118 $parm->{eta}= $init->{ao}*$parm->{eccentricity}*$tsi;
6492 35         76 $etasq= $parm->{eta}*$parm->{eta};
6493 35         66 $eeta= $parm->{eccentricity}*$parm->{eta};
6494 35         68 $psisq= abs(1-$etasq);
6495 35         78 $coef= $qzms24*$tsi**4;
6496 35         98 $coef1= $coef/$psisq**3.5;
6497             $cc2= $coef1*$parm->{meanmotion}* ($init->{ao}*
6498             (1+1.5*$etasq+$eeta* (4+$etasq) )+0.375*
6499 35         210 $parm->{j2}*$tsi/$psisq*$parm->{con41}*(8+3*$etasq*(8+$etasq)));
6500 35         99 $parm->{cc1}= $self->{bstardrag}*$cc2;
6501 35         71 $cc3= 0;
6502 35 100       112 if ($parm->{eccentricity} > 0.0001) {
6503             $cc3=
6504             -2*$coef*$tsi*$parm->{j3oj2}*$parm->{meanmotion}*
6505 33         116 $init->{sinio}/$parm->{eccentricity};
6506             }
6507 35         167 $parm->{x1mth2}= 1-$init->{cosio2};
6508             $parm->{cc4}=
6509             2*$parm->{meanmotion}*$coef1*$init->{ao}*$init->{omeosq}*
6510             ($parm->{eta}*(2+0.5*$etasq)
6511             +$parm->{eccentricity}*(0.5 + 2*$etasq) - $parm->{j2}*$tsi/
6512             ($init->{ao}*$psisq)* (-3*$parm->{con41}*(1-2*
6513             $eeta+$etasq*(1.5-0.5*$eeta))+0.75*$parm->{x1mth2}*
6514 35         309 (2*$etasq-$eeta*(1+$etasq))*cos(2*$parm->{argumentofperigee})));
6515 35         147 $parm->{cc5}= 2*$coef1*$init->{ao}*$init->{omeosq}* (1 + 2.75*
6516             ($etasq+ $eeta) + $eeta*$etasq);
6517 35         88 $cosio4= $init->{cosio2}*$init->{cosio2};
6518 35         91 $temp1= 1.5*$parm->{j2}*$pinvsq*$parm->{meanmotion};
6519 35         78 $temp2= 0.5*$temp1*$parm->{j2}*$pinvsq;
6520             $temp3=
6521 35         107 -0.46875*$parm->{j4}*$pinvsq*$pinvsq*$parm->{meanmotion};
6522             $parm->{mdot}= $parm->{meanmotion}+
6523             0.5*$temp1*$init->{rteosq}*$parm->{con41}+ 0.0625*$temp2*
6524 35         217 $init->{rteosq}*(13 - 78*$init->{cosio2}+ 137*$cosio4);
6525             $parm->{argpdot}= -0.5*$temp1*$init->{con42}+ 0.0625*$temp2* (7
6526             - 114*$init->{cosio2}+
6527 35         217 395*$cosio4)+$temp3*(3-36*$init->{cosio2}+49*$cosio4);
6528 35         77 $xhdot1= -$temp1*$init->{cosio};
6529             $parm->{nodedot}= $xhdot1+(0.5*$temp2*(4-19*$init->{cosio2})+
6530 35         178 2*$temp3*(3 - 7*$init->{cosio2}))*$init->{cosio};
6531 35         136 $init->{xpidot}= $parm->{argpdot}+$parm->{nodedot};
6532             $parm->{omgcof}=
6533 35         139 $self->{bstardrag}*$cc3*cos($parm->{argumentofperigee});
6534 35         100 $parm->{xmcof}= 0;
6535 35 100       138 if ($parm->{eccentricity} > 0.0001) {
6536 33         150 $parm->{xmcof}= -&SGP_TOTHRD*$coef*$self->{bstardrag}/$eeta;
6537             }
6538 35         128 $parm->{xnodcf}= 3.5*$init->{omeosq}*$xhdot1*$parm->{cc1};
6539 35         75 $parm->{t2cof}= 1.5*$parm->{cc1};
6540             #c sgp4fix for divide by zero with xinco = 180 deg
6541 35 50       154 if (abs($init->{cosio}+1) > 1.5e-12) {
6542             $parm->{xlcof}= -0.25*$parm->{j3oj2}*$init->{sinio}*
6543 35         179 (3+5*$init->{cosio})/(1+$init->{cosio});
6544             } else {
6545             $parm->{xlcof}= -0.25*$parm->{j3oj2}*$init->{sinio}*
6546 0         0 (3+5*$init->{cosio})/$temp4;
6547             }
6548 35         124 $parm->{aycof}= -0.5*$parm->{j3oj2}*$init->{sinio};
6549 35         147 $parm->{delmo}= (1+$parm->{eta}*cos($parm->{meananomaly}))**3;
6550 35         91 $parm->{sinmao}= sin($parm->{meananomaly});
6551              
6552 35         149 $parm->{x7thm1}= 7*$init->{cosio2}-1;
6553             #* ------------------------ Deep Space Initialization ------------------
6554 35 100       195 if ((&SGP_TWOPI/$parm->{meanmotion}) >= 225) {
6555 23         66 $parm->{deep_space}=1;
6556 23         92 $parm->{isimp}= 1;
6557 23         64 $tc= 0;
6558 23         82 $init->{inclm}= $parm->{inclination};
6559 23         149 $self->_r_dscom ($tc);
6560              
6561             $self->_r_dpper ($t, \$parm->{eccentricity},
6562             \$parm->{inclination}, \$parm->{ascendingnode},
6563 23         159 \$parm->{argumentofperigee}, \$parm->{meananomaly});
6564 23         71 $init->{argpm}= 0;
6565 23         58 $init->{nodem}= 0;
6566              
6567 23         63 $init->{mm}= 0;
6568 23         122 $self->_r_dsinit ($t, $tc);
6569              
6570             }
6571             #* ------------ Set variables if not deep space or rp < 220 -------------
6572 35 100       127 if ( ! $parm->{isimp}) {
6573 4         13 $cc1sq= $parm->{cc1}*$parm->{cc1};
6574 4         17 $parm->{d2}= 4*$init->{ao}*$tsi*$cc1sq;
6575 4         16 $temp= $parm->{d2}*$tsi*$parm->{cc1}/ 3;
6576 4         14 $parm->{d3}= (17*$init->{ao}+ $sfour) * $temp;
6577             $parm->{d4}= 0.5*$temp*$init->{ao}*$tsi* (221*$init->{ao}+
6578 4         23 31*$sfour)*$parm->{cc1};
6579 4         15 $parm->{t3cof}= $parm->{d2}+ 2*$cc1sq;
6580             $parm->{t4cof}= 0.25*
6581 4         17 (3*$parm->{d3}+$parm->{cc1}*(12*$parm->{d2}+10*$cc1sq)
6582             );
6583             $parm->{t5cof}= 0.2* (3*$parm->{d4}+
6584             12*$parm->{cc1}*$parm->{d3}+ 6*$parm->{d2}*$parm->{d2}+
6585 4         22 15*$cc1sq* (2*$parm->{d2}+ $cc1sq) );
6586              
6587             }
6588              
6589             }
6590              
6591             #>>>>trw init = 'n'
6592              
6593             #>>>>trw CALL SGP4(whichconst, 0.0D0, r, v, error)
6594             #c INCLUDE 'debug6.for'
6595              
6596             #>>>>trw RETURN
6597              
6598 35         101 delete $parm->{init};
6599 35         370 return $parm;
6600             }
6601              
6602             #* -----------------------------------------------------------------------------
6603             #*
6604             #* SUBROUTINE SGP4
6605             #*
6606             #* this procedure is the sgp4 prediction model from space command. this is an
6607             #* updated and combined version of sgp4 and sdp4, which were originally
6608             #* published separately in spacetrack report #3. this version follows the
6609             #* methodology from the aiaa paper (2006) describing the history and
6610             #* development of the code.
6611             #*
6612             #* author : david vallado 719-573-2600 28 jun 2005
6613             #*
6614             #* inputs :
6615             #* satrec - initialised structure from sgp4init() call.
6616             #* tsince - time eince epoch (minutes)
6617             #*
6618             #* outputs :
6619             #* r - position vector km
6620             #* v - velocity km/sec
6621             #* return code - non-zero on error.
6622             #* 1 - mean elements, ecc >= 1.0 or ecc < -0.001 or a < 0.95 er
6623             #* 2 - mean motion less than 0.0
6624             #* 3 - pert elements, ecc < 0.0 or ecc > 1.0
6625             #* 4 - semi-latus rectum < 0.0
6626             #* 5 - epoch elements are sub-orbital
6627             #* 6 - satellite has decayed
6628             #*
6629             #* locals :
6630             #* am -
6631             #* axnl, aynl -
6632             #* betal -
6633             #* COSIM , SINIM , COSOMM , SINOMM , Cnod , Snod , Cos2u ,
6634             #* Sin2u , Coseo1 , Sineo1 , Cosi , Sini , Cosip , Sinip ,
6635             #* Cosisq , Cossu , Sinsu , Cosu , Sinu
6636             #* Delm -
6637             #* Delomg -
6638             #* Dndt -
6639             #* Eccm -
6640             #* EMSQ -
6641             #* Ecose -
6642             #* El2 -
6643             #* Eo1 -
6644             #* Eccp -
6645             #* Esine -
6646             #* Argpm -
6647             #* Argpp -
6648             #* Omgadf -
6649             #* Pl -
6650             #* R -
6651             #* RTEMSQ -
6652             #* Rdotl -
6653             #* Rl -
6654             #* Rvdot -
6655             #* Rvdotl -
6656             #* Su -
6657             #* T2 , T3 , T4 , Tc
6658             #* Tem5, Temp , Temp1 , Temp2 , Tempa , Tempe , Templ
6659             #* U , Ux , Uy , Uz , Vx , Vy , Vz
6660             #* inclm - inclination
6661             #* mm - mean anomaly
6662             #* nm - mean motion
6663             #* nodem - longi of ascending node
6664             #* xinc -
6665             #* xincp -
6666             #* xl -
6667             #* xlm -
6668             #* mp -
6669             #* xmdf -
6670             #* xmx -
6671             #* xmy -
6672             #* nodedf -
6673             #* xnode -
6674             #* nodep -
6675             #* np -
6676             #*
6677             #* coupling :
6678             #* getgravconst-
6679             #* dpper
6680             #* dpspace
6681             #*
6682             #* references :
6683             #* hoots, roehrich, norad spacetrack report #3 1980
6684             #* hoots, norad spacetrack report #6 1986
6685             #* hoots, schumacher and glover 2004
6686             #* vallado, crawford, hujsak, kelso 2006
6687             #*------------------------------------------------------------------------------
6688              
6689             sub sgp4r {
6690 18820     18820 1 39891 my ($self, $t) = @_;
6691 18820         46040 my $oid = $self->get('id');
6692 18820   66     102855 my $parm = $self->{&TLE_INIT}{TLE_sgp4r} ||= $self->_r_sgp4init ();
6693 18820         35521 my $time = $t;
6694 18820         56063 $t = ($t - $self->{epoch}) / 60;
6695              
6696 18820         98947 my (@r, @v);
6697             #>>>>trw INCLUDE 'SGP4.CMN'
6698              
6699             #* -------------------------- Local Variables --------------------------
6700              
6701 18820         0 my ($am, $axnl, $aynl, $betal, $cosim, $cnod, $cos2u, $coseo1,
6702             $cosi, $cosip, $cosisq, $cossu, $cosu, $delm, $delomg, $eccm,
6703             $emsq, $ecose, $el2, $eo1, $eccp, $esine, $argpm, $argpp,
6704             $omgadf, $pl, $rdotl, $rl, $rvdot, $rvdotl, $sinim, $sin2u,
6705             $sineo1, $sini, $sinip, $sinsu, $sinu, $snod, $su, $t2, $t3,
6706             $t4, $tem5, $temp, $temp1, $temp2, $tempa, $tempe, $templ, $u,
6707             $ux, $uy, $uz, $vx, $vy, $vz, $inclm, $mm, $xn, $nodem, $xinc,
6708             $xincp, $xl, $xlm, $mp, $xmdf, $xmx, $xmy, $xnoddf, $xnode,
6709             $nodep, $tc, $dndt);
6710 18820         0 my ($mr, $mv, $vkmpersec, $temp4);
6711              
6712 18820         0 my ($iter);
6713             #>>>>trw INCLUDE 'ASTMATH.CMN'
6714              
6715             #* ------------------------ WGS-72 EARTH CONSTANTS ---------------------
6716             #* ---------------------- SET MATHEMATICAL CONSTANTS -------------------
6717              
6718             #>>>>trw X2O3 = 2.0D0/3.0D0
6719             #c Keep compiler ok for warnings on uninitialized variables
6720 18820         35478 $mr= 0;
6721 18820         28194 $coseo1= 1;
6722              
6723 18820         28775 $sineo1= 0;
6724             #>>>>trw CALL getgravconst( whichconst, tumin, mu, radiusearthkm, xke, j2, j3, j4, j3oj2 )
6725 18820         65043 $temp4= 1 + cos(&SGP_PI-1e-09);
6726              
6727 18820         46055 $vkmpersec= $parm->{radiusearthkm}* $parm->{xke}/60;
6728             #* ------------------------- CLEAR SGP4 ERROR FLAG ---------------------
6729              
6730 18820         53566 $self->{model_error}= &SGP4R_ERROR_0;
6731             #* ----------- UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG ---------
6732 18820         39773 $xmdf= $parm->{meananomaly}+ $parm->{mdot}*$t;
6733 18820         35774 $omgadf= $parm->{argumentofperigee}+ $parm->{argpdot}*$t;
6734 18820         34561 $xnoddf= $parm->{ascendingnode}+ $parm->{nodedot}*$t;
6735 18820         30368 $argpm= $omgadf;
6736 18820         28817 $mm= $xmdf;
6737 18820         29116 $t2= $t*$t;
6738 18820         41533 $nodem= $xnoddf+ $parm->{xnodcf}*$t2;
6739 18820         36293 $tempa= 1 - $parm->{cc1}*$t;
6740 18820         46027 $tempe= $self->{bstardrag}*$parm->{cc4}*$t;
6741 18820         44041 $templ= $parm->{t2cof}*$t2;
6742 18820 100       48069 if ( ! $parm->{isimp}) {
6743 85         186 $delomg= $parm->{omgcof}*$t;
6744             $delm= $parm->{xmcof}*(( 1+$parm->{eta}*cos($xmdf)
6745 85         440 )**3-$parm->{delmo});
6746 85         177 $temp= $delomg+ $delm;
6747 85         167 $mm= $xmdf+ $temp;
6748 85         169 $argpm= $omgadf- $temp;
6749 85         173 $t3= $t2*$t;
6750 85         172 $t4= $t3*$t;
6751             $tempa= $tempa- $parm->{d2}*$t2- $parm->{d3}*$t3-
6752 85         286 $parm->{d4}*$t4;
6753             $tempe= $tempe+ $self->{bstardrag}*$parm->{cc5}*(sin($mm) -
6754 85         283 $parm->{sinmao});
6755             $templ= $templ+ $parm->{t3cof}*$t3+ $t4*($parm->{t4cof}+
6756 85         300 $t*$parm->{t5cof});
6757             }
6758 18820         32980 $xn= $parm->{meanmotion};
6759 18820         34364 $eccm= $parm->{eccentricity};
6760 18820         39364 $inclm= $parm->{inclination};
6761 18820 100       44505 if ($parm->{deep_space}) {
6762 397         859 $tc= $t;
6763             $self->_r_dspace ($t, $tc, \$parm->{atime}, \$eccm, \$argpm,
6764 397         3329 \$inclm, \$parm->{xli}, \$mm, \$parm->{xni}, \$nodem,
6765             \$dndt, \$xn);
6766              
6767             }
6768             #c mean motion less than 0.0
6769 18820 50       42362 if ($xn <= 0) {
6770 0         0 $self->{model_error}= &SGP4R_ERROR_2;
6771 0         0 croak "Error - OID $oid ", &SGP4R_ERROR_MEAN_MOTION;
6772             }
6773 18820         73666 $am= ($parm->{xke}/$xn)**&SGP_TOTHRD*$tempa**2;
6774 18820         37814 $xn= $parm->{xke}/$am**1.5;
6775 18820         30812 $eccm= $eccm-$tempe;
6776             $self->{debug}
6777 18820 50       47053 and warn "Debug - OID $oid sgp4r effective eccentricity $eccm\n";
6778             #c fix tolerance for error recognition
6779 18820 100 66     107277 if ($eccm >= 1 || $eccm < -0.001 || $am < 0.95) {
      66        
6780             #c write(6,*) '# Error 1, Eccm = ', Eccm, ' AM = ', AM
6781 4         8 $self->{model_error} = &SGP4R_ERROR_1;
6782 4         6 my $tfmt = '%d-%b-%Y %H:%M:%S';
6783 4         14 my @data = "Error - OID $oid " . &SGP4R_ERROR_MEAN_ECCEN;
6784 4         25 push @data, "eccentricity = $eccm";
6785 4         8 foreach my $thing (qw{universal epoch effective}) {
6786 12 100       81 if (defined ( my $value = $self->can($thing) ?
    100          
6787             $self->$thing() :
6788             $self->get($thing))) {
6789 8         13 local $@ = undef;
6790 8         11 my $diag = eval {
6791 8         27 gm_strftime( "$thing = $tfmt", $value ) };
6792 8 50       22 defined $diag or $diag = "$thing = $value";
6793 8         24 push @data, $diag;
6794             } else {
6795 4         14 push @data, "$thing is undefined";
6796             }
6797             }
6798 4         1092 croak join '; ', @data
6799             }
6800 18816 100       40135 if ($eccm < 0) {
6801 5         9 $eccm= 1e-06
6802             }
6803 18816         38140 $mm= $mm+$parm->{meanmotion}*$templ;
6804 18816         30864 $xlm= $mm+$argpm+$nodem;
6805 18816         31343 $emsq= $eccm*$eccm;
6806 18816         32169 $temp= 1 - $emsq;
6807 18816         69300 $nodem= fmod($nodem, &SGP_TWOPI);
6808 18816         41435 $argpm= fmod($argpm, &SGP_TWOPI);
6809 18816         41669 $xlm= fmod($xlm, &SGP_TWOPI);
6810              
6811 18816         48176 $mm= fmod($xlm- $argpm- $nodem, &SGP_TWOPI);
6812             #* --------------------- COMPUTE EXTRA MEAN QUANTITIES -----------------
6813 18816         40584 $sinim= sin($inclm);
6814              
6815 18816         31247 $cosim= cos($inclm);
6816             #* ------------------------ ADD LUNAR-SOLAR PERIODICS ------------------
6817 18816         37386 $eccp= $eccm;
6818 18816         29471 $xincp= $inclm;
6819 18816         26956 $argpp= $argpm;
6820 18816         27323 $nodep= $nodem;
6821 18816         26530 $mp= $mm;
6822 18816         27755 $sinip= $sinim;
6823 18816         28413 $cosip= $cosim;
6824 18816 100       43641 if ($parm->{deep_space}) {
6825 395         1978 $self->_r_dpper ($t, \$eccp, \$xincp, \$nodep, \$argpp, \$mp);
6826 395 100       1234 if ($xincp < 0) {
6827 26         70 $xincp= -$xincp;
6828 26         72 $nodep= $nodep+ &SGP_PI;
6829 26         84 $argpp= $argpp- &SGP_PI;
6830             }
6831 395 50 33     1944 if ($eccp < 0 || $eccp > 1) {
6832 0         0 $self->{model_error}= &SGP4R_ERROR_3;
6833 0         0 croak "Error - OID $oid ", &SGP4R_ERROR_INST_ECCEN;
6834             }
6835              
6836             }
6837             #* ------------------------ LONG PERIOD PERIODICS ----------------------
6838 18816 100       43357 if ($parm->{deep_space}) {
6839 395         703 $sinip= sin($xincp);
6840 395         783 $cosip= cos($xincp);
6841 395         1161 $parm->{aycof}= -0.5*$parm->{j3oj2}*$sinip;
6842             #c sgp4fix for divide by zero with xincp = 180 deg
6843 395 50       1156 if (abs($cosip+1) > 1.5e-12) {
6844 395         1334 $parm->{xlcof}= -0.25*$parm->{j3oj2}*$sinip*
6845             (3+5*$cosip)/(1+$cosip);
6846             } else {
6847 0         0 $parm->{xlcof}= -0.25*$parm->{j3oj2}*$sinip*
6848             (3+5*$cosip)/$temp4;
6849             }
6850             }
6851 18816         33775 $axnl= $eccp*cos($argpp);
6852 18816         37552 $temp= 1 / ($am*(1-$eccp*$eccp));
6853 18816         50281 $aynl= $eccp*sin($argpp) + $temp*$parm->{aycof};
6854              
6855 18816         41737 $xl= $mp+ $argpp+ $nodep+ $temp*$parm->{xlcof}*$axnl;
6856             #* ------------------------- SOLVE KEPLER'S EQUATION -------------------
6857 18816         52475 $u= fmod($xl-$nodep, &SGP_TWOPI);
6858 18816         29293 $eo1= $u;
6859 18816         30686 $iter=0;
6860             #c sgp4fix for kepler iteration
6861             #c the following iteration needs better limits on corrections
6862 18816         30310 $temp= 9999.9;
6863 18816   66     71625 while (($temp >= 1e-12) && ($iter < 10)) {
6864 56901         91199 $iter=$iter+1;
6865 56901         86654 $sineo1= sin($eo1);
6866 56901         91095 $coseo1= cos($eo1);
6867 56901         92146 $tem5= 1 - $coseo1*$axnl- $sineo1*$aynl;
6868 56901         98680 $tem5= ($u- $aynl*$coseo1+ $axnl*$sineo1- $eo1) / $tem5;
6869 56901         84258 $temp= abs($tem5);
6870 56901 100       115521 if ($temp > 1) {
6871 27         67 $tem5=$tem5/$temp
6872             }
6873 56901         161756 $eo1= $eo1+$tem5;
6874              
6875             }
6876             #* ----------------- SHORT PERIOD PRELIMINARY QUANTITIES ---------------
6877 18816         33618 $ecose= $axnl*$coseo1+$aynl*$sineo1;
6878 18816         29833 $esine= $axnl*$sineo1-$aynl*$coseo1;
6879 18816         30284 $el2= $axnl*$axnl+$aynl*$aynl;
6880 18816         38301 $pl= $am*(1-$el2);
6881             #c semi-latus rectum < 0.0
6882 18816 50       41487 if ( $pl < 0 ) {
6883 0         0 $self->{model_error}= &SGP4R_ERROR_4;
6884 0         0 croak "Error - OID $oid ", &SGP4R_ERROR_LATUSRECTUM;
6885             } else {
6886 18816         29530 $rl= $am*(1-$ecose);
6887 18816         39817 $rdotl= sqrt($am)*$esine/$rl;
6888 18816         29248 $rvdotl= sqrt($pl)/$rl;
6889 18816         34520 $betal= sqrt(1-$el2);
6890 18816         31764 $temp= $esine/(1+$betal);
6891 18816         34303 $sinu= $am/$rl*($sineo1-$aynl-$axnl*$temp);
6892 18816         32487 $cosu= $am/$rl*($coseo1-$axnl+$aynl*$temp);
6893 18816         45310 $su= atan2($sinu, $cosu);
6894 18816         34786 $sin2u= ($cosu+$cosu)*$sinu;
6895 18816         32218 $cos2u= 1-2*$sinu*$sinu;
6896 18816         29396 $temp= 1/$pl;
6897 18816         43817 $temp1= 0.5*$parm->{j2}*$temp;
6898              
6899 18816         34663 $temp2= $temp1*$temp;
6900             #* ------------------ UPDATE FOR SHORT PERIOD PERIODICS ----------------
6901 18816 100       46674 if ($parm->{deep_space}) {
6902 395         749 $cosisq= $cosip*$cosip;
6903 395         917 $parm->{con41}= 3*$cosisq- 1;
6904 395         867 $parm->{x1mth2}= 1 - $cosisq;
6905 395         938 $parm->{x7thm1}= 7*$cosisq- 1;
6906             }
6907             $mr= $rl*(1 - 1.5*$temp2*$betal*$parm->{con41}) +
6908 18816         50090 0.5*$temp1*$parm->{x1mth2}*$cos2u;
6909 18816         41233 $su= $su- 0.25*$temp2*$parm->{x7thm1}*$sin2u;
6910 18816         35928 $xnode= $nodep+ 1.5*$temp2*$cosip*$sin2u;
6911 18816         33912 $xinc= $xincp+ 1.5*$temp2*$cosip*$sinip*$cos2u;
6912 18816         38919 $mv= $rdotl- $xn*$temp1*$parm->{x1mth2}*$sin2u/ $parm->{xke};
6913              
6914             $rvdot= $rvdotl+ $xn*$temp1*
6915 18816         42469 ($parm->{x1mth2}*$cos2u+1.5*$parm->{con41}) / $parm->{xke};
6916             #* ------------------------- ORIENTATION VECTORS -----------------------
6917 18816         34910 $sinsu= sin($su);
6918 18816         31473 $cossu= cos($su);
6919 18816         28304 $snod= sin($xnode);
6920 18816         28926 $cnod= cos($xnode);
6921 18816         28919 $sini= sin($xinc);
6922 18816         28108 $cosi= cos($xinc);
6923 18816         34712 $xmx= -$snod*$cosi;
6924 18816         28705 $xmy= $cnod*$cosi;
6925 18816         30886 $ux= $xmx*$sinsu+ $cnod*$cossu;
6926 18816         28267 $uy= $xmy*$sinsu+ $snod*$cossu;
6927 18816         26902 $uz= $sini*$sinsu;
6928 18816         28755 $vx= $xmx*$cossu- $cnod*$sinsu;
6929 18816         30104 $vy= $xmy*$cossu- $snod*$sinsu;
6930              
6931 18816         31146 $vz= $sini*$cossu;
6932             #* ----------------------- POSITION AND VELOCITY -----------------------
6933 18816         37695 $r[1] = $mr*$ux* $parm->{radiusearthkm};
6934 18816         31956 $r[2] = $mr*$uy* $parm->{radiusearthkm};
6935 18816         31416 $r[3] = $mr*$uz* $parm->{radiusearthkm};
6936 18816         34845 $v[1] = ($mv*$ux+ $rvdot*$vx) * $vkmpersec;
6937 18816         39169 $v[2] = ($mv*$uy+ $rvdot*$vy) * $vkmpersec;
6938 18816         37338 $v[3] = ($mv*$uz+ $rvdot*$vz) * $vkmpersec;
6939              
6940             }
6941             #* --------------------------- ERROR PROCESSING ------------------------
6942             #c sgp4fix for decaying satellites
6943 18816 50       42616 if ($mr < 1) {
6944             #c write(*,*) '# decay condition ',mr
6945 0         0 $self->{model_error}= &SGP4R_ERROR_6;
6946              
6947             }
6948             #c INCLUDE 'debug7.for'
6949              
6950             #>>>>trw RETURN
6951              
6952 18816         86220 $self->__universal( $time );
6953 18816         89299 $self->eci (@r[1..3], @v[1..3]);
6954 18816         82542 $self->equinox_dynamical ($self->{epoch_dynamical});
6955 18816         64808 return $self;
6956             }
6957              
6958             =begin comment
6959              
6960             The following code was converted from the Fortran reference
6961             implementation, but is not used by this code.
6962              
6963             #* -----------------------------------------------------------------------------
6964             #*
6965             #* FUNCTION GSTIME
6966             #*
6967             #* This function finds the Greenwich SIDEREAL time. Notice just the INTEGER
6968             #* part of the Julian Date is used for the Julian centuries calculation.
6969             #* We use radper Solar day because we're multiplying by 0-24 solar hours.
6970             #*
6971             #* Author : David Vallado 719-573-2600 1 Mar 2001
6972             #*
6973             #* Inputs Description Range / Units
6974             #* JD - Julian Date days from 4713 BC
6975             #*
6976             #* OutPuts :
6977             #* GSTIME - Greenwich SIDEREAL Time 0 to 2Pi rad
6978             #*
6979             #* Locals :
6980             #* Temp - Temporary variable for reals rad
6981             #* TUT1 - Julian Centuries from the
6982             #* Jan 1, 2000 12 h epoch (UT1)
6983             #*
6984             #* Coupling :
6985             #*
6986             #* References :
6987             #* Vallado 2007, 194, Eq 3-45
6988             #* -----------------------------------------------------------------------------
6989              
6990             sub _r_gstime {
6991             my ($jd) = @_;
6992             my $gstime;
6993             #* ---------------------------- Locals -------------------------------
6994              
6995             my ($temp, $tut1);
6996             #>>>>trw INCLUDE 'astmath.cmn'
6997              
6998             $tut1= ( $$jd- 2451545 ) / 36525;
6999             $temp= - 6.2e-06*$tut1*$tut1*$tut1+ 0.093104*$tut1*$tut1+
7000             (876600*3600 + 8640184.812866)*$tut1+ 67310.54841;
7001              
7002             $temp= fmod($temp*&SGP_DE2RA/240, &SGP_TWOPI);
7003             if ( $temp < 0 ) {
7004             $temp= $temp+ &SGP_TWOPI;
7005              
7006             }
7007              
7008             $gstime= $temp;
7009             return $gstime;
7010             }
7011              
7012             =end comment
7013              
7014             =cut
7015              
7016             #* -----------------------------------------------------------------------------
7017             #*
7018             #* function getgravconst
7019             #*
7020             #* this function gets constants for the propagator. note that mu is identified to
7021             #* facilitiate comparisons with newer models.
7022             #*
7023             #* author : david vallado 719-573-2600 21 jul 2006
7024             #*
7025             #* inputs :
7026             #* whichconst - which set of constants to use 721, 72, 84
7027             #*
7028             #* outputs :
7029             #* tumin - minutes in one time unit
7030             #* mu - earth gravitational parameter
7031             #* radiusearthkm - radius of the earth in km
7032             #* xke - reciprocal of tumin
7033             #* j2, j3, j4 - un-normalized zonal harmonic values
7034             #* j3oj2 - j3 divided by j2
7035             #*
7036             #* locals :
7037             #*
7038             #* coupling :
7039             #*
7040             #* references :
7041             #* norad spacetrack report #3
7042             #* vallado, crawford, hujsak, kelso 2006
7043             #* ----------------------------------------------------------------------------
7044              
7045             sub _r_getgravconst {
7046 35     35   119 my ($self) = @_;
7047             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
7048 35 50       177 or confess "Programming error - Sgp4r not initialized";
7049              
7050 35 50       145 if ($self->{gravconst_r} == 721) {
7051 0         0 $parm->{radiusearthkm}= 6378.135;
7052 0         0 $parm->{xke}= 0.0743669161;
7053 0         0 $parm->{mu}= 398600.79964;
7054 0         0 $parm->{tumin}= 1 / $parm->{xke};
7055 0         0 $parm->{j2}= 0.001082616;
7056 0         0 $parm->{j3}= -2.53881e-06;
7057 0         0 $parm->{j4}= -1.65597e-06;
7058 0         0 $parm->{j3oj2}= $parm->{j3}/ $parm->{j2};
7059             }
7060              
7061 35 50       119 if ($self->{gravconst_r} == 72) {
7062 35         144 $parm->{mu}= 398600.8;
7063 35         84 $parm->{radiusearthkm}= 6378.135;
7064 35         250 $parm->{xke}= 60 / sqrt($parm->{radiusearthkm}**3/$parm->{mu});
7065 35         98 $parm->{tumin}= 1 / $parm->{xke};
7066 35         91 $parm->{j2}= 0.001082616;
7067 35         138 $parm->{j3}= -2.53881e-06;
7068 35         110 $parm->{j4}= -1.65597e-06;
7069 35         115 $parm->{j3oj2}= $parm->{j3}/ $parm->{j2};
7070             }
7071              
7072 35 50       131 if ($self->{gravconst_r} == 84) {
7073 0         0 $parm->{mu}= 398600.5;
7074 0         0 $parm->{radiusearthkm}= 6378.137;
7075 0         0 $parm->{xke}= 60 / sqrt($parm->{radiusearthkm}**3/$parm->{mu});
7076 0         0 $parm->{tumin}= 1 / $parm->{xke};
7077 0         0 $parm->{j2}= 0.00108262998905;
7078 0         0 $parm->{j3}= -2.53215306e-06;
7079 0         0 $parm->{j4}= -1.61098761e-06;
7080 0         0 $parm->{j3oj2}= $parm->{j3}/ $parm->{j2};
7081              
7082             }
7083 35         73 return;
7084             }
7085              
7086             ##### end of sgp4unit.for
7087              
7088             =begin comment
7089              
7090             # Used for debugging
7091              
7092             sub _r_dump {
7093             my $self = shift;
7094             no warnings qw{uninitialized};
7095             my $parm = $self->{&TLE_INIT}{TLE_sgp4r}
7096             or confess "Programming error - Sgp4r not initialized";
7097             my $fh = IO::File->new('perldump.out', '>>')
7098             or croak "Failed to open perldump.out: $!";
7099             print $fh ' ========== sgp4r initialization', "\n";
7100             print $fh ' SatNum = ', $self->get ('id'), "\n";
7101             print $fh ' ...', "\n";
7102             print $fh ' Bstar = ', $self->{bstardrag}, "\n";
7103             print $fh ' Ecco = ', $parm->{eccentricity}, "\n";
7104             print $fh ' Inclo = ', $parm->{inclination}, "\n";
7105             print $fh ' nodeo = ', $parm->{ascendingnode}, "\n";
7106             print $fh ' Argpo = ', $parm->{argumentofperigee}, "\n";
7107             print $fh ' No = ', $parm->{meanmotion}, "\n";
7108             print $fh ' Mo = ', $parm->{meananomaly}, "\n";
7109             print $fh ' NDot = ', '????', "\n";
7110             print $fh ' NDDot = ', '????', "\n";
7111             print $fh ' alta = ', 'not computed; unused?', "\n";
7112             print $fh ' altp = ', 'not computed; unused?', "\n";
7113             print $fh ' a = ', 'not computed; unused?', "\n";
7114             print $fh ' ...', "\n";
7115             print $fh ' ----', "\n";
7116             print $fh ' Aycof = ', $parm->{aycof}, "\n";
7117             print $fh ' CON41 = ', $parm->{con41}, "\n";
7118             print $fh ' Cc1 = ', $parm->{cc1}, "\n";
7119             print $fh ' Cc4 = ', $parm->{cc4}, "\n";
7120             print $fh ' Cc5 = ', $parm->{cc5}, "\n";
7121             print $fh ' D2 = ', $parm->{d2}, "\n";
7122             print $fh ' D3 = ', $parm->{d3}, "\n";
7123             print $fh ' D4 = ', $parm->{d4}, "\n";
7124             print $fh ' Delmo = ', $parm->{delmo}, "\n";
7125             print $fh ' Eta = ', $parm->{eta}, "\n";
7126             print $fh ' ArgpDot = ', $parm->{argpdot}, "\n";
7127             print $fh ' Omgcof = ', $parm->{omgcof}, "\n";
7128             print $fh ' Sinmao = ', $parm->{sinmao}, "\n";
7129             print $fh ' T2cof = ', $parm->{t2cof}, "\n";
7130             print $fh ' T3cof = ', $parm->{t3cof}, "\n";
7131             print $fh ' T4cof = ', $parm->{t4cof}, "\n";
7132             print $fh ' T5cof = ', $parm->{t5cof}, "\n";
7133             print $fh ' X1mth2 = ', $parm->{x1mth2}, "\n";
7134             print $fh ' MDot = ', $parm->{mdot}, "\n";
7135             print $fh ' nodeDot = ', $parm->{nodedot}, "\n";
7136             print $fh ' Xlcof = ', $parm->{xlcof}, "\n";
7137             print $fh ' Xmcof = ', $parm->{xmcof}, "\n";
7138             print $fh ' Xnodcf = ', $parm->{xnodcf}, "\n";
7139             print $fh ' ----', "\n";
7140             print $fh ' D2201 = ', $parm->{d2201}, "\n";
7141             print $fh ' D2211 = ', $parm->{d2211}, "\n";
7142             print $fh ' D3210 = ', $parm->{d3210}, "\n";
7143             print $fh ' D3222 = ', $parm->{d3222}, "\n";
7144             print $fh ' D4410 = ', $parm->{d4410}, "\n";
7145             print $fh ' D4422 = ', $parm->{d4422}, "\n";
7146             print $fh ' D5220 = ', $parm->{d5220}, "\n";
7147             print $fh ' D5232 = ', $parm->{d5232}, "\n";
7148             print $fh ' D5421 = ', $parm->{d5421}, "\n";
7149             print $fh ' D5433 = ', $parm->{d5433}, "\n";
7150             print $fh ' Dedt = ', $parm->{dedt}, "\n";
7151             print $fh ' Del1 = ', $parm->{del1}, "\n";
7152             print $fh ' Del2 = ', $parm->{del2}, "\n";
7153             print $fh ' Del3 = ', $parm->{del3}, "\n";
7154             print $fh ' Didt = ', $parm->{didt}, "\n";
7155             print $fh ' Dmdt = ', $parm->{dmdt}, "\n";
7156             print $fh ' Dnodt = ', $parm->{dnodt}, "\n";
7157             print $fh ' Domdt = ', $parm->{domdt}, "\n";
7158             print $fh ' E3 = ', $parm->{e3}, "\n";
7159             print $fh ' Ee2 = ', $parm->{ee2}, "\n";
7160             print $fh ' Peo = ', $parm->{peo}, "\n";
7161             print $fh ' Pgho = ', $parm->{pgho}, "\n";
7162             print $fh ' Pho = ', $parm->{pho}, "\n";
7163             print $fh ' Pinco = ', $parm->{pinco}, "\n";
7164             print $fh ' Plo = ', $parm->{plo}, "\n";
7165             print $fh ' Se2 = ', $parm->{se2}, "\n";
7166             print $fh ' Se3 = ', $parm->{se3}, "\n";
7167             print $fh ' Sgh2 = ', $parm->{sgh2}, "\n";
7168             print $fh ' Sgh3 = ', $parm->{sgh3}, "\n";
7169             print $fh ' Sgh4 = ', $parm->{sgh4}, "\n";
7170             print $fh ' Sh2 = ', $parm->{sh2}, "\n";
7171             print $fh ' Sh3 = ', $parm->{sh3}, "\n";
7172             print $fh ' Si2 = ', $parm->{si2}, "\n";
7173             print $fh ' Si3 = ', $parm->{si3}, "\n";
7174             print $fh ' Sl2 = ', $parm->{sl2}, "\n";
7175             print $fh ' Sl3 = ', $parm->{sl3}, "\n";
7176             print $fh ' Sl4 = ', $parm->{sl4}, "\n";
7177             print $fh ' GSTo = ', $parm->{gsto}, "\n";
7178             print $fh ' Xfact = ', $parm->{xfact}, "\n";
7179             print $fh ' Xgh2 = ', $parm->{xgh2}, "\n";
7180             print $fh ' Xgh3 = ', $parm->{xgh3}, "\n";
7181             print $fh ' Xgh4 = ', $parm->{xgh4}, "\n";
7182             print $fh ' Xh2 = ', $parm->{xh2}, "\n";
7183             print $fh ' Xh3 = ', $parm->{xh3}, "\n";
7184             print $fh ' Xi2 = ', $parm->{xi2}, "\n";
7185             print $fh ' Xi3 = ', $parm->{xi3}, "\n";
7186             print $fh ' Xl2 = ', $parm->{xl2}, "\n";
7187             print $fh ' Xl3 = ', $parm->{xl3}, "\n";
7188             print $fh ' Xl4 = ', $parm->{xl4}, "\n";
7189             print $fh ' Xlamo = ', $parm->{xlamo}, "\n";
7190             print $fh ' Zmol = ', $parm->{zmol}, "\n";
7191             print $fh ' Zmos = ', $parm->{zmos}, "\n";
7192             print $fh ' Atime = ', $parm->{atime}, "\n";
7193             print $fh ' Xli = ', $parm->{xli}, "\n";
7194             print $fh ' Xni = ', $parm->{xni}, "\n";
7195             print $fh ' IRez = ', $parm->{irez}, "\n";
7196             print $fh ' Isimp = ', $parm->{isimp}, "\n";
7197             print $fh ' Init = ', $parm->{init}, "\n";
7198             print $fh ' Method = ', ($parm->{deep_space} ? 'd' : 'n'), "\n";
7199             return;
7200             }
7201              
7202             =end comment
7203              
7204             =cut
7205              
7206             # Elevation of the illuminating body as seen from the satellite at the
7207             # given time.
7208             sub __sun_elev_from_sat {
7209 917     917   2145 my ( $self, $time ) = @_;
7210 917 100       1970 if ( defined $time ) {
7211 916         2768 $self->universal( $time );
7212             } else {
7213 1         4 $time = $self->universal();
7214             }
7215 917         3057 return ( $self->azel_offset(
7216             $self->get( 'illum' )->universal( $time ),
7217             $self->get( 'edge_of_earths_shadow' ),
7218             ) )[1] - $self->dip();
7219             }
7220              
7221             =item $text = $tle->tle_verbose(...);
7222              
7223             This method returns a verbose version of the TLE data, with one data
7224             field per line, labeled. The optional arguments are key-value pairs
7225             affecting the formatting of the output. The only key implemented at the
7226             moment is
7227              
7228             date_format
7229             specifies the strftime() format used for dates
7230             (default: '%d-%b-%Y %H:%M:%S').
7231              
7232             =cut
7233              
7234             sub tle_verbose {
7235 0     0 1 0 my ($self, %args) = @_;
7236 0   0     0 my $dtfmt = $args{date_format} || '%d-%b-%Y %H:%M:%S';
7237 0         0 my $epoch = __format_epoch_time_usec( $self->get( 'epoch' ), $dtfmt );
7238 0         0 my $semimajor = $self->get('semimajor'); # Of reference ellipsoid.
7239              
7240 0         0 my $result = <
7241 0         0 NORAD ID: @{[$self->get ('id')]}
7242 0   0     0 Name: @{[$self->get ('name') || 'unspecified']}
7243 0         0 International launch designator: @{[$self->get ('international')]}
7244             Epoch of data: $epoch GMT
7245             EOD
7246 0 0       0 if (defined (my $effective = $self->get('effective'))) {
7247 0         0 $result .= <
7248 0         0 Effective date: @{[ gm_strftime $dtfmt, $effective]} GMT
7249             EOD
7250             }
7251 0         0 $result .= <
7252 0         0 Classification status: @{[$self->get ('classification')]}
7253 0         0 Mean motion: @{[rad2deg ($self->get ('meanmotion'))]} degrees/minute
7254 0         0 First derivative of motion: @{[rad2deg ($self->get ('firstderivative'))]} degrees/minute squared
7255 0         0 Second derivative of motion: @{[rad2deg ($self->get ('secondderivative'))]} degrees/minute cubed
7256 0         0 B Star drag term: @{[$self->get ('bstardrag')]}
7257 0         0 Ephemeris type: @{[$self->get ('ephemeristype')]}
7258 0         0 Inclination of orbit: @{[rad2deg ($self->get ('inclination'))]} degrees
7259 0         0 Right ascension of ascending node: @{[rad2deg ($self->get ('ascendingnode'))]} degrees
7260 0         0 Eccentricity: @{[$self->get ('eccentricity')]}
7261 0         0 Argument of perigee: @{[rad2deg ($self->get ('argumentofperigee'))]} degrees from ascending node
7262 0         0 Mean anomaly: @{[rad2deg ($self->get ('meananomaly'))]} degrees
7263 0         0 Element set number: @{[$self->get ('elementnumber')]}
7264 0         0 Revolutions at epoch: @{[$self->get ('revolutionsatepoch')]}
7265 0         0 Period (derived): @{[$self->period()]} seconds
7266 0         0 Semimajor axis (derived): @{[$self->semimajor()]} kilometers
7267 0         0 Altitude at perigee (derived): @{[$self->periapsis() - $semimajor]} kilometers
7268 0         0 Altitude at apogee (derived): @{[$self->apoapsis() - $semimajor]} kilometers
7269             EOD
7270 0         0 return $result;
7271             }
7272              
7273             =item $hash_ref = $tle->TO_JSON();
7274              
7275             Despite its name, this method B convert the object to JSON.
7276             What it does instead is to return a reference to a hash that the
7277             L class will use to encode the object into JSON. The possible
7278             keys are, to the extent possible, those used by the Space Track REST
7279             interface.
7280              
7281             In order to get L to use this hook you need to instantiate a
7282             L object and turn on the conversion of blessed objects, like
7283             so:
7284              
7285             my $json = JSON->new()->convert_blessed( 1 );
7286             print $json->encode( $tle );
7287              
7288             The returned keys are a mish-mash of the keys returned by the Space
7289             Track C and C classes, plus others that are not maintained
7290             by Space Track. Since the Space Track keys are all upper case, I have
7291             made the non-Space Track keys all lower case.
7292              
7293             At this point I am not going to document the keys returned by this
7294             method, but they are generally self-explanatory. I find the most cryptic
7295             one is C<{INTLDES}>, which is the International Launch Designator,
7296             encoded with a four-digit year.
7297              
7298             =cut
7299              
7300             {
7301              
7302             my %json_map = (
7303             ARG_OF_PERICENTER => sub {
7304             my ( $self ) = @_;
7305             return rad2deg( $self->get( 'argumentofperigee' ) );
7306             },
7307             BSTAR => 'bstardrag',
7308             CLASSIFICATION_TYPE => 'classification',
7309             COMMENT => sub {
7310             return 'Generated by ' . __PACKAGE__ . ' v' . $VERSION;
7311             },
7312             CREATION_DATE => sub {
7313             return format_space_track_json_time( time );
7314             },
7315             ECCENTRICITY => 'eccentricity',
7316             ELEMENT_SET_NO => 'elementnumber',
7317             EPHEMERIS_TYPE => 'ephemeristype',
7318             EPOCH => sub {
7319             my ( $self ) = @_;
7320             return format_space_track_json_time( $self->get( 'epoch' ) );
7321             },
7322             EPOCH_MICROSECONDS => sub {
7323             my ( $self ) = @_;
7324             my $epoch = sprintf '%.6f', $self->get( 'epoch' );
7325             $epoch =~ s/ [^.]* [.] //smx;
7326             return $epoch;
7327             },
7328             FILE => 'file',
7329             INCLINATION => sub {
7330             my ( $self ) = @_;
7331             return rad2deg( $self->get( 'inclination' ) );
7332             },
7333             INTLDES => sub {
7334             my ( $self ) = @_;
7335             my $year = $self->get( 'launch_year' );
7336             my $num = $self->get( 'launch_num' );
7337             my $part = $self->get( 'launch_piece' );
7338             # As of August 27 2012, this is no longer yyyy-lllp, it is
7339             # yylllp, same as it has always been in the TLE format.
7340             $year %= 100;
7341             foreach ( $year, $num, $part ) {
7342             defined $_
7343             and $_ =~ m/ \S /smx
7344             or return;
7345             }
7346             return sprintf '%02d%03d%s', $year, $num, $part; # ditto
7347             },
7348             LAUNCH_NUM => 'launch_num',
7349             LAUNCH_PIECE => 'launch_piece',
7350             LAUNCH_YEAR => 'launch_year',
7351             MEAN_ANOMALY => sub {
7352             my ( $self ) = @_;
7353             return rad2deg( $self->get( 'meananomaly' ) );
7354             },
7355             MEAN_MOTION => sub {
7356             my ( $self ) = @_;
7357             return $self->get( 'meanmotion' ) * SGP_XMNPDA / TWOPI;
7358             },
7359             MEAN_MOTION_DDOT => sub {
7360             my ( $self ) = @_;
7361             return $self->get(
7362             'secondderivative'
7363             ) * SGP_XMNPDA * SGP_XMNPDA * SGP_XMNPDA / TWOPI;
7364             },
7365             MEAN_MOTION_DOT => sub {
7366             my ( $self ) = @_;
7367             return $self->get(
7368             'firstderivative'
7369             ) * SGP_XMNPDA * SGP_XMNPDA / TWOPI;
7370             },
7371             NORAD_CAT_ID => 'id',
7372             OBJECT_ID => sub {
7373             my ( $self ) = @_;
7374             my $year = $self->get( 'launch_year' );
7375             my $num = $self->get( 'launch_num' );
7376             my $part = $self->get( 'launch_piece' );
7377             foreach ( $year, $num, $part ) {
7378             defined $_
7379             and $_ =~ m/ \S /smx
7380             or return;
7381             }
7382             return sprintf '%04d-%03d%s', $year, $num, $part;
7383             },
7384             OBJECT_NAME => 'name',
7385             OBJECT_NUMBER => 'id',
7386             OBJECT_TYPE => sub {
7387             my ( $self ) = @_;
7388             return uc $self->body_type();
7389             },
7390             ORDINAL => 'ordinal',
7391             ORIGINATOR => 'originator',
7392             RA_OF_ASC_NODE => sub {
7393             my ( $self ) = @_;
7394             return rad2deg( $self->get( 'ascendingnode' ) );
7395             },
7396             RCSVALUE => 'rcs',
7397             REV_AT_EPOCH => 'revolutionsatepoch',
7398             # TLE_LINE0 => sub {
7399             # my ( $self ) = @_;
7400             # my $name = $self->get( 'name' );
7401             # defined $name
7402             # and $name = "0 $name";
7403             # return $name;
7404             # },
7405             # TLE_LINE0 is handled programmatically
7406             # TLE_LINE1 is handled programmatically
7407             # TLE_LINE2 is handled programmatically
7408             effective_date => sub {
7409             my ( $self ) = @_;
7410             return format_space_track_json_time( $self->get( 'effective' ) );
7411             },
7412             intrinsic_magnitude => 'intrinsic_magnitude',
7413             );
7414              
7415             # This guy is to be used by subclasses so they don't have to
7416             # implement their own converter. The arguments (after the invocant)
7417             # are a reference to the mapping hash and an optional reference to
7418             # a hash to populate. The return is a hash reference, which will be
7419             # the one provided if there _was_ one provided.
7420              
7421             # The mapping hash's keys are the keys to be provided in the output.
7422             # The values are either the Astro::Coord::ECI::TLE attributes
7423             # corresponding to those keys, or a code reference which computes
7424             # the value. If a code reference, it is called with the invocant and
7425             # the JSON key. No matter where they come from, values which are
7426             # undef or '' will not appear in the output hash.
7427              
7428             sub __to_json {
7429 0     0   0 my ( $self, $mapping, $rslt ) = @_;
7430 0   0     0 $rslt ||= {};
7431              
7432 0         0 foreach my $key ( keys %{ $mapping } ) {
  0         0  
7433 0         0 my $map = $mapping->{$key};
7434 0 0       0 my $val = CODE_REF eq ref $map ?
7435             $map->( $self, $key ) :
7436             $self->get( $map );
7437             defined $val
7438             and $val ne ''
7439 0 0 0     0 and $rslt->{$key} = $val;
7440             }
7441              
7442 0 0       0 if ( defined ( my $tle = $self->get( 'tle' ) ) ) {
7443 0         0 chomp $tle;
7444 0         0 my @lines = split "\n", $tle;
7445 0         0 unshift @lines, '' while @lines < 3;
7446 0         0 foreach my $line ( 1 .. 2 ) {
7447             defined $lines[$line]
7448             and $lines[$line] =~ m/ \S /smx
7449 0 0 0     0 and $rslt->{"TLE_LINE$line"} = $lines[$line];
7450             }
7451 0 0       0 if ( defined( my $name = $self->get( 'name' ) ) ) {
7452 0         0 $rslt->{TLE_LINE0} = "0 $name";
7453             }
7454             }
7455              
7456 0         0 return $rslt;
7457             }
7458              
7459             sub TO_JSON {
7460 0     0 1 0 my ( $self ) = @_;
7461 0         0 return $self->__to_json( \%json_map );
7462             }
7463              
7464             }
7465              
7466             {
7467             my $have_json;
7468             my @required = qw{
7469             NORAD_CAT_ID
7470             EPOCH
7471             MEAN_MOTION
7472             ECCENTRICITY
7473             INCLINATION
7474             RA_OF_ASC_NODE
7475             ARG_OF_PERICENTER
7476             MEAN_ANOMALY
7477             EPHEMERIS_TYPE
7478             CLASSIFICATION_TYPE
7479             ELEMENT_SET_NO
7480             REV_AT_EPOCH
7481             BSTAR
7482             MEAN_MOTION_DOT
7483             MEAN_MOTION_DDOT
7484             };
7485             my %json_map = (
7486             # INTLDES => 'international',
7487             NORAD_CAT_ID => 'id',
7488             OBJECT_NAME => 'name',
7489             # OBJECT_ID => 'international',
7490             RCSVALUE => 'rcs',
7491             # LAUNCH_YEAR => 'launch_year',
7492             # LAUNCH_NUM => 'launch_num',
7493             # LAUNCH_PIECE => 'launch_piece',
7494             # COMMENT => sub {
7495             # return 'Generated by ' . __PACKAGE__ . ' v' . $VERSION;
7496             # },
7497             # CREATION_DATE => sub {
7498             # return format_space_track_json_time( time );
7499             # },
7500             EPOCH => 'epoch',
7501             FILE => 'file',
7502             MEAN_MOTION => 'meanmotion',
7503             ECCENTRICITY => 'eccentricity',
7504             INCLINATION => 'inclination',
7505             RA_OF_ASC_NODE => 'ascendingnode',
7506             ARG_OF_PERICENTER => 'argumentofperigee',
7507             MEAN_ANOMALY => 'meananomaly',
7508             EPHEMERIS_TYPE => 'ephemeristype',
7509             CLASSIFICATION_TYPE => 'classification',
7510             ELEMENT_SET_NO => 'elementnumber',
7511             REV_AT_EPOCH => 'revolutionsatepoch',
7512             BSTAR => 'bstardrag',
7513             MEAN_MOTION_DOT => 'firstderivative',
7514             MEAN_MOTION_DDOT => 'secondderivative',
7515             OBJECT_TYPE => 'object_type',
7516             ORDINAL => 'ordinal',
7517             ORIGINATOR => 'originator',
7518             effective_date => 'effective',
7519             intrinsic_magnitude => 'intrinsic_magnitude',
7520             );
7521              
7522             sub _decode_json_time {
7523 0     0   0 my ( $string ) = @_;
7524 0 0       0 $string =~ m{ \A \s*
7525             ( [0-9]+ ) [^0-9]+ ( [0-9]+ ) [^0-9]+ ( [0-9]+ ) [^0-9]+
7526             ( [0-9]+ ) [^0-9]+ ( [0-9]+ ) [^0-9]+ ( [0-9]+ )
7527             (?: ( [.] [0-9]* ) )?
7528             \s* \z }smx
7529             or return;
7530 0         0 my @time = ( $1, $2, $3, $4, $5, $6 );
7531 0         0 my $frac = $7;
7532 0         0 $time[0] = __tle_year_to_Gregorian_year( $time[0] );
7533 0         0 $time[1] -= 1;
7534 0         0 my $rslt = greg_time_gm( reverse @time );
7535 0 0 0     0 defined $frac
7536             and $frac ne '.'
7537             and $rslt += $frac;
7538 0         0 return $rslt;
7539             }
7540              
7541             sub _parse_json {
7542 0     0   0 my ( undef, @args ) = @_; # Invocant unused
7543             defined $have_json
7544 0 0       0 or $have_json = eval {
    0          
7545 0         0 require JSON;
7546 0         0 1;
7547             } ? 1 : 0;
7548 0 0       0 $have_json
7549             or croak 'Can not load JSON';
7550 0         0 my $json = JSON->new()->utf8( 1 );
7551 0 0       0 my $attrs = HASH_REF eq ref $args[0] ? shift @args : {};
7552 0         0 my @rslt;
7553              
7554 0         0 foreach my $arg ( @args ) {
7555 0         0 my $decode = $json->decode( $arg );
7556              
7557 0 0       0 foreach my $hash ( ARRAY_REF eq ref $decode ? @{ $decode } :
  0         0  
7558             $decode ) {
7559              
7560 0   0     0 my $class = $hash->{astro_coord_eci_class} || __PACKAGE__;
7561 0         0 load_module( $class );
7562 0         0 push @rslt, $class->__from_json( $hash, $attrs );
7563              
7564             }
7565             }
7566              
7567 0         0 return @rslt;
7568             }
7569              
7570             sub __from_json {
7571 0     0   0 my ( $class, $hash, $attrs ) = @_;
7572              
7573 0   0     0 $attrs ||= {};
7574              
7575 0 0       0 if ( exists $hash->{SATNAME} ) { # TODO Deprecated
7576 0 0       0 warnings::enabled( 'deprecated' )
7577             and croak 'The SATNAME JSON key is deprecated ',
7578             'in favor of the OBJECT_NAME key';
7579             exists $hash->{OBJECT_NAME}
7580 0 0       0 or $hash->{OBJECT_NAME} = $hash->{SATNAME};
7581 0         0 delete $hash->{SATNAME};
7582             }
7583              
7584 0         0 foreach my $key ( @required ) {
7585 0 0       0 defined $hash->{$key}
7586             or return;
7587             }
7588              
7589             defined $hash->{INTLDES}
7590             and $hash->{INTLDES} =~
7591 0 0       0 s/ \A [0-9]{2} ( [0-9]{2} ) - /$1/smx;
7592              
7593 0         0 foreach my $key ( qw{ EPOCH effective_date } ) {
7594             defined $hash->{$key}
7595 0 0       0 and $hash->{$key} = _decode_json_time( $hash->{$key} );
7596             }
7597             defined $hash->{EPOCH_MICROSECONDS}
7598             and $hash->{EPOCH} += $hash->{EPOCH_MICROSECONDS} /
7599 0 0       0 1_000_000;
7600              
7601 0         0 foreach my $key ( qw{
7602             ARG_OF_PERICENTER INCLINATION MEAN_ANOMALY
7603             RA_OF_ASC_NODE
7604             } ) {
7605 0         0 $hash->{$key} *= SGP_DE2RA;
7606             }
7607              
7608             {
7609 0         0 my $temp = SGP_TWOPI;
  0         0  
7610 0         0 foreach my $key ( qw{
7611             MEAN_MOTION MEAN_MOTION_DOT MEAN_MOTION_DDOT
7612             } ) {
7613 0         0 $temp /= SGP_XMNPDA;
7614 0         0 $hash->{$key} *= $temp;
7615             }
7616             }
7617              
7618 0         0 my %tle = %{ $attrs };
  0         0  
7619 0         0 foreach my $key ( keys %{ $hash } ) {
  0         0  
7620 0         0 my $value = $hash->{$key};
7621 0 0       0 my $attr = $json_map{$key}
7622             or next;
7623 0         0 $tle{$attr} = $value;
7624             }
7625              
7626 0         0 my $obj = $class->new( %tle );
7627              
7628 0         0 foreach my $key ( qw{ OBJECT_ID INTLDES } ) {
7629 0 0       0 defined $hash->{$key}
7630             or next;
7631 0         0 $obj->_set_intldes( international => $hash->{$key} );
7632 0         0 last;
7633             }
7634              
7635 0         0 return $obj;
7636             }
7637             }
7638              
7639             =item $valid = $tle->validate($options, $time ...);
7640              
7641             This method checks to see if the currently-selected model can be run
7642             successfully. If so, it returns 1; if not, it returns 0.
7643              
7644             The $options argument is itself optional. If passed, it is a reference
7645             to a hash of option names and values. At the moment the only option used
7646             is
7647              
7648             quiet => 1 to suppress output to STDERR.
7649              
7650             If the C option is not specified, or is specified as a false
7651             value, validation failures will produce output to STDERR.
7652              
7653             Each $time argument is adjusted by passing it through C<<
7654             $tle->max_effective_date >>, and the distinct adjusted times are sorted
7655             into ascending order. The currently-selected model is run at each of the
7656             times thus computed. The return is 0 if any run fails, or 1 if they all
7657             succeed.
7658              
7659             If there are no $time arguments, the model is run at the effective date
7660             if that is specified, or the epoch if the effective date is not
7661             specified.
7662              
7663             =cut
7664              
7665             sub validate {
7666 0     0 1 0 my ($self, @args) = @_;
7667 0 0       0 my $opt = HASH_REF eq ref $args[0] ? shift @args : {};
7668 0         0 my %args;
7669 0 0       0 if (@args) {
7670 0         0 %args = map { ( $self->max_effective_date( $_ ) => 1 ) } @args;
  0         0  
7671             } else {
7672 0   0     0 $args{$self->get('effective') || $self->get('epoch')} = 1;
7673             }
7674 0 0       0 eval {
7675 0         0 foreach my $time ( sort { $a <=> $b } keys %args ) {
  0         0  
7676 0         0 $self->universal( $time );
7677             }
7678 0         0 1;
7679             } and return 1;
7680 0 0 0     0 $opt->{quiet} or $@ and warn $@;
7681 0         0 return 0;
7682             }
7683              
7684             #######################################################################
7685              
7686             # _actan
7687              
7688             # This function wraps the atan2 function, and normalizes the
7689             # result to the range 0 < result < 2 * pi.
7690              
7691             sub _actan {
7692 29     29   142 my $rslt = atan2 ($_[0], $_[1]);
7693 29 100       98 $rslt < 0 and $rslt += SGP_TWOPI;
7694 29         85 return $rslt;
7695             }
7696              
7697             # _convert_out
7698              
7699             # Convert model results to kilometers and kilometers per second.
7700              
7701             sub _convert_out {
7702 25     25   85 my ($self, @args) = @_;
7703 25         48 $args[0] *= (SGP_XKMPER / SGP_AE); # x
7704 25         62 $args[1] *= (SGP_XKMPER / SGP_AE); # y
7705 25         44 $args[2] *= (SGP_XKMPER / SGP_AE); # z
7706 25         42 $args[3] *= (SGP_XKMPER / SGP_AE * SGP_XMNPDA / SECSPERDAY); # dx/dt
7707 25         40 $args[4] *= (SGP_XKMPER / SGP_AE * SGP_XMNPDA / SECSPERDAY); # dy/dt
7708 25         38 $args[5] *= (SGP_XKMPER / SGP_AE * SGP_XMNPDA / SECSPERDAY); # dz/dt
7709 25         143 $self->__universal( pop @args );
7710 25         123 $self->eci (@args);
7711              
7712 25         216 $self->equinox_dynamical ($self->{epoch_dynamical});
7713              
7714 25         151 return $self;
7715             }
7716              
7717             # Called by pass() to find the illumination. The arguments are the sun
7718             # object (or nothing), the time, and a reference to the pass information
7719             # hash. The return is either nothing (if $sun is not defined) or
7720             # ( illumination => $illum ).
7721             sub _find_illumination {
7722 42     42   122 my ( $sun, $when, $info ) = @_;
7723 42 100       146 $sun
7724             or return;
7725 39         114 my $illum = $info->[0]{illumination};
7726 39         69 foreach my $evt ( @{ $info } ) {
  39         94  
7727 96 100       243 $evt->{time} > $when
7728             and last;
7729 58         119 $illum = $evt->{illumination};
7730             }
7731 39         244 return ( illumination => $illum );
7732             }
7733              
7734             # Called by pass() to calculate azimuth, elevation, and range. The
7735             # arguments are the TLE object, the station object, and the time. If the
7736             # TLE's 'lazy_pass_position' attribute is true, nothing is returned.
7737             # Otherwise the azimuth, elevation, and range are calculated and
7738             # returned as three name/value pairs (i.e. a six-element list).
7739             sub _find_position {
7740 30     30   66 my ( $tle, $sta, $when ) = @_;
7741 30 100       75 $tle->get( 'lazy_pass_position' )
7742             and return;
7743 15         69 $tle->universal( $when );
7744 15         60 my ( $azimuth, $elevation, $range ) = $sta->azel( $tle );
7745             return (
7746 15         283 azimuth => $azimuth,
7747             elevation => $elevation,
7748             range => $range,
7749             );
7750             }
7751              
7752             # Initial value of the 'inertial' attribute. TLEs are assumed to be
7753             # inertial until set otherwise.
7754              
7755 64     64   348 sub __initial_inertial{ return 1 };
7756              
7757             # Unsupported, experimental, and subject to change or retraction without
7758             # notice. The intent is to provide a way for the Astro::App::Satpass2
7759             # 'list' command to pick an appropriate template to format each line of
7760             # the listing based on the object being listed.
7761             sub __list_type {
7762 3     3   5 my ( $self ) = @_;
7763 3 100       16 return $self->{inertial} ? 'inertial' : 'fixed';
7764             }
7765              
7766             # _looks_like_real
7767             #
7768             # This returns a boolean which is true if the input looks like a real
7769             # number and is false otherwise. It is based on looks_like_number, but
7770             # excludes things like NaN, and Inf.
7771             sub _looks_like_real {
7772 3     3   6 my ( $number ) = @_;
7773 3 50       10 looks_like_number( $number )
7774             or return;
7775 3 50       22 $number =~ m/ \A nan \z /smxi
7776             and return;
7777 3 50       16 $number =~ m/ \A [+-]? inf (?: inity )? \z /smxi
7778             and return;
7779 3         8 return 1;
7780             }
7781              
7782             # *equinox_dynamical = \&Astro::Coord::ECI::equinox_dynamical;
7783              
7784             # $text = $self->_make_tle();
7785             #
7786             # This method manufactures a TLE. It's a 'real' TLE if the 'name'
7787             # attribute is not set, and a 'NASA' TLE (i.e. the 'T' stands for
7788             # 'three') if the 'name' attribute is set. The output is intended
7789             # to be equivalent to the TLE (if any) that initialized the
7790             # object, not identical to it. This method is used to manufacture
7791             # a TLE in the case where $self->get('tle') was called but the
7792             # object was not initialized by the parse() method.
7793              
7794             {
7795              
7796             my %hack = (
7797             effective => sub {
7798             ## my ( $self, $name, $value ) = @_;
7799             my ( undef, undef, $value ) = @_; # Invocant & name unused
7800             my $whole = floor($value);
7801             my ($sec, $min, $hr, undef, undef, $year, undef, $yday) =
7802             gmtime $value;
7803             my $effective =
7804             sprintf '%04d/%03d/%02d:%02d:%06.3f',
7805             $year + 1900, $yday + 1, $hr, $min,
7806             $sec + ($value - $whole);
7807             $effective =~ s/ [.]? 0+ \z //smx;
7808             return ( '--effective', $effective );
7809             },
7810             rcs => sub {
7811             ## my ( $self, $name, $value ) = @_;
7812             my ( undef, undef, $value ) = @_; # Invocant & name unused
7813             return ( '--rcs', $value );
7814             },
7815             );
7816              
7817             my @required_fields = qw{
7818             firstderivative secondderivative bstardrag inclination
7819             ascendingnode eccentricity argumentofperigee meananomaly
7820             meanmotion revolutionsatepoch
7821             };
7822              
7823             sub _make_tle {
7824 0     0   0 my $self = shift;
7825 0         0 my $output;
7826              
7827 0         0 my $oid = $self->get('id');
7828 0         0 my $name = $self->get( 'name' );
7829 0         0 my @line0;
7830              
7831 0 0       0 if ( defined $name ) {
7832 0         0 $name =~ s/ \s+ \z //smx;
7833 0 0       0 $name ne ''
7834             and push @line0, substr $name, 0, 24;
7835             }
7836              
7837 0 0       0 if ( my $code = $self->can( '__encode_operational_status' ) ) {
7838 0         0 push @line0, sprintf '[%s]', $code->( $self, 'status' );
7839             }
7840              
7841 0         0 foreach my $name ( sort keys %hack ) {
7842 0 0       0 defined( my $value = $self->get( $name ) ) or next;
7843 0         0 push @line0, $hack{$name}->( $self, $name, $value );
7844             }
7845 0 0       0 @line0 and $output .= join (' ', @line0) . "\n";
7846              
7847 0         0 my %ele;
7848             {
7849 0         0 my @missing_fields;
  0         0  
7850 0         0 foreach ( @required_fields ) {
7851 0 0       0 defined( $ele{$_} = $self->get( $_ ) )
7852             and next;
7853 0         0 push @missing_fields, $_;
7854             }
7855              
7856 0 0       0 if ( @missing_fields ) {
7857             # If all required fields are missing we presume it is
7858             # deliberate, and return nothing.
7859 0 0       0 @required_fields == @missing_fields
7860             and return undef; ## no critic (ProhibitExplicitReturnUndef)
7861             # Otherwise we croak with an error
7862 0 0       0 croak 'Can not generate TLE for ',
7863             defined $oid ? $oid : $name,
7864             '; undefined attribute(s) ',
7865             join ', ', @missing_fields;
7866             }
7867 0         0 my $temp = SGP_TWOPI;
7868 0         0 foreach (qw{meanmotion firstderivative secondderivative}) {
7869 0         0 $temp /= SGP_XMNPDA;
7870 0         0 $ele{$_} /= $temp;
7871             }
7872 0         0 foreach (qw{ascendingnode argumentofperigee meananomaly
7873             inclination}) {
7874 0         0 $ele{$_} /= SGP_DE2RA;
7875             }
7876 0         0 foreach my $key (qw{eccentricity}) {
7877 0         0 local $_ = sprintf '%.7f', $ele{$key};
7878 0         0 s/.*?\.//;
7879 0         0 $ele{$key} = $_;
7880             }
7881 0         0 $ele{epoch} = $self->__make_tle_epoch();
7882             $ele{firstderivative} = sprintf (
7883 0         0 '%.8f', $ele{firstderivative});
7884 0         0 $ele{firstderivative} =~ s/([-+]?)[\s0]*\./$1./;
7885 0         0 foreach my $key (qw{secondderivative bstardrag}) {
7886 0 0       0 if ($ele{$key}) {
7887 0         0 local $_ = sprintf '%.4e', $ele{$key};
7888 0         0 s/\.//;
7889 0         0 my ($mantissa, $exponent) = split 'e', $_;
7890 0         0 $exponent++;
7891 0         0 $ele{$key} = sprintf '%s%+1d', $mantissa, $exponent;
7892             } else {
7893 0         0 $ele{$key} = '00000-0';
7894             }
7895             }
7896             }
7897             $output .= _make_tle_checksum ('1%6s%s %-8s %-14s %10s %8s %8s %s %4s',
7898             $oid, $self->get('classification'),
7899             $self->get('international'),
7900 0         0 ( map { $ele{$_} } qw{ epoch firstderivative
  0         0  
7901             secondderivative bstardrag} ),
7902             $self->get('ephemeristype'), $self->get('elementnumber'),
7903             );
7904             $output .= _make_tle_checksum ('2%6s%9.4f%9.4f %-7s%9.4f%9.4f%12.8f%5s',
7905 0         0 $oid, ( map { $ele{$_} } qw{ inclination ascendingnode
  0         0  
7906             eccentricity argumentofperigee meananomaly meanmotion
7907             revolutionsatepoch } ),
7908             );
7909 0         0 return $output;
7910             }
7911             }
7912              
7913             sub __make_tle_epoch {
7914 0     0   0 my ( $self ) = @_;
7915 0         0 my $raw_epoch = $self->get( 'epoch' );
7916 0         0 my $cooked_epoch = floor( $raw_epoch );
7917 0         0 my ( $sec, $min, $hr, undef, undef, $year, undef, $yday ) =
7918             gmtime $cooked_epoch;
7919 0         0 my $epoch_dayfrac = ( ( $hr * 60 + $min ) * 60 + $sec + $raw_epoch -
7920             $cooked_epoch ) / SECSPERDAY;
7921 0         0 return sprintf '%02d%03d.%08d', $year % 100, $yday + 1,
7922             $epoch_dayfrac * 100_000_000 + 0.5;
7923             }
7924              
7925             # $output = _make_tle_checksum($fmt ...);
7926             #
7927             # This subroutine calls sprintf using the first argument as a
7928             # format and the rest as arguments. It then computes the TLE-style
7929             # checksum, appends it to the output, slaps a newline on the end
7930             # of the whole thing, and returns it.
7931              
7932             sub _make_tle_checksum {
7933 0     0   0 my ($fmt, @args) = @_;
7934 0         0 my $buffer = sprintf $fmt, @args;
7935 0         0 my $sum = 0;
7936 0         0 foreach (split '', $buffer) {
7937 0 0       0 if ($_ eq '-') {
    0          
7938 0         0 $sum++;
7939             } elsif ( m/ [0-9] /smx ) {
7940 0         0 $sum += $_;
7941             }
7942             }
7943 0         0 $sum = $sum % 10;
7944 0         0 return sprintf "%-68s%i\n", substr ($buffer, 0, 68), $sum;
7945             }
7946              
7947             # _normalize_oid
7948             #
7949             # Normalize an OID by expanding it to five digits.
7950              
7951             sub _normalize_oid {
7952 63     63   103 my ( $oid ) = @_;
7953 63 50       169 $oid =~ m/ [^0-9] /smx
7954             and return $oid;
7955 63         339 return sprintf '%05d', $oid;
7956             }
7957              
7958             # _set_illum
7959              
7960             # Setting the {illum} attribute is complex enough that the code
7961             # got pulled out into its own subroutine. As with all mutators,
7962             # the arguments are the object reference, the attribute name, and
7963             # the new value.
7964              
7965             __PACKAGE__->alias (sun => 'Astro::Coord::ECI::Sun');
7966             __PACKAGE__->alias (moon => 'Astro::Coord::ECI::Moon');
7967             sub _set_illum {
7968 108     108   299 my ($self, $name, $body) = @_;
7969 108 50       278 unless (ref $body) {
7970 108 50       338 $type_map{$body} and $body = $type_map{$body};
7971 108         340 load_module ($body);
7972             }
7973 108 50       300 embodies ($body, 'Astro::Coord::ECI') or croak <
7974             Error - The illuminating body must be an Astro::Coord::ECI, or a
7975             subclass thereof, or the words 'sun' or 'moon', which are
7976             handled as special cases. You tried to use a
7977 0   0     0 '@{[ref $body || $body]}'.
7978             eod
7979 108 50       472 ref $body or $body = $body->new ();
7980 108         299 $self->{$name} = $body;
7981 108         336 return 0;
7982             }
7983              
7984             sub _set_intldes {
7985 44     44   99 my ( $self, $name, $val ) = @_;
7986              
7987 44 100 66     240 if ( defined $val && $val =~ m/ \S /smx ) {
7988              
7989 31         51 my $working = $val;
7990              
7991 31         86 $working =~ s/ \s+ \z //smx;
7992 31         70 $working =~ s/ \s /0/smxg;
7993              
7994 31         145 foreach my $re (
7995             qr< ( [0-9]+ ) - ( [0-9]+ ) ( .+ ) >smx,
7996             qr< ( [0-9]{2} ) ( [0-9]{3} ) ( .+ ) >smx,
7997             ) {
7998 62 100       1973 $working =~ m/ \A $re \z /smx
7999             or next;
8000 30         137 my ( $year, $num, $piece ) = ( $1, $2, $3 );
8001              
8002 30 100       112 $year < 100
    50          
8003             and $year += $year < 57 ? 2000 : 1900;
8004              
8005 30         67 $self->{launch_year} = $year;
8006 30         73 $self->{launch_num} = $num;
8007 30         60 $self->{launch_piece} = $piece;
8008              
8009 30         131 $self->{$name} = sprintf '%02d%03d%s', $year % 100, $num, $piece;
8010              
8011 30         162 return 0;
8012             }
8013              
8014             }
8015              
8016             # We bypass the public interface to avoid thrashing
8017              
8018             $self->{launch_year} =
8019             $self->{launch_num} =
8020 14         98 $self->{launch_piece} = undef;
8021              
8022 14         52 $self->{$name} = $val;
8023              
8024 14         56 return 0;
8025             }
8026              
8027             {
8028             my %intldes_valid = (
8029             launch_year => sub {
8030             my ( $val ) = @_;
8031             $val =~ RE_ALL_DIGITS
8032             and $val <= 9999
8033             or croak 'Invalid launch_year';
8034             $val < 100
8035             and $val += $val < 57 ? 2000 : 1900;
8036             return $val + 0;
8037             },
8038             launch_num => sub {
8039             my ( $val ) = @_;
8040             $val =~ RE_ALL_DIGITS
8041             and $val < 1000
8042             or croak 'Invalid launch_num';
8043             return $val + 0;
8044             },
8045             launch_piece => sub {
8046             my ( $val ) = @_;
8047             $val =~ m/ \A [[:alpha:]]+ \z /smx
8048             or croak 'Invalid launch_piece';
8049             return uc $val;
8050             },
8051             );
8052              
8053             my $value_or_empty = sub {
8054             my ( $self, $name ) = @_;
8055             return defined $self->{$name} ? $self->{$name} : '';
8056             };
8057              
8058             sub _set_intldes_part {
8059 4     4   5 my ( $self, $name, $val ) = @_;
8060              
8061             $self->{$name} = defined $val ?
8062 4 100       14 $intldes_valid{$name}->( $val ) :
8063             $val;
8064              
8065 4         5 my %intldes;
8066 4         7 foreach my $key ( qw{ launch_year launch_num launch_piece } ) {
8067 12         15 $intldes{$key} = $value_or_empty->( $self, $key );
8068             }
8069             $intldes{launch_year} eq ''
8070 4 100       11 or $intldes{launch_year} %= 100;
8071              
8072             my $tplt = join '',
8073             ( $intldes{launch_year} eq '' ? '%2s' : '%02d' ),
8074 4 100       16 ( $intldes{launch_num} eq '' ? '%3s' : '%03d' ),
    100          
8075             '%s';
8076 4         7 $self->{international} = sprintf $tplt, map { $intldes{$_} }
  12         29  
8077             qw{ launch_year launch_num launch_piece };
8078              
8079 4         15 return 0;
8080             }
8081              
8082             }
8083              
8084             # _set_object_type
8085             #
8086             # This acts as a mutator for the object type.
8087             {
8088             my %name_to_type;
8089             my @number_to_type;
8090             foreach my $type (
8091             BODY_TYPE_UNKNOWN,
8092             BODY_TYPE_DEBRIS,
8093             BODY_TYPE_ROCKET_BODY,
8094             BODY_TYPE_PAYLOAD,
8095             ) {
8096             $number_to_type[$type] = $type;
8097             $name_to_type{ fold_case( $type ) } = $type;
8098             }
8099             sub _set_object_type {
8100 0     0   0 my ( $self, $name, $value ) = @_;
8101 0 0       0 if ( defined $value ) {
8102 0 0       0 if ( $value =~ RE_ALL_DIGITS ) {
8103 0         0 $self->{$name} = $number_to_type[$value];
8104             } else {
8105 0         0 $self->{$name} = $name_to_type{ fold_case( $value ) };
8106             }
8107 0 0       0 unless ( defined $self->{$name} ) {
8108 0         0 carp "Invalid $name '$value'; setting to unknown";
8109 0         0 $self->{$name} = BODY_TYPE_UNKNOWN;
8110             }
8111             } else {
8112 0         0 $self->{$name} = undef;
8113             }
8114 0         0 return 0;
8115             }
8116             }
8117              
8118             # _set_optional_float_no_reinit
8119             #
8120             # This acts as a mutator for any attribute whose value is either undef
8121             # or a floating-point number, and which does not cause the model to be
8122             # renitialized when its value changes. We disallow NaN.
8123              
8124             sub _set_optional_float_no_reinit {
8125 3     3   97 my ( $self, $name, $value ) = @_;
8126 3 50 33     17 if ( defined $value && ! _looks_like_real( $value ) ) {
8127 0         0 carp "Invalid $name '$value'; must be a float or undef";
8128 0         0 $value = undef;
8129             }
8130 3         7 $self->{$name} = $value;
8131 3         8 return 0;
8132             }
8133              
8134             # _set_optional_unsigned_integer_no_reinit
8135             #
8136             # This acts as a mutator for any attribute whose value is either undef
8137             # or an unsigned integer, and which does not cause the model to be
8138             # reinitialized when its value changes.
8139              
8140             sub _set_optional_unsigned_integer_no_reinit {
8141 0     0   0 my ( $self, $name, $value ) = @_;
8142 0 0 0     0 if ( defined $value && $value =~ m/ [^0-9] /smx ) {
8143 0         0 carp "Invalid $name '$value'; must be unsigned integer or undef";
8144 0         0 $value = undef;
8145             }
8146 0         0 $self->{$name} = $value;
8147 0         0 return 0;
8148             }
8149              
8150             sub _next_elevation_screen {
8151 95     95   347 my ( $sta, $pass_step, @args ) = @_;
8152 95 50       286 ref $sta
8153             or confess 'Programming error - station not a reference';
8154 95         485 my ( $suntim, $dawn ) = $sta->next_elevation( @args );
8155 95 50       286 defined $suntim
8156             or confess 'Programming error - time of next elevation undefined';
8157 95 100       310 $dawn or $pass_step = - $pass_step;
8158 95         277 my $sun_screen = $suntim + $pass_step / 2;
8159 95 100       698 return ( $suntim, $dawn, $sun_screen,
8160             $dawn ? $sun_screen : $suntim,
8161             );
8162             }
8163              
8164             #######################################################################
8165              
8166             # Initialization of aliases and status
8167              
8168             {
8169             # The following classes initialize themselves on load.
8170             local $@ = undef;
8171             eval { ## no critic (RequireCheckingReturnValueOfEval)
8172             require Astro::Coord::ECI::TLE::Iridium;
8173             };
8174             }
8175              
8176             # $$ BEGIN magnitude_table
8177              
8178             # The following is all the Celestrak visual list that have magnitudes in
8179             # Heavens Above. These data are generated by the following:
8180             #
8181             # $ tools/heavens-above-mag --celestrak --update
8182             #
8183             # Last-Modified: Sun, 07 Sep 2025 20:59:52 GMT
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             '05118' => 4.2, # SL-3 R/B
8195             '05560' => 4.2, # ASTEX 1
8196             '05730' => 4.2, # SL-8 R/B
8197             '06153' => 5.2, # OAO 3 (COPERNICUS)
8198             '06155' => 4.2, # ATLAS CENTAUR R/B
8199             '08459' => 5.2, # SL-8 R/B
8200             '10114' => 4.7, # SL-3 R/B
8201             '10967' => 3.2, # SEASAT 1
8202             '11267' => 4.7, # SL-14 R/B
8203             '11574' => 4.2, # SL-8 R/B
8204             '11672' => 4.2, # SL-14 R/B
8205             '12139' => 4.2, # SL-8 R/B
8206             '12465' => 4.2, # SL-3 R/B
8207             '12585' => 5.2, # METEOR PRIRODA
8208             '12904' => 4.2, # SL-3 R/B
8209             '13068' => 4.2, # SL-3 R/B
8210             '13154' => 4.7, # SL-3 R/B
8211             '13403' => 4.2, # SL-3 R/B
8212             '13553' => 4.7, # SL-14 R/B
8213             '13819' => 4.7, # SL-3 R/B
8214             '14208' => 4.2, # SL-3 R/B
8215             '14699' => 4.2, # COSMOS 1536
8216             '14820' => 4.7, # SL-14 R/B
8217             '15483' => 4.7, # SL-8 R/B
8218             '15772' => 4.2, # SL-12 R/B(2)
8219             '15945' => 4.7, # SL-14 R/B
8220             '16182' => 3.2, # SL-16 R/B
8221             '16496' => 4.7, # SL-14 R/B
8222             '16719' => 4.2, # COSMOS 1743
8223             '16792' => 4.7, # SL-14 R/B
8224             '16882' => 4.7, # SL-14 R/B
8225             '16908' => 4.2, # EGS (AJISAI)
8226             '17295' => 4.2, # COSMOS 1812
8227             '17567' => 4.7, # SL-14 R/B
8228             '17589' => 4.7, # COSMOS 1833
8229             '17590' => 3.2, # SL-16 R/B
8230             '17912' => 4.7, # SL-14 R/B
8231             '17973' => 4.2, # COSMOS 1844
8232             '18153' => 4.7, # SL-14 R/B
8233             '18187' => 4.2, # COSMOS 1867
8234             '18421' => 4.2, # COSMOS 1892
8235             '18749' => 4.7, # SL-14 R/B
8236             '18958' => 4.7, # COSMOS 1933
8237             '19046' => 4.2, # SL-3 R/B
8238             '19120' => 2.7, # SL-16 R/B
8239             '19210' => 3.7, # COSMOS 1953
8240             '19257' => 4.7, # SL-8 R/B
8241             '19573' => 4.2, # COSMOS 1975
8242             '19574' => 4.2, # SL-14 R/B
8243             '19650' => 2.7, # SL-16 R/B
8244             '20261' => 5.2, # INTERCOSMOS 24
8245             '20262' => 5.7, # SL-14 R/B
8246             '20323' => 4.7, # DELTA 1 R/B
8247             '20443' => 4.2, # ARIANE 40 R/B
8248             '20453' => 4.7, # DELTA 2 R/B(1)
8249             '20465' => 4.2, # COSMOS 2058
8250             '20466' => 4.2, # SL-14 R/B
8251             '20511' => 4.2, # SL-14 R/B
8252             '20580' => 2.2, # HST
8253             '20625' => 2.7, # SL-16 R/B
8254             '20663' => 4.7, # COSMOS 2084
8255             '20666' => 4.7, # SL-6 R/B(2)
8256             '20775' => 4.2, # SL-8 R/B
8257             '21088' => 4.2, # SL-8 R/B
8258             '21397' => 4.7, # OKEAN 3
8259             '21422' => 4.2, # COSMOS 2151
8260             '21423' => 4.7, # SL-14 R/B
8261             '21574' => 5.2, # ERS 1
8262             '21610' => 3.7, # ARIANE 40 R/B
8263             '21819' => 4.7, # INTERCOSMOS 25
8264             '21876' => 4.7, # SL-8 R/B
8265             '21938' => 4.2, # SL-8 R/B
8266             '21949' => 4.7, # USA 81
8267             '22219' => 3.7, # COSMOS 2219
8268             '22220' => 2.7, # SL-16 R/B
8269             '22236' => 3.7, # COSMOS 2221
8270             '22285' => 2.7, # SL-16 R/B
8271             '22286' => 4.2, # COSMOS 2228
8272             '22566' => 2.7, # SL-16 R/B
8273             '22626' => 4.2, # COSMOS 2242
8274             '22803' => 2.7, # SL-16 R/B
8275             '22830' => 4.2, # ARIANE 40 R/B
8276             '23087' => 4.2, # COSMOS 2278
8277             '23088' => 2.7, # SL-16 R/B
8278             '23343' => 2.7, # SL-16 R/B
8279             '23405' => 2.7, # SL-16 R/B
8280             '23561' => 3.7, # ARIANE 40+ R/B
8281             '23705' => 2.7, # SL-16 R/B
8282             '24298' => 2.7, # SL-16 R/B
8283             '24883' => 6.8, # ORBVIEW 2 (SEASTAR)
8284             '25400' => 2.7, # SL-16 R/B
8285             '25407' => 2.7, # SL-16 R/B
8286             '25544' => -1.8, # ISS (ZARYA)
8287             '25732' => 4.2, # CZ-4B R/B
8288             '25860' => 3.7, # OKEAN O
8289             '25861' => 2.7, # SL-16 R/B
8290             '25876' => 4.2, # DELTA 2 R/B
8291             '25977' => 5.7, # HELIOS 1B
8292             '25994' => 2.7, # TERRA
8293             '26070' => 2.7, # SL-16 R/B
8294             '26474' => 2.7, # TITAN 4B R/B
8295             '26905' => 3.7, # USA 160
8296             '26907' => 3.7, # USA 160 DEB
8297             '27386' => 3.7, # ENVISAT
8298             '27422' => 3.2, # IDEFIX/ARIANE 42P
8299             '27424' => 4.7, # AQUA
8300             '27432' => 3.7, # CZ-4B R/B
8301             '27597' => 2.7, # ADEOS 2
8302             '27601' => 2.7, # H-2A R/B
8303             '28059' => 4.7, # CZ-4B R/B
8304             '28222' => 4.2, # CZ-2C R/B
8305             '28353' => 2.7, # SL-16 R/B
8306             '28415' => 4.2, # CZ-4B R/B
8307             '28480' => 3.7, # CZ-2C R/B
8308             '28499' => undef, # ARIANE 5 R/B has no recorded magnitude
8309             '28738' => 4.7, # CZ-2D R/B
8310             '28931' => 3.2, # ALOS
8311             '28932' => 3.7, # H-2A R/B
8312             '29228' => 3.7, # RESURS DK-1
8313             '29507' => 2.7, # CZ-4B R/B
8314             '31114' => 3.2, # CZ-2C R/B
8315             '31598' => 3.7, # SKYMED 1
8316             '31792' => 3.2, # COSMOS 2428
8317             '31793' => 2.7, # SL-16 R/B
8318             '33504' => 5.3, # KORONAS-FOTON
8319             '37731' => undef, # CZ-2C R/B has no recorded magnitude
8320             '38341' => 3.2, # H-2A R/B
8321             '39358' => undef, # SJ-16 has no recorded magnitude
8322             '39679' => 3.4, # SL-4 R/B
8323             '39766' => 3.7, # ALOS 2
8324             '41038' => undef, # YAOGAN 29 has no recorded magnitude
8325             '41337' => undef, # ASTRO H has no recorded magnitude
8326             '42758' => undef, # HXMT has no recorded magnitude
8327             '43521' => undef, # CZ-2C R/B has no recorded magnitude
8328             '43641' => undef, # SAOCOM 1-A has no recorded magnitude
8329             '43682' => undef, # H-2A R/B has no recorded magnitude
8330             '46265' => undef, # SAOCOM 1-B has no recorded magnitude
8331             '48274' => 0.0, # CSS (TIANHE-1)
8332             '48865' => undef, # COSMOS 2550 has no recorded magnitude
8333             '52794' => undef, # CZ-2C R/B has no recorded magnitude
8334             '53807' => 3.5, # BLUEWALKER 3
8335             '54149' => undef, # GSLV R/B has no recorded magnitude
8336             '57800' => undef, # XRISM has no recorded magnitude
8337             '59588' => 2.0, # ACS 3
8338             );
8339              
8340             # $$ END
8341              
8342             1;
8343              
8344             __END__