1 /* zzsgp4.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* Table of constant values */
9
10 static doublereal c_b10 = -.66666666666666663;
11 static doublereal c_b11 = .33333333333333331;
12 static doublereal c_b16 = 3.5;
13 static doublereal c_b22 = 1.5;
14 static logical c_false = FALSE_;
15
16 /* $Procedure ZZSGP4 ( SGP4 wrapper ) */
zzsgp4_0_(int n__,doublereal * geophs,doublereal * elems,integer * opmode,doublereal * t,doublereal * state)17 /* Subroutine */ int zzsgp4_0_(int n__, doublereal *geophs, doublereal *elems,
18 integer *opmode, doublereal *t, doublereal *state)
19 {
20 /* System generated locals */
21 doublereal d__1, d__2;
22
23 /* Builtin functions */
24 double pow_dd(doublereal *, doublereal *), cos(doublereal), sin(
25 doublereal), d_mod(doublereal *, doublereal *), sqrt(doublereal),
26 atan2(doublereal, doublereal);
27
28 /* Local variables */
29 doublereal eccm;
30 static doublereal ecco;
31 doublereal eccp, coef, eeta;
32 static doublereal alta, dedt;
33 doublereal cnod;
34 static doublereal con41;
35 doublereal con42, delm;
36 static doublereal didt, dmdt;
37 doublereal dndt;
38 static doublereal pgho;
39 doublereal ainv, cosi;
40 static doublereal altp;
41 doublereal axnl;
42 static doublereal mdot;
43 doublereal aynl, emsq;
44 static doublereal j3oj2;
45 doublereal sini, snod, cosu, temp;
46 static doublereal gsto;
47 doublereal sinu, tvec[8], xinc;
48 static doublereal zmol;
49 doublereal posq, xmdf;
50 integer iter;
51 static integer irez;
52 static doublereal zmos;
53 doublereal coef1, cc1sq;
54 static doublereal t2cof, t3cof, t4cof, t5cof;
55 doublereal temp1, temp2, temp3, temp4, cos2u, sin2u;
56 static doublereal a;
57 doublereal betal, u;
58 extern /* Subroutine */ int chkin_(char *, ftnlen);
59 doublereal eccsq;
60 static doublereal atime, aycof;
61 doublereal cnodm;
62 static doublereal inclo, xfact, pinco;
63 doublereal argpm;
64 static doublereal argpo, xlcof, xmcof;
65 doublereal argpp;
66 static doublereal bstar;
67 doublereal cosim;
68 static doublereal xlamo;
69 doublereal cosio;
70 static doublereal x1mth2;
71 doublereal cosip;
72 static doublereal delmo, d2, d3, x7thm1, e3, d4, dnodt;
73 doublereal cossu;
74 static doublereal domdt;
75 doublereal ecose, epoch, esine, etasq, inclm;
76 static doublereal j2;
77 doublereal j3, j4, nodem;
78 static doublereal nodeo;
79 doublereal nodep, psisq, qzms24, rdotl, rvdot, s1, s2, s3, s4, s5, s6, s7,
80 sfour, sinim, sinio, sinip, coseo1, sinsu, snodm, t2, t3, cosio2,
81 sineo1, cosio4, t4, tempa, tempe, templ, tumin, tzero, xhdot1,
82 xincp, xnode, z1, z2, z3;
83 extern doublereal twopi_(void);
84 doublereal am;
85 extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
86 doublereal ao;
87 extern logical failed_(void);
88 static doublereal er;
89 doublereal tc;
90 extern doublereal pi_(void);
91 doublereal mm;
92 static doublereal mo;
93 doublereal mp;
94 static doublereal no;
95 doublereal mr, omgadf, pl, mv, qzms2t, rl, delomg, rp;
96 static doublereal omgcof;
97 doublereal perige, ss, su, ux, uy;
98 static doublereal xnodcf;
99 doublereal uz;
100 static doublereal cc1, sinmao;
101 doublereal cc2;
102 static doublereal cc4, cc5, ee2;
103 doublereal cc3, cosomm, vx, cosisq, el2, eo1, omeosq, sinomm, vy, vz,
104 rvdotl, rtemsq;
105 static doublereal se2;
106 doublereal rteosq;
107 static doublereal se3, sh2;
108 doublereal pinvsq;
109 static doublereal sh3, xh2, xh3, xi2, xi3, xl2, xl3, xl4, si2, si3, sl2,
110 sl3, sl4;
111 doublereal ss1, ss2, ss3, ss4, ss5, ss6, ss7, sz1, sz2, sz3, xl;
112 static doublereal d2201, d2211, d3210;
113 doublereal xn;
114 static doublereal d3222, d4410, d5220, d4422, d5232, d5421, d5433;
115 doublereal xnoddf, gam, xpidot, z11, z12, z13;
116 static doublereal eta;
117 doublereal z21, z22, z23, day, z31, z32, z33;
118 static integer svmode;
119 logical doinit;
120 static doublereal peo;
121 static logical dosimp, dodeep;
122 static doublereal pho, xke, plo;
123 doublereal x2o3;
124 static doublereal xli;
125 doublereal kps;
126 static doublereal xni;
127 doublereal sz11, sz12, sz13, sz21, sz22, sz23, sz31, sz32, sz33, tsi, xlm;
128 extern logical return_(void);
129 static doublereal nodedot;
130 doublereal xmx, xmy;
131 extern /* Subroutine */ int setmsg_(char *, ftnlen);
132 static doublereal argpdot;
133 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
134 ftnlen), ttrans_(char *, char *, doublereal *, ftnlen, ftnlen),
135 zzinil_(doublereal *, integer *, doublereal *, doublereal *,
136 doublereal *, doublereal *, doublereal *, doublereal *,
137 doublereal *, doublereal *, doublereal *, doublereal *,
138 doublereal *, doublereal *, doublereal *, doublereal *,
139 doublereal *, doublereal *, doublereal *);
140 static doublereal del1, del2, del3;
141 extern /* Subroutine */ int zzdscm_(doublereal *, doublereal *,
142 doublereal *, doublereal *, doublereal *, doublereal *,
143 doublereal *, doublereal *, doublereal *, doublereal *,
144 doublereal *, doublereal *, doublereal *, doublereal *,
145 doublereal *, doublereal *, doublereal *, doublereal *,
146 doublereal *, doublereal *, doublereal *, doublereal *,
147 doublereal *, doublereal *, doublereal *, doublereal *,
148 doublereal *, doublereal *, doublereal *, doublereal *,
149 doublereal *, doublereal *, doublereal *, doublereal *,
150 doublereal *, doublereal *, doublereal *, doublereal *,
151 doublereal *, doublereal *, doublereal *, doublereal *,
152 doublereal *, doublereal *, doublereal *, doublereal *,
153 doublereal *, doublereal *, doublereal *, doublereal *,
154 doublereal *, doublereal *, doublereal *, doublereal *,
155 doublereal *, doublereal *, doublereal *, doublereal *,
156 doublereal *, doublereal *, doublereal *, doublereal *,
157 doublereal *, doublereal *, doublereal *, doublereal *,
158 doublereal *, doublereal *, doublereal *, doublereal *,
159 doublereal *, doublereal *, doublereal *, doublereal *,
160 doublereal *, doublereal *, doublereal *, doublereal *,
161 doublereal *, doublereal *, doublereal *, doublereal *,
162 doublereal *, doublereal *, doublereal *, doublereal *,
163 doublereal *, doublereal *), zzdspr_(integer *, doublereal *,
164 doublereal *, doublereal *, doublereal *, doublereal *,
165 doublereal *, doublereal *, doublereal *, doublereal *,
166 doublereal *, doublereal *, doublereal *, doublereal *,
167 doublereal *, doublereal *, doublereal *, doublereal *,
168 doublereal *, doublereal *, doublereal *, doublereal *,
169 doublereal *, doublereal *, doublereal *, doublereal *,
170 doublereal *, doublereal *, doublereal *, doublereal *,
171 doublereal *, doublereal *, doublereal *, doublereal *, logical *,
172 doublereal *, doublereal *, doublereal *, doublereal *,
173 doublereal *), zzdsin_(doublereal *, doublereal *, doublereal *,
174 doublereal *, doublereal *, doublereal *, doublereal *,
175 doublereal *, doublereal *, doublereal *, doublereal *,
176 doublereal *, doublereal *, doublereal *, doublereal *,
177 doublereal *, doublereal *, doublereal *, doublereal *,
178 doublereal *, doublereal *, doublereal *, doublereal *,
179 doublereal *, doublereal *, doublereal *, doublereal *,
180 doublereal *, doublereal *, doublereal *, doublereal *,
181 doublereal *, doublereal *, doublereal *, doublereal *,
182 doublereal *, doublereal *, doublereal *, doublereal *,
183 doublereal *, doublereal *, doublereal *, doublereal *,
184 doublereal *, doublereal *, doublereal *, doublereal *,
185 doublereal *, integer *, doublereal *, doublereal *, doublereal *,
186 doublereal *, doublereal *, doublereal *, doublereal *,
187 doublereal *, doublereal *, doublereal *, doublereal *,
188 doublereal *, doublereal *, doublereal *, doublereal *,
189 doublereal *, doublereal *, doublereal *, doublereal *,
190 doublereal *, doublereal *, doublereal *, doublereal *,
191 doublereal *), zzdspc_(integer *, doublereal *, doublereal *,
192 doublereal *, doublereal *, doublereal *, doublereal *,
193 doublereal *, doublereal *, doublereal *, doublereal *,
194 doublereal *, doublereal *, doublereal *, doublereal *,
195 doublereal *, doublereal *, doublereal *, doublereal *,
196 doublereal *, doublereal *, doublereal *, doublereal *,
197 doublereal *, doublereal *, doublereal *, doublereal *,
198 doublereal *, doublereal *, doublereal *, doublereal *,
199 doublereal *, doublereal *, doublereal *, doublereal *,
200 doublereal *, doublereal *);
201 static doublereal sgh2, sgh3, sgh4, xgh2, xgh3, xgh4;
202 doublereal tem5;
203
204 /* $ Abstract */
205
206 /* Umbrella for the SGP4 initializer and evaluator routines. */
207
208 /* $ Disclaimer */
209
210 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
211 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
212 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
213 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
214 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
215 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
216 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
217 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
218 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
219 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
220
221 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
222 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
223 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
224 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
225 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
226 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
227
228 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
229 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
230 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
231 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
232
233 /* $ Required_Reading */
234
235 /* None. */
236
237 /* $ Keywords */
238
239 /* None. */
240
241 /* $ Declarations */
242 /* $Procedure ZZSGP4 ( SGP4 parameters ) */
243
244 /* $ Abstract */
245
246 /* Parameter assignments for SGP4 algorithm as expressed */
247 /* by Vallado [2]. */
248
249 /* $ Disclaimer */
250
251 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
252 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
253 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
254 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
255 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
256 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
257 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
258 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
259 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
260 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
261
262 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
263 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
264 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
265 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
266 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
267 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
268
269 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
270 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
271 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
272 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
273
274 /* $ Required_Reading */
275
276 /* None. */
277
278 /* $ Keywords */
279
280 /* None. */
281
282 /* $ Declarations */
283
284 /* None. */
285
286 /* $ Brief_I/O */
287
288 /* None. */
289
290 /* $ Detailed_Input */
291
292 /* None. */
293
294 /* $ Detailed_Output */
295
296 /* None. */
297
298 /* $ Parameters */
299
300 /* None. */
301
302 /* $ Exceptions */
303
304 /* None. */
305
306 /* $ Files */
307
308 /* None. */
309
310 /* $ Particulars */
311
312 /* None. */
313
314 /* $ Examples */
315
316 /* J2 = GEOPHS(K_J2) */
317 /* J3 = GEOPHS(K_J3) */
318 /* J4 = GEOPHS(K_J4) */
319 /* ER = GEOPHS(K_ER) */
320 /* XKE = GEOPHS(K_KE) */
321
322 /* TUMIN = 1.D0/XKE */
323 /* J3OJ2 = J3/J2 */
324
325 /* $ Restrictions */
326
327 /* None. */
328
329 /* $ Literature_References */
330
331 /* [1] Hoots, F. R., and Roehrich, R. L. 1980. "Models for */
332 /* Propagation of the NORAD Element Sets." Spacetrack Report #3. */
333 /* U.S. Air Force: Aerospace Defense Command. */
334
335 /* [2] Vallado, David, Crawford, Paul, Hujsak, Richard, and Kelso, T.S. */
336 /* 2006. Revisiting Spacetrack Report #3. Paper AIAA 2006-6753 */
337 /* presented at the AIAA/AAS Astrodynamics Specialist Conference, */
338 /* August 21-24, 2006. Keystone, CO. */
339
340 /* $ Author_and_Institution */
341
342 /* E. D. Wright (JPL) */
343
344 /* $ Version */
345
346 /* - SPICELIB Version 1.0.0 22-JUL-2014 (EDW) */
347
348 /* -& */
349 /* $ Index_Entries */
350
351 /* SGP4 */
352
353 /* -& */
354
355 /* WGS gravitational constants IDs. */
356
357
358 /* Gravitational constant indices. */
359
360
361 /* The following parameters give the location in the GEOPHS */
362 /* array of the various geophysical parameters needed for */
363 /* the two line element sets. */
364
365 /* K_J2 --- location of J2 */
366 /* K_J3 --- location of J3 */
367 /* K_J4 --- location if J4 */
368 /* K_KE --- location of KE = sqrt(GM) in earth-radii**1.5/MIN */
369 /* K_QO --- upper bound of atmospheric model in KM */
370 /* K_SO --- lower bound of atmospheric model in KM */
371 /* K_ER --- earth equatorial radius in KM. */
372 /* K_AE --- distance units/earth radius */
373
374
375 /* Operation mode values, OPMODE. */
376
377
378 /* An enumeration of the various components of the */
379 /* elements array---ELEMS */
380
381 /* KNDT20 --- location of NDT20 */
382 /* KNDD60 --- location of NDD60 */
383 /* KBSTAR --- location of BSTAR */
384 /* KINCL --- location of INCL */
385 /* KNODE0 --- location of NODE0 */
386 /* KECC --- location of ECC */
387 /* KOMEGA --- location of OMEGA */
388 /* KMO --- location of MO */
389 /* KNO --- location of NO */
390
391 /* $ Brief_I/O */
392
393 /* Variable I/O Entry Point */
394 /* -------- --- -------------------------------------------------- */
395 /* GEOPHS I XXSGP4I */
396 /* ELEMS I XXSGP4I */
397 /* OPMODE I XXSGP4I */
398 /* T I XXSGP4E */
399 /* STATE O XXSGP4E */
400
401 /* $ Detailed_Input */
402
403 /* See Individual Entry points. */
404
405 /* $ Detailed_Output */
406
407 /* See Individual Entry points. */
408
409 /* $ Parameters */
410
411 /* None. */
412
413 /* $ Exceptions */
414
415 /* 1) 'SPICE(BOGUSENTRY)' will signal if ZZSGP4 is called. */
416
417 /* $ Files */
418
419 /* None. */
420
421 /* $ Particulars */
422
423 /* This routine wraps XXSGP4E and XXSGP4I. As entry points to */
424 /* this routine, they share the local memory space. */
425
426 /* $ Examples */
427
428 /* The numerical results shown for these examples may differ across */
429 /* platforms. The results depend on the SPICE kernels used as */
430 /* input, the compiler and supporting libraries, and the machine */
431 /* specific arithmetic implementation. */
432
433 /* Use a set of TLEs to calculate a collection of states for a */
434 /* time interval centered at the TLE set epoch. */
435
436 /* PROGRAM ZZSGP4_T */
437
438 /* C */
439 /* C Read a data file containing sets of TLEs, then calculate */
440 /* C states at -1440 to 1440 minutes from the epoch of each */
441 /* C TLE set in steps of 10 minutes. */
442 /* C */
443 /* C Example cases listed in sgp4-ver.tle. */
444 /* C */
445 /* C 1 00005U 58002B 00179.78495062 .00000023 */
446 /* C 00000-0 28098-4 0 4753 */
447 /* C 2 00005 34.2682 348.7242 1859667 331.7664 */
448 /* C 19.3264 10.82419157413667 */
449 /* C */
450 /* C 1 04632U 70093B 04031.91070959 -.00000084 */
451 /* C 00000-0 10000-3 0 9955 */
452 /* C 2 04632 11.4628 273.1101 1450506 207.6000 */
453 /* C 143.9350 1.20231981 44145 */
454 /* C */
455 /* C 1 06251U 62025E 06176.82412014 .00008885 */
456 /* C 00000-0 12808-3 0 3985 */
457 /* C 2 06251 58.0579 54.0425 0030035 139.1568 */
458 /* C 221.1854 15.56387291 6774 */
459 /* C */
460 /* C 1 08195U 75081A 06176.33215444 .00000099 */
461 /* C 00000-0 11873-3 0 813 */
462 /* C 2 08195 64.1586 279.0717 6877146 264.7651 */
463 /* C 20.2257 2.00491383225656 */
464 /* C */
465 /* C 1 09880U 77021A 06176.56157475 .00000421 */
466 /* C 00000-0 10000-3 0 9814 */
467 /* C 2 09880 64.5968 349.3786 7069051 270.0229 */
468 /* C 16.3320 2.00813614112380 */
469 /* C */
470 /* C 1 09998U 74033F 05148.79417928 -.00000112 */
471 /* C 00000-0 00000+0 0 4480 */
472 /* C 2 09998 9.4958 313.1750 0270971 327.5225 */
473 /* C 30.8097 1.16186785 45878 */
474 /* C */
475 /* C 1 11801U 80230.29629788 .01431103 */
476 /* C 00000-0 14311-1 13 */
477 /* C 2 11801 46.7916 230.4354 7318036 47.4722 */
478 /* C 10.4117 2.28537848 13 */
479 /* C */
480 /* C 1 14128U 83058A 06176.02844893 -.00000158 */
481 /* C 00000-0 10000-3 0 9627 */
482 /* C 2 14128 11.4384 35.2134 0011562 26.4582 */
483 /* C 333.5652 0.98870114 46093 */
484 /* C */
485 /* C 1 16925U 86065D 06151.67415771 .02550794 */
486 /* C -30915-6 18784-3 0 4486 */
487 /* C 2 16925 62.0906 295.0239 5596327 245.1593 */
488 /* C 47.9690 4.88511875148616 */
489 /* C */
490 /* C 1 20413U 83020D 05363.79166667 .00000000 */
491 /* C 00000-0 00000+0 0 7041 */
492 /* C 2 20413 12.3514 187.4253 7864447 196.3027 */
493 /* C 356.5478 0.24690082 7978 */
494 /* C */
495 /* C 1 21897U 92011A 06176.02341244 -.00001273 */
496 /* C 00000-0 -13525-3 0 3044 */
497 /* C 2 21897 62.1749 198.0096 7421690 253.0462 */
498 /* C 20.1561 2.01269994104880 */
499 /* C */
500 /* C 1 22312U 93002D 06094.46235912 .99999999 */
501 /* C 81888-5 49949-3 0 3953 */
502 /* C 2 22312 62.1486 77.4698 0308723 267.9229 */
503 /* C 88.7392 15.95744531 98783 */
504 /* C */
505 /* C 1 22674U 93035D 06176.55909107 .00002121 */
506 /* C 00000-0 29868-3 0 6569 */
507 /* C 2 22674 63.5035 354.4452 7541712 253.3264 */
508 /* C 18.7754 1.96679808 93877 */
509 /* C */
510 /* C 1 23177U 94040C 06175.45752052 .00000386 */
511 /* C 00000-0 76590-3 0 95 */
512 /* C 2 23177 7.0496 179.8238 7258491 296.0482 */
513 /* C 8.3061 2.25906668 97438 */
514 /* C */
515 /* C 1 23333U 94071A 94305.49999999 -.00172956 */
516 /* C 26967-3 10000-3 0 15 */
517 /* C 2 23333 28.7490 2.3720 9728298 30.4360 */
518 /* C 1.3500 0.07309491 70 */
519 /* C */
520 /* C 1 23599U 95029B 06171.76535463 .00085586 */
521 /* C 12891-6 12956-2 0 2905 */
522 /* C 2 23599 6.9327 0.2849 5782022 274.4436 */
523 /* C 25.2425 4.47796565123555 */
524 /* C */
525 /* C 1 24208U 96044A 06177.04061740 -.00000094 */
526 /* C 00000-0 10000-3 0 1600 */
527 /* C 2 24208 3.8536 80.0121 0026640 311.0977 */
528 /* C 48.3000 1.00778054 36119 */
529 /* C */
530 /* C 1 25954U 99060A 04039.68057285 -.00000108 */
531 /* C 00000-0 00000-0 0 6847 */
532 /* C 2 25954 0.0004 243.8136 0001765 15.5294 */
533 /* C 22.7134 1.00271289 15615 */
534 /* C */
535 /* C 1 26900U 01039A 06106.74503247 .00000045 */
536 /* C 00000-0 10000-3 0 8290 */
537 /* C 2 26900 0.0164 266.5378 0003319 86.1794 */
538 /* C 182.2590 1.00273847 16981 */
539 /* C */
540 /* C 1 26975U 78066F 06174.85818871 .00000620 */
541 /* C 00000-0 10000-3 0 6809 */
542 /* C 2 26975 68.4714 236.1303 5602877 123.7484 */
543 /* C 302.5767 2.05657553 67521 */
544 /* C */
545 /* C 1 28057U 03049A 06177.78615833 .00000060 */
546 /* C 00000-0 35940-4 0 1836 */
547 /* C 2 28057 98.4283 247.6961 0000884 88.1964 */
548 /* C 271.9322 14.35478080140550 */
549 /* C */
550 /* C 1 28129U 03058A 06175.57071136 -.00000104 */
551 /* C 00000-0 10000-3 0 459 */
552 /* C 2 28129 54.7298 324.8098 0048506 266.2640 */
553 /* C 93.1663 2.00562768 18443 */
554 /* C */
555 /* C 1 28350U 04020A 06167.21788666 .16154492 */
556 /* C 76267-5 18678-3 0 8894 */
557 /* C 2 28350 64.9977 345.6130 0024870 260.7578 */
558 /* C 99.9590 16.47856722116490 */
559 /* C */
560 /* C 1 28623U 05006B 06177.81079184 .00637644 */
561 /* C 69054-6 96390-3 0 6000 */
562 /* C 2 28623 28.5200 114.9834 6249053 170.2550 */
563 /* C 212.8965 3.79477162 12753 */
564 /* C */
565 /* C 1 28626U 05008A 06176.46683397 -.00000205 */
566 /* C 00000-0 10000-3 0 2190 */
567 /* C 2 28626 0.0019 286.9433 0000335 13.7918 */
568 /* C 55.6504 1.00270176 4891 */
569 /* C */
570 /* C 1 28872U 05037B 05333.02012661 .25992681 */
571 /* C 00000-0 24476-3 0 1534 */
572 /* C 2 28872 96.4736 157.9986 0303955 244.0492 */
573 /* C 110.6523 16.46015938 10708 */
574 /* C */
575 /* C 1 29141U 85108AA 06170.26783845 .99999999 */
576 /* C 00000-0 13519-0 0 718 */
577 /* C 2 29141 82.4288 273.4882 0015848 277.2124 */
578 /* C 83.9133 15.93343074 6828 */
579 /* C */
580 /* C 1 29238U 06022G 06177.28732010 .00766286 */
581 /* C 10823-4 13334-2 0 101 */
582 /* C 2 29238 51.5595 213.7903 0202579 95.2503 */
583 /* C 267.9010 15.73823839 1061 */
584 /* C */
585 /* C 1 88888U 80275.98708465 .00073094 */
586 /* C 13844-3 66816-4 0 87 */
587 /* C 2 88888 72.8435 115.9689 0086731 52.6988 */
588 /* C 110.5714 16.05824518 1058 */
589 /* C */
590
591 /* IMPLICIT NONE */
592
593 /* INCLUDE 'zzsgp4.inc' */
594
595 /* CHARACTER*(72) LINES ( 2 ) */
596 /* CHARACTER*(72) TLEDAT */
597
598 /* INTEGER FRSTYR */
599 /* INTEGER I */
600 /* INTEGER OPMODE */
601
602 /* DOUBLE PRECISION DELT */
603 /* DOUBLE PRECISION ELEMS ( 10 ) */
604 /* DOUBLE PRECISION EPOCH */
605 /* DOUBLE PRECISION GEOPHS ( 8 ) */
606 /* DOUBLE PRECISION STATE ( 6 ) */
607 /* DOUBLE PRECISION TF */
608 /* DOUBLE PRECISION TIME */
609 /* DOUBLE PRECISION TS */
610
611 /* LOGICAL EOF */
612
613 /* C */
614 /* C SPICELIB routines. */
615 /* C */
616 /* LOGICAL FAILED */
617
618 /* C */
619 /* C Load a leapseconds kernel for time conversion. Required */
620 /* C by the SPK 10 evaluator. */
621 /* C */
622 /* CALL FURNSH ( '/kernels/gen/lsk/naif0011.tls' ) */
623
624 /* C */
625 /* C Define the geophysical quantities using the values */
626 /* C from geophysical.ker. */
627 /* C */
628 /* GEOPHS( K_J2 ) = 1.082616D-3 */
629 /* GEOPHS( K_J3 ) = -2.53881D-6 */
630 /* GEOPHS( K_J4 ) = -1.65597D-6 */
631 /* GEOPHS( K_KE ) = 7.43669161D-2 */
632 /* GEOPHS( K_QO ) = 120.0D0 */
633 /* GEOPHS( K_SO ) = 78.0D0 */
634 /* GEOPHS( K_ER ) = 6378.135D0 */
635 /* GEOPHS( K_AE ) = 1.0D0 */
636
637 /* TLEDAT = 'sgp4-ver1.tle' */
638
639 /* C */
640 /* C Error subsystem to report to ensure execution continues */
641 /* C if an error signals. */
642 /* C */
643 /* CALL ERRACT( 'SET', 'REPORT') */
644
645 /* C */
646 /* C Use Spacetrack #3 algorithm to calculate sidereal time. */
647 /* C */
648 /* OPMODE = AFSPC */
649
650 /* C */
651 /* C Identify the earliest year for the elements. */
652 /* C */
653 /* FRSTYR = 1958 */
654
655 /* C */
656 /* C Start and final offsets from TLE epochs. [-1440, 1400] */
657 /* C minutes. */
658 /* C */
659 /* TS = -1440.0D0 */
660 /* TF = 1440.0D0 */
661
662 /* C */
663 /* C Step size for elements output 10 minutes. */
664 /* C */
665 /* DELT = 10.D0 */
666
667 /* C */
668 /* C Read the TLE data file. */
669 /* C */
670 /* CALL RDTEXT ( TLEDAT, LINES(1), EOF ) */
671 /* CALL RDTEXT ( TLEDAT, LINES(2), EOF ) */
672
673 /* C */
674 /* C Loop over data file until end-of-file. */
675 /* C */
676 /* DO WHILE ( .NOT. EOF ) */
677
678 /* C */
679 /* C Parse the elements to something SPICE can use. */
680 /* C */
681 /* CALL GETELM ( FRSTYR, LINES, EPOCH, ELEMS ) */
682
683 /* WRITE(*, FMT='(A72)') LINES(1) */
684 /* WRITE(*, FMT='(A72)') LINES(2) */
685 /* WRITE(*,*) ' ' */
686
687 /* C */
688 /* C Initialize SGP4 calculations based on values in */
689 /* C GEOPHS, ELEMS, and AFSPC. */
690 /* C */
691 /* CALL XXSGP4I ( GEOPHS, ELEMS, OPMODE ) */
692
693 /* C */
694 /* C Start time keyed in minutes from TLE epoch. */
695 /* C */
696 /* TIME = TS */
697
698 /* DO WHILE ( TIME .LE. DABS(TF) .AND. (.NOT. FAILED()) ) */
699
700 /* C */
701 /* C Calculate the STATE at TIME. */
702 /* C */
703 /* CALL XXSGP4E ( TIME, STATE ) */
704
705 /* C */
706 /* C If the propagation succeeded, output the STATE. */
707 /* C */
708 /* IF ( .NOT. FAILED() ) THEN */
709
710 /* WRITE(*, FMT ='(7F17.8)' ) TIME, */
711 /* . (STATE(I),I=1,6) */
712
713 /* END IF */
714
715 /* C */
716 /* C Increment the evaluation time by one step. */
717 /* C */
718 /* TIME = TIME + DELT */
719
720 /* END DO */
721
722 /* WRITE(*,*) ' ' */
723
724 /* C */
725 /* C reset the error subsystem for the next loop. */
726 /* C */
727 /* CALL RESET() */
728
729 /* C */
730 /* C Read the next two lines (if any) from the TLE */
731 /* C data file. */
732 /* C */
733 /* CALL RDTEXT ( TLEDAT, LINES(1), EOF ) */
734 /* CALL RDTEXT ( TLEDAT, LINES(2), EOF ) */
735
736 /* END DO */
737
738 /* END */
739
740 /* $ Restrictions */
741
742 /* None. */
743
744 /* $ Literature_References */
745
746 /* [1] Hoots, F. R., and Roehrich, R. L. 1980. "Models for */
747 /* Propagation of the NORAD Element Sets." Spacetrack Report #3. */
748 /* U.S. Air Force: Aerospace Defense Command. */
749
750 /* [2] Hoots, Felix R. "Spacetrack Report #6: Models for Propagation */
751 /* of Space Command Element Sets." Space Command, */
752 /* U. S. Air Force, CO. */
753
754 /* [3] Hoots, Felix R., P. W. Schumacher, and R. A. Glover. 2004. */
755 /* History of Analytical Orbit Modeling in the U. S. Space */
756 /* Surveillance System. Journal of Guidance, Control, and */
757 /* Dynamics. 27(2):174-185. */
758
759 /* [4] Vallado, David, Crawford, Paul, Hujsak, Richard, */
760 /* and Kelso, T.S. 2006. Revisiting Spacetrack Report #3. Paper */
761 /* AIAA 2006-6753 presented at the AIAA/AAS Astrodynamics */
762 /* Specialist Conference, August 21-24, 2006. Keystone, CO. */
763
764 /* $ Author_and_Institution */
765
766 /* David Vallado (AGI) */
767 /* E. D. Wright (JPL) */
768
769 /* $ Version */
770
771 /* - SPICELIB Version 1.0.0, SEP-15-2014 (EDW) */
772
773 /* Based on routine SGP4, 28-JUN-2005, Vallado 2006 [4]. */
774
775 /* -& */
776 /* $ Index_Entries */
777
778 /* SGP4 */
779
780 /* -& */
781
782 /* Local Variables */
783
784
785 /* DS values */
786
787
788 /* SPICELIB routines. */
789
790 /* Parameter adjustments */
791 if (geophs) {
792 }
793 if (elems) {
794 }
795 if (state) {
796 }
797
798 /* Function Body */
799 switch(n__) {
800 case 1: goto L_xxsgp4i;
801 case 2: goto L_xxsgp4e;
802 }
803
804 chkin_("ZZSGP4", (ftnlen)6);
805 setmsg_("The routine ZZSGP4 is an umbrella for the SGP4 initializer and "
806 "propagator entry points. Do not call ZZSGP4. It is likely that a"
807 " programming error has been made.", (ftnlen)160);
808 sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17);
809 chkout_("ZZSGP4", (ftnlen)6);
810 return 0;
811 /* $Procedure XXSGP4I ( SGP4 initializer ) */
812
813 L_xxsgp4i:
814 /* $ Abstract */
815
816 /* This subroutine initializes variables for SGP4. */
817
818 /* $ Disclaimer */
819
820 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
821 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
822 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
823 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
824 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
825 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
826 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
827 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
828 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
829 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
830
831 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
832 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
833 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
834 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
835 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
836 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
837
838 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
839 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
840 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
841 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
842
843 /* $ Required_Reading */
844
845 /* None. */
846
847 /* $ Keywords */
848
849 /* None. */
850
851 /* $ Declarations */
852
853 /* Refer to Declarations section in ZZSGP4. */
854
855 /* $ Brief_I/O */
856
857 /* Variable I/O Description */
858 /* -------- --- -------------------------------------------------- */
859 /* GEOPHS I Geophysical constants */
860 /* ELEMS I Two-line element data */
861 /* OPMODE I Flag to indicate operation mode for GMST. */
862
863 /* $ Detailed_Input */
864
865 /* GEOPHS is a collection of 8 geophysical constants needed */
866 /* for computing a state. The order of these */
867 /* constants must be: */
868
869 /* GEOPHS(1) = J2 gravitational harmonic for earth */
870 /* GEOPHS(2) = J3 gravitational harmonic for earth */
871 /* GEOPHS(3) = J4 gravitational harmonic for earth */
872
873 /* These first three constants are dimensionless. */
874
875 /* GEOPHS(4) = KE: Square root of the GM for earth where */
876 /* GM is expressed in earth radii cubed per */
877 /* minutes squared. */
878
879 /* GEOPHS(5) = QO: Low altitude bound for atmospheric */
880 /* model in km. */
881
882 /* GEOPHS(6) = SO: High altitude bound for atmospheric */
883 /* model in km. */
884
885 /* GEOPHS(7) = RE: Equatorial radius of the earth in km. */
886
887
888 /* GEOPHS(8) = AE: Distance units/earth radius */
889 /* (normally 1) */
890
891 /* Below are currently recommended values for these */
892 /* items: */
893
894 /* J2 = 1.082616D-3 */
895 /* J3 = -2.53881D-6 */
896 /* J4 = -1.65597D-6 */
897
898 /* The next item is the square root of GM for the */
899 /* earth given in units of earth-radii**1.5/Minute */
900
901 /* KE = 7.43669161D-2 */
902
903 /* The next two items give the top and */
904 /* bottom of the atmospheric drag model */
905 /* used by the type 10 ephemeris type. */
906 /* Don't adjust these unless you understand */
907 /* the full implications of such changes. */
908
909 /* QO = 120.0D0 */
910 /* SO = 78.0D0 */
911
912 /* The following is the equatorial radius */
913 /* of the earth as used by NORAD in km. */
914
915 /* ER = 6378.135D0 */
916
917 /* The value of AE is the number of */
918 /* distance units per earth radii used by */
919 /* the NORAD state propagation software. */
920 /* The value should be 1 unless you've got */
921 /* a very good understanding of the NORAD */
922 /* routine SGP4 and the affect of changing */
923 /* this value.. */
924
925 /* AE = 1.0D0 */
926
927 /* ELEMS is an array containing two-line element data */
928 /* as prescribed below. The elements XNDD6O and BSTAR */
929 /* must already be scaled by the proper exponent stored */
930 /* in the two line elements set. Moreover, the */
931 /* various items must be converted to the units shown */
932 /* here. */
933
934 /* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */
935 /* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */
936 /* ELEMS ( 3 ) = BSTAR */
937 /* ELEMS ( 4 ) = XINCL in radians */
938 /* ELEMS ( 5 ) = XNODEO in radians */
939 /* ELEMS ( 6 ) = EO */
940 /* ELEMS ( 7 ) = OMEGAO in radians */
941 /* ELEMS ( 8 ) = XMO in radians */
942 /* ELEMS ( 9 ) = XNO in radians/minute */
943 /* ELEMS ( 10 ) = EPOCH of the elements in seconds */
944 /* past ephemeris epoch J2000. */
945
946 /* OPMODE Flag indicating which technique */
947 /* to use to calculate sidereal time. */
948
949 /* $ Detailed_Output */
950
951 /* None. */
952
953 /* $ Parameters */
954
955 /* None. */
956
957 /* $ Exceptions */
958
959 /* 1) SPICE(SUBORBITAL) signals if radius of perigee has */
960 /* value less-than 1. */
961
962 /* $ Files */
963
964 /* None. */
965
966 /* $ Particulars */
967
968 /* This routine is based on the SGP4INIT code by David Vallado */
969 /* corresponding to "Revisiting Spacetrack Report #3". */
970 /* The intent is to maintain the original Vallado algorithm, */
971 /* changing code only to meet NAIF format standards and to */
972 /* integrate with SPICELIB. */
973
974 /* 1) Implemented error checks using SPICE error subsystem. */
975 /* On detecting an error, control returns to the calling */
976 /* routine. This behavior differs from the original */
977 /* version. */
978
979 /* 2) Comments prefixed with "SGP4FIX" indicate a comment */
980 /* from the code by Vallado et. al concerning a correction */
981 /* to the STR#3 code. */
982
983 /* 3) Eliminated the use of COMMON blocks. */
984
985 /* Removed getgravconst call, replaced with GEOPHS array. */
986
987 /* xBStar, */
988 /* xEcco, */
989 /* Epoch, */
990 /* xArgpo, */
991 /* xInclo, */
992 /* xMo, */
993 /* xNo, */
994 /* xnodeo replaced with ELEMS array. */
995 /* radiusearthkm replaced with ER */
996
997 /* $ Examples */
998
999 /* Refer to Examples section in ZZSGP4. */
1000
1001 /* $ Restrictions */
1002
1003 /* None. */
1004
1005 /* $ Literature_References */
1006
1007 /* [1] Hoots, F. R., and Roehrich, R. L. 1980. "Models for */
1008 /* Propagation of the NORAD Element Sets." Spacetrack Report #3. */
1009 /* U.S. Air Force: Aerospace Defense Command. */
1010
1011 /* [2] Hoots, Felix R. "Spacetrack Report #6: Models for Propagation */
1012 /* of Space Command Element Sets." Space Command, */
1013 /* U. S. Air Force, CO. */
1014
1015 /* [3] Hoots, Felix R., P. W. Schumacher, and R. A. Glover. 2004. */
1016 /* History of Analytical Orbit Modeling in the U. S. Space */
1017 /* Surveillance System. Journal of Guidance, Control, and */
1018 /* Dynamics. 27(2):174-185. */
1019
1020 /* [4] Vallado, David, Crawford, Paul, Hujsak, Richard, */
1021 /* and Kelso, T.S. 2006. Revisiting Spacetrack Report #3. Paper */
1022 /* AIAA 2006-6753 presented at the AIAA/AAS Astrodynamics */
1023 /* Specialist Conference, August 21-24, 2006. Keystone, CO. */
1024
1025 /* $ Author_and_Institution */
1026
1027 /* David Vallado (AGI) */
1028 /* E. D. Wright (JPL) */
1029
1030 /* $ Version */
1031
1032 /* - SPICELIB Version 1.0.0, DEC-11-2014 (EDW) */
1033
1034 /* Based on routine SGP4INIT, 28-JUN-2005, Vallado 2006 [4]. */
1035
1036 /* -& */
1037 /* $ Index_Entries */
1038
1039 /* SGP4 */
1040
1041 /* -& */
1042
1043 /* Standard SPICE error handling. */
1044
1045 if (return_()) {
1046 return 0;
1047 }
1048 chkin_("XXSGP4I", (ftnlen)7);
1049
1050 /* Initialize. */
1051
1052 dodeep = FALSE_;
1053 dosimp = FALSE_;
1054 svmode = *opmode;
1055
1056 /* This code block replaces the call: */
1057
1058 /* sgp4fix - note the following variables are also passed directly */
1059 /* via sgp4 common. It is possible to streamline the XXSGP4I call */
1060 /* by deleting the "x" variables, but the user would need to set */
1061 /* the common values first. we include the additional assignment */
1062 /* in case twoline2rv is not used. */
1063
1064 /* bstar = xbstar */
1065 /* ecco = xecco */
1066 /* argpo = xargpo */
1067 /* inclo = xinclo */
1068 /* mo = xmo */
1069 /* no = xno */
1070 /* nodeo = xnodeo */
1071 bstar = elems[2];
1072 inclo = elems[3];
1073 nodeo = elems[4];
1074 ecco = elems[5];
1075 argpo = elems[6];
1076 mo = elems[7];
1077 no = elems[8];
1078
1079 /* Remember that sgp4 uses units of days from 0 jan 1950 */
1080 /* (sgp4epoch) and minutes from the epoch (time) */
1081
1082 /* 2433281.5 JD TDB = 1949-12-31 00:00:00.000000 TDB */
1083 /* 2400000.5 JD TDB = 1858-11-17 00:00:00.000000 TDB */
1084
1085 /* 2433281.5 - 2400000.5 = 33281.0 */
1086
1087
1088 /* Convert the J2000 TDB representation of the epoch to */
1089 /* JD UTC then calculate the offset from the JD 2433281.5 UTC */
1090 /* reference. */
1091
1092 tvec[0] = elems[9];
1093 ttrans_("TDB", "JDUTC", tvec, (ftnlen)3, (ftnlen)5);
1094 epoch = tvec[0] - 2433281.5;
1095 if (failed_()) {
1096 chkout_("XXSGP4I", (ftnlen)7);
1097 return 0;
1098 }
1099
1100 /* This code block replaces the call: */
1101
1102 /* CALL getgravconst( whichconst, tumin, */
1103 /* . mu, radiusearthkm, xke, */
1104 /* . j2, j3, j4, j3oj2 ) */
1105
1106 j2 = geophs[0];
1107 j3 = geophs[1];
1108 j4 = geophs[2];
1109 er = geophs[6];
1110 xke = geophs[3];
1111 tumin = 1. / geophs[3];
1112 j3oj2 = j3 / j2;
1113
1114 /* The following assignment and IF block is taken */
1115 /* from TWOLINE2RVSGP4. */
1116
1117 d__1 = no * tumin;
1118 a = pow_dd(&d__1, &c_b10);
1119 if ((d__1 = ecco - 1., abs(d__1)) > 1e-6) {
1120 altp = a * (1. - ecco) - 1.;
1121 alta = a * (ecco + 1.) - 1.;
1122 } else {
1123 alta = 999999.9;
1124 d__1 = no * no;
1125 altp = 4. / pow_dd(&d__1, &c_b11) * 2.;
1126 }
1127 ss = 78. / er + 1.;
1128 /* Computing 4th power */
1129 d__1 = 42. / er, d__1 *= d__1;
1130 qzms2t = d__1 * d__1;
1131 x2o3 = .66666666666666663;
1132
1133 /* sgp4fix divisor for divide by zero check on inclination */
1134 /* the old check used 1.0D0 + cos(pi-1.0D-9), but then compared */
1135 /* it to 1.5D-12, so the threshold was changed to 1.5D-12 for */
1136 /* consistency. */
1137
1138 temp4 = 1.5e-12;
1139 tzero = 0.;
1140 doinit = TRUE_;
1141 zzinil_(geophs, opmode, &ecco, &epoch, &inclo, &no, &ainv, &ao, &con41, &
1142 con42, &cosio, &cosio2, &eccsq, &omeosq, &posq, &rp, &rteosq, &
1143 sinio, &gsto);
1144 if (failed_()) {
1145 chkout_("XXSGP4I", (ftnlen)7);
1146 return 0;
1147 }
1148
1149 /* Check RP for a reasonable value. The propagator may not */
1150 /* calculate correct state values for RP < 1. */
1151
1152 if (rp < 1.) {
1153 setmsg_("TLE elements suborbital.", (ftnlen)24);
1154 sigerr_("SPICE(SUBORBITAL)", (ftnlen)17);
1155 chkout_("XXSGP4I", (ftnlen)7);
1156 return 0;
1157 }
1158
1159 /* If nodeo and No are gtr 0 */
1160
1161 if (omeosq >= 0. || no >= 0.) {
1162 dosimp = FALSE_;
1163 if (rp < 220. / er + 1.) {
1164 dosimp = TRUE_;
1165 }
1166 sfour = ss;
1167 qzms24 = qzms2t;
1168 perige = (rp - 1.) * er;
1169
1170 /* For perigees below 156 km, S and Qoms2t are altered. */
1171
1172 if (perige < 156.) {
1173 sfour = perige - 78.;
1174 if (perige <= 98.) {
1175 sfour = 20.;
1176 }
1177 /* Computing 4th power */
1178 d__1 = (120. - sfour) / er, d__1 *= d__1;
1179 qzms24 = d__1 * d__1;
1180 sfour = sfour / er + 1.;
1181 }
1182 pinvsq = 1. / posq;
1183 tsi = 1. / (ao - sfour);
1184 eta = ao * ecco * tsi;
1185 etasq = eta * eta;
1186 eeta = ecco * eta;
1187 psisq = (d__1 = 1. - etasq, abs(d__1));
1188 /* Computing 4th power */
1189 d__1 = tsi, d__1 *= d__1;
1190 coef = qzms24 * (d__1 * d__1);
1191 coef1 = coef / pow_dd(&psisq, &c_b16);
1192 cc2 = coef1 * no * (ao * (etasq * 1.5 + 1. + eeta * (etasq + 4.)) +
1193 j2 * .375 * tsi / psisq * con41 * (etasq * 3. * (etasq + 8.)
1194 + 8.));
1195 cc1 = bstar * cc2;
1196 cc3 = 0.;
1197 if (ecco > 1e-4) {
1198 cc3 = coef * -2. * tsi * j3oj2 * no * sinio / ecco;
1199 }
1200 x1mth2 = 1. - cosio2;
1201 cc4 = no * 2. * coef1 * ao * omeosq * (eta * (etasq * .5 + 2.) + ecco
1202 * (etasq * 2. + .5) - j2 * tsi / (ao * psisq) * (con41 * -3. *
1203 (1. - eeta * 2. + etasq * (1.5 - eeta * .5)) + x1mth2 * .75 *
1204 (etasq * 2. - eeta * (etasq + 1.)) * cos(argpo * 2.)));
1205 cc5 = coef1 * 2. * ao * omeosq * ((etasq + eeta) * 2.75 + 1. + eeta *
1206 etasq);
1207 cosio4 = cosio2 * cosio2;
1208 temp1 = j2 * 1.5 * pinvsq * no;
1209 temp2 = temp1 * .5 * j2 * pinvsq;
1210 temp3 = j4 * -.46875 * pinvsq * pinvsq * no;
1211 mdot = no + temp1 * .5 * rteosq * con41 + temp2 * .0625 * rteosq * (
1212 13. - cosio2 * 78. + cosio4 * 137.);
1213 argpdot = temp1 * -.5 * con42 + temp2 * .0625 * (7. - cosio2 * 114. +
1214 cosio4 * 395.) + temp3 * (3. - cosio2 * 36. + cosio4 * 49.);
1215 xhdot1 = -temp1 * cosio;
1216 nodedot = xhdot1 + (temp2 * .5 * (4. - cosio2 * 19.) + temp3 * 2. * (
1217 3. - cosio2 * 7.)) * cosio;
1218 xpidot = argpdot + nodedot;
1219 omgcof = bstar * cc3 * cos(argpo);
1220 xmcof = 0.;
1221 if (ecco > 1e-4) {
1222 xmcof = -x2o3 * coef * bstar / eeta;
1223 }
1224 xnodcf = omeosq * 3.5 * xhdot1 * cc1;
1225 t2cof = cc1 * 1.5;
1226
1227 /* sgp4fix for divide by zero with xinco = 180 deg. */
1228
1229 if ((d__1 = cosio + 1., abs(d__1)) > 1.5e-12) {
1230 xlcof = j3oj2 * -.25 * sinio * (cosio * 5. + 3.) / (cosio + 1.);
1231 } else {
1232 xlcof = j3oj2 * -.25 * sinio * (cosio * 5. + 3.) / temp4;
1233 }
1234 aycof = j3oj2 * -.5 * sinio;
1235 /* Computing 3rd power */
1236 d__1 = eta * cos(mo) + 1.;
1237 delmo = d__1 * (d__1 * d__1);
1238 sinmao = sin(mo);
1239 x7thm1 = cosio2 * 7. - 1.;
1240
1241 /* Deep Space Initialization */
1242
1243 if (twopi_() / no >= 225.) {
1244 dodeep = TRUE_;
1245 dosimp = TRUE_;
1246 tc = 0.;
1247 inclm = inclo;
1248
1249 /* Common. */
1250
1251 zzdscm_(&epoch, &ecco, &argpo, &tc, &inclo, &nodeo, &no, &snodm, &
1252 cnodm, &sinim, &cosim, &sinomm, &cosomm, &day, &e3, &ee2,
1253 &eccm, &emsq, &gam, &peo, &pgho, &pho, &pinco, &plo, &
1254 rtemsq, &se2, &se3, &sgh2, &sgh3, &sgh4, &sh2, &sh3, &si2,
1255 &si3, &sl2, &sl3, &sl4, &s1, &s2, &s3, &s4, &s5, &s6, &
1256 s7, &ss1, &ss2, &ss3, &ss4, &ss5, &ss6, &ss7, &sz1, &sz2,
1257 &sz3, &sz11, &sz12, &sz13, &sz21, &sz22, &sz23, &sz31, &
1258 sz32, &sz33, &xgh2, &xgh3, &xgh4, &xh2, &xh3, &xi2, &xi3,
1259 &xl2, &xl3, &xl4, &xn, &z1, &z2, &z3, &z11, &z12, &z13, &
1260 z21, &z22, &z23, &z31, &z32, &z33, &zmol, &zmos);
1261
1262 /* Long period perturbations. */
1263
1264 zzdspr_(opmode, &e3, &ee2, &peo, &pgho, &pho, &pinco, &plo, &se2,
1265 &se3, &sgh2, &sgh3, &sgh4, &sh2, &sh3, &si2, &si3, &sl2, &
1266 sl3, &sl4, &tzero, &xgh2, &xgh3, &xgh4, &xh2, &xh3, &xi2,
1267 &xi3, &xl2, &xl3, &xl4, &zmol, &zmos, &inclm, &doinit, &
1268 ecco, &inclo, &nodeo, &argpo, &mo);
1269 argpm = 0.;
1270 nodem = 0.;
1271 mm = 0.;
1272
1273 /* Initialization */
1274
1275 zzdsin_(geophs, &cosim, &emsq, &argpo, &s1, &s2, &s3, &s4, &s5, &
1276 sinim, &ss1, &ss2, &ss3, &ss4, &ss5, &sz1, &sz3, &sz11, &
1277 sz13, &sz21, &sz23, &sz31, &sz33, &tzero, &tc, &gsto, &mo,
1278 &mdot, &no, &nodeo, &nodedot, &xpidot, &z1, &z3, &z11, &
1279 z13, &z21, &z23, &z31, &z33, &ecco, &eccsq, &eccm, &argpm,
1280 &inclm, &mm, &xn, &nodem, &irez, &atime, &d2201, &d2211,
1281 &d3210, &d3222, &d4410, &d4422, &d5220, &d5232, &d5421, &
1282 d5433, &dedt, &didt, &dmdt, &dndt, &dnodt, &domdt, &del1,
1283 &del2, &del3, &xfact, &xlamo, &xli, &xni);
1284 }
1285
1286 /* Set variables if not deep space or rp < 220 */
1287
1288 if (! dosimp) {
1289 cc1sq = cc1 * cc1;
1290 d2 = ao * 4. * tsi * cc1sq;
1291 temp = d2 * tsi * cc1 / 3.;
1292 d3 = (ao * 17. + sfour) * temp;
1293 d4 = temp * .5 * ao * tsi * (ao * 221. + sfour * 31.) * cc1;
1294 t3cof = d2 + cc1sq * 2.;
1295 t4cof = (d3 * 3. + cc1 * (d2 * 12. + cc1sq * 10.)) * .25;
1296 t5cof = (d4 * 3. + cc1 * 12. * d3 + d2 * 6. * d2 + cc1sq * 15. * (
1297 d2 * 2. + cc1sq)) * .2;
1298 }
1299 }
1300 doinit = FALSE_;
1301 chkout_("XXSGP4I", (ftnlen)7);
1302 return 0;
1303 /* $Procedure XXSGP4E ( SGP4 evaluator ) */
1304
1305 L_xxsgp4e:
1306 /* $ Abstract */
1307
1308 /* This procedure is the SGP4 prediction model from Space Command. */
1309 /* This is an updated and combined version of SGP4 and SDP4 */
1310 /* originally published separately in Spacetrack report #3 [1]. */
1311 /* This version follows the methodology from the 2006 AIAA */
1312 /* Vallado paper [4] describing the history and development of */
1313 /* \the code. */
1314
1315 /* $ Disclaimer */
1316
1317 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
1318 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
1319 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
1320 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
1321 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
1322 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
1323 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
1324 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
1325 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
1326 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
1327
1328 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
1329 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
1330 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
1331 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
1332 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
1333 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
1334
1335 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
1336 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
1337 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
1338 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
1339
1340 /* $ Required_Reading */
1341
1342 /* None. */
1343
1344 /* $ Keywords */
1345
1346 /* TLE */
1347 /* Two line elements */
1348
1349 /* $ Declarations */
1350
1351 /* Refer to Declarations section in ZZSGP4. */
1352
1353 /* $ Brief_I/O */
1354
1355 /* Variable I/O Description */
1356 /* -------- --- -------------------------------------------------- */
1357 /* T I Time to evaluate state in minutes from epoch */
1358 /* STATE O Evaluated state */
1359
1360 /* $ Detailed_Input */
1361
1362
1363 /* T The time in minutes from the elements epoch */
1364 /* at which to calculate a state from the */
1365 /* TLE set. */
1366
1367 /* $ Detailed_Output */
1368
1369 /* STATE the state produced by evaluating the input elements */
1370 /* at the input epoch T. Units are km and km/sec. */
1371
1372 /* $ Parameters */
1373
1374 /* None. */
1375
1376 /* $ Exceptions */
1377
1378 /* 1) SPICE(BADMEANMOTION) Mean motion less than 0.0 */
1379
1380 /* 2) SPICE(BADMECCENTRICITY) signals when the mean eccentricity is */
1381 /* not bounded by [-0.001, 1]. */
1382
1383 /* 3) SPICE(BADMSEMIMAJOR) signals when the mean semimajor axis */
1384 /* has value less-than .95. */
1385
1386 /* 4) SPICE(BADPECCENTRICITY) signals when the perturbed eccentricity */
1387 /* is not bounded by [0, 1]. */
1388
1389 /* 5) SPICE(BADSEMILATUS) signals when the semi-latus rectum */
1390 /* has value less-than 0. */
1391
1392 /* 6) SPICE(ORBITDECAY) signals if the scaled orbit radial */
1393 /* distance has value less-than 1. */
1394
1395 /* $ Files */
1396
1397 /* None. */
1398
1399 /* $ Particulars */
1400
1401 /* This routine is based on the SGP4 code by David Vallado */
1402 /* corresponding to "Revisiting Spacetrack Report #3." */
1403 /* The intent is to maintain the original Vallado algorithm, */
1404 /* changing code only to meet NAIF format standards and to */
1405 /* integrate with SPICELIB. */
1406
1407 /* 1) Implemented error checks using SPICE error subsystem. */
1408 /* On detecting an error, control returns to the calling */
1409 /* routine. This behavior differs from the original */
1410 /* version. */
1411
1412 /* 2) Comments prefixed with "SGP4FIX" indicate a comment */
1413 /* from the code by Vallado et. al concerning a correction */
1414 /* to the STR#3 code. */
1415
1416 /* 3) Eliminated the use of COMMON blocks. */
1417
1418 /* Removed getgravconst call, replaced with GEOPHS array. */
1419
1420 /* Capitalize all variables. */
1421
1422 /* radiusearthkm replaced with ER */
1423 /* VKmPerSec replaced with KPS */
1424 /* r, v replaced with STATE */
1425 /* method replaced with DODEEP */
1426 /* isimp replaced with DOSIMP */
1427 /* Error eliminated */
1428 /* whichconst eliminated, function provided by GEOPHS */
1429
1430 /* $ Examples */
1431
1432 /* Refer to Examples section in ZZSGP4. */
1433
1434 /* $ Restrictions */
1435
1436 /* None. */
1437
1438 /* $ Literature_References */
1439
1440 /* [1] Hoots, F. R., and Roehrich, R. L. 1980. "Models for */
1441 /* Propagation of the NORAD Element Sets." Spacetrack Report #3. */
1442 /* U.S. Air Force: Aerospace Defense Command. */
1443
1444 /* [2] Hoots, Felix R. "Spacetrack Report #6: Models for Propagation */
1445 /* of Space Command Element Sets." Space Command, */
1446 /* U. S. Air Force, CO. */
1447
1448 /* [3] Hoots, Felix R., P. W. Schumacher, and R. A. Glover. 2004. */
1449 /* History of Analytical Orbit Modeling in the U. S. Space */
1450 /* Surveillance System. Journal of Guidance, Control, and */
1451 /* Dynamics. 27(2):174-185. */
1452
1453 /* [4] Vallado, David, Crawford, Paul, Hujsak, Richard, */
1454 /* and Kelso, T.S. 2006. Revisiting Spacetrack Report #3. Paper */
1455 /* AIAA 2006-6753 presented at the AIAA/AAS Astrodynamics */
1456 /* Specialist Conference, August 21-24, 2006. Keystone, CO. */
1457
1458 /* $ Author_and_Institution */
1459
1460 /* David Vallado (AGI) */
1461 /* E. D. Wright (JPL) */
1462
1463 /* $ Version */
1464
1465 /* - SPICELIB Version 1.0.0, SEP-15-2014 (EDW) */
1466
1467 /* Based on routine SGP4, 28-JUN-2005 [4]. */
1468
1469 /* -& */
1470 /* $ Index_Entries */
1471
1472 /* SGP4 */
1473
1474 /* -& */
1475
1476 /* Standard SPICE error handling. */
1477
1478 if (return_()) {
1479 return 0;
1480 }
1481 chkin_("XXSGP4E", (ftnlen)7);
1482
1483 /* Local constants. Keep compiler ok for warnings on */
1484 /* uninitialized variables */
1485
1486 x2o3 = .66666666666666663;
1487 mr = 0.;
1488 coseo1 = 1.;
1489 sineo1 = 0.;
1490
1491 /* Set mathematical constants. */
1492
1493 /* This code block replaces the call: */
1494
1495 /* sgp4fix identify constants and allow alternate values. */
1496
1497 /* CALL getgravconst( whichconst, tumin, */
1498 /* . mu, radiusearthkm, xke, */
1499 /* . j2, j3, j4, j3oj2 ) */
1500
1501
1502 /* sgp4fix divisor for divide by zero check on inclination */
1503 /* the old check used 1.0D0 + cos(pi-1.0D-9), but then compared it to */
1504 /* 1.5D-12, so the threshold was changed to 1.5D-12 for consistency. */
1505
1506 temp4 = 1.5e-12;
1507 kps = er * xke / 60.;
1508
1509 /* UPDATE FOR SECULAR GRAVITY AND ATMOSPHERIC DRAG */
1510
1511 xmdf = mo + mdot * *t;
1512 omgadf = argpo + argpdot * *t;
1513 xnoddf = nodeo + nodedot * *t;
1514 argpm = omgadf;
1515 mm = xmdf;
1516 t2 = *t * *t;
1517 nodem = xnoddf + xnodcf * t2;
1518 tempa = 1. - cc1 * *t;
1519 tempe = bstar * cc4 * *t;
1520 templ = t2cof * t2;
1521 if (! dosimp) {
1522 delomg = omgcof * *t;
1523 /* Computing 3rd power */
1524 d__1 = eta * cos(xmdf) + 1.;
1525 delm = xmcof * (d__1 * (d__1 * d__1) - delmo);
1526 temp = delomg + delm;
1527 mm = xmdf + temp;
1528 argpm = omgadf - temp;
1529 t3 = t2 * *t;
1530 t4 = t3 * *t;
1531 tempa = tempa - d2 * t2 - d3 * t3 - d4 * t4;
1532 tempe += bstar * cc5 * (sin(mm) - sinmao);
1533 templ = templ + t3cof * t3 + t4 * (t4cof + *t * t5cof);
1534 }
1535 xn = no;
1536 eccm = ecco;
1537 inclm = inclo;
1538 if (dodeep) {
1539 tc = *t;
1540 zzdspc_(&irez, &d2201, &d2211, &d3210, &d3222, &d4410, &d4422, &d5220,
1541 &d5232, &d5421, &d5433, &dedt, &del1, &del2, &del3, &didt, &
1542 dmdt, &dnodt, &domdt, &argpo, &argpdot, t, &tc, &gsto, &xfact,
1543 &xlamo, &no, &atime, &eccm, &argpm, &inclm, &xli, &mm, &xni,
1544 &nodem, &dndt, &xn);
1545 }
1546
1547 /* Mean motion less than 0.0. */
1548
1549 if (xn <= 0.) {
1550 setmsg_("Mean motion less-than zero. This error may indicate a bad T"
1551 "LE set.", (ftnlen)66);
1552 sigerr_("SPICE(BADMEANMOTION)", (ftnlen)20);
1553 chkout_("XXSGP4E", (ftnlen)7);
1554 return 0;
1555 }
1556 d__1 = xke / xn;
1557 /* Computing 2nd power */
1558 d__2 = tempa;
1559 am = pow_dd(&d__1, &x2o3) * (d__2 * d__2);
1560 xn = xke / pow_dd(&am, &c_b22);
1561 eccm -= tempe;
1562
1563 /* Fix tolerance for error recognition. Vallado code used */
1564 /* a lower limit of -0.001. This value apparently prevents */
1565 /* an error signal due to roundoff error. */
1566
1567 if (eccm >= 1. || eccm < -.001) {
1568 setmsg_("Mean eccentricity value, #, beyond allowed bounds [-0.001,1"
1569 ".0). This error may indicate a bad TLE set.", (ftnlen)102);
1570 errdp_("#", &eccm, (ftnlen)1);
1571 sigerr_("SPICE(BADMECCENTRICITY)", (ftnlen)23);
1572 chkout_("XXSGP4E", (ftnlen)7);
1573 return 0;
1574 }
1575 if (am < .95f) {
1576 setmsg_("Mean semi-major axis value, #, below allowed minimum of 0.9"
1577 "5. This error may indicate a bad TLE set or a decayed orbit.",
1578 (ftnlen)119);
1579 errdp_("#", &eccm, (ftnlen)1);
1580 sigerr_("SPICE(BADMSEMIMAJOR)", (ftnlen)20);
1581 chkout_("XXSGP4E", (ftnlen)7);
1582 return 0;
1583 }
1584
1585 /* sgp4fix change test condition for eccentricity */
1586
1587 if (eccm < 1e-6) {
1588 eccm = 1e-6;
1589 }
1590 mm += no * templ;
1591 xlm = mm + argpm + nodem;
1592 emsq = eccm * eccm;
1593 temp = 1. - emsq;
1594 d__1 = twopi_();
1595 nodem = d_mod(&nodem, &d__1);
1596 d__1 = twopi_();
1597 argpm = d_mod(&argpm, &d__1);
1598 d__1 = twopi_();
1599 xlm = d_mod(&xlm, &d__1);
1600 d__1 = xlm - argpm - nodem;
1601 d__2 = twopi_();
1602 mm = d_mod(&d__1, &d__2);
1603
1604 /* Compute extra mean quantities */
1605
1606 sinim = sin(inclm);
1607 cosim = cos(inclm);
1608
1609 /* Add lunar-solar periodics */
1610
1611 eccp = eccm;
1612 xincp = inclm;
1613 argpp = argpm;
1614 nodep = nodem;
1615 mp = mm;
1616 sinip = sinim;
1617 cosip = cosim;
1618
1619 /* Use deep space perturbation if indicated. */
1620
1621 if (dodeep) {
1622 zzdspr_(&svmode, &e3, &ee2, &peo, &pgho, &pho, &pinco, &plo, &se2, &
1623 se3, &sgh2, &sgh3, &sgh4, &sh2, &sh3, &si2, &si3, &sl2, &sl3,
1624 &sl4, t, &xgh2, &xgh3, &xgh4, &xh2, &xh3, &xi2, &xi3, &xl2, &
1625 xl3, &xl4, &zmol, &zmos, &inclo, &c_false, &eccp, &xincp, &
1626 nodep, &argpp, &mp);
1627 if (xincp < 0.) {
1628 xincp = -xincp;
1629 nodep += pi_();
1630 argpp -= pi_();
1631 }
1632 if (eccp < 0. || eccp > 1.) {
1633 setmsg_("Perturbed eccentricity value, #, beyond allowed bounds "
1634 "[0,1]. This error may indicate a bad TLE set.", (ftnlen)
1635 100);
1636 errdp_("#", &eccp, (ftnlen)1);
1637 sigerr_("SPICE(BADPECCENTRICITY)", (ftnlen)23);
1638 chkout_("XXSGP4E", (ftnlen)7);
1639 return 0;
1640 }
1641 }
1642
1643 /* Update for long period periodics if a deep space trajectory. */
1644
1645 if (dodeep) {
1646 sinip = sin(xincp);
1647 cosip = cos(xincp);
1648 aycof = j3oj2 * -.5 * sinip;
1649
1650 /* sgp4fix for divide by zero with xincp = 180 deg */
1651
1652 if ((d__1 = cosip + 1., abs(d__1)) > 1.5e-12) {
1653 xlcof = j3oj2 * -.25 * sinip * (cosip * 5. + 3.) / (cosip + 1.);
1654 } else {
1655 xlcof = j3oj2 * -.25 * sinip * (cosip * 5. + 3.) / temp4;
1656 }
1657 }
1658 axnl = eccp * cos(argpp);
1659 temp = 1. / (am * (1. - eccp * eccp));
1660 aynl = eccp * sin(argpp) + temp * aycof;
1661 xl = mp + argpp + nodep + temp * xlcof * axnl;
1662
1663 /* Solve Kepler's equation. */
1664
1665 d__1 = xl - nodep;
1666 d__2 = twopi_();
1667 u = d_mod(&d__1, &d__2);
1668 eo1 = u;
1669 iter = 0;
1670
1671 /* sgp4fix for Kepler iteration the following iteration needs */
1672 /* better limits on corrections */
1673
1674 temp = 9999.9;
1675 while(temp >= 1e-12 && iter < 10) {
1676 ++iter;
1677 sineo1 = sin(eo1);
1678 coseo1 = cos(eo1);
1679 tem5 = 1. - coseo1 * axnl - sineo1 * aynl;
1680 tem5 = (u - aynl * coseo1 + axnl * sineo1 - eo1) / tem5;
1681 temp = abs(tem5);
1682
1683 /* Stop excessive correction. */
1684
1685 if (temp > 1.) {
1686 tem5 /= temp;
1687 }
1688 eo1 += tem5;
1689 }
1690
1691 /* Short period preliminary quantities. */
1692
1693 ecose = axnl * coseo1 + aynl * sineo1;
1694 esine = axnl * sineo1 - aynl * coseo1;
1695 el2 = axnl * axnl + aynl * aynl;
1696 pl = am * (1. - el2);
1697
1698 /* Error check for semi-latus rectum < 0.0 */
1699
1700 if (pl < 0.) {
1701 setmsg_("Semi-latus rectum less-than zero.", (ftnlen)33);
1702 sigerr_("SPICE(BADSEMILATUS)", (ftnlen)19);
1703 chkout_("XXSGP4E", (ftnlen)7);
1704 return 0;
1705 }
1706 rl = am * (1. - ecose);
1707 rdotl = sqrt(am) * esine / rl;
1708 rvdotl = sqrt(pl) / rl;
1709 betal = sqrt(1. - el2);
1710 temp = esine / (betal + 1.);
1711 sinu = am / rl * (sineo1 - aynl - axnl * temp);
1712 cosu = am / rl * (coseo1 - axnl + aynl * temp);
1713 su = atan2(sinu, cosu);
1714 sin2u = (cosu + cosu) * sinu;
1715 cos2u = 1. - sinu * 2. * sinu;
1716 temp = 1. / pl;
1717 temp1 = j2 * .5 * temp;
1718 temp2 = temp1 * temp;
1719
1720 /* Update for short period periodics if a deep space trajectory. */
1721
1722 if (dodeep) {
1723 cosisq = cosip * cosip;
1724 con41 = cosisq * 3. - 1.;
1725 x1mth2 = 1. - cosisq;
1726 x7thm1 = cosisq * 7. - 1.;
1727 }
1728 mr = rl * (1. - temp2 * 1.5 * betal * con41) + temp1 * .5 * x1mth2 *
1729 cos2u;
1730 su -= temp2 * .25 * x7thm1 * sin2u;
1731 xnode = nodep + temp2 * 1.5 * cosip * sin2u;
1732 xinc = xincp + temp2 * 1.5 * cosip * sinip * cos2u;
1733 mv = rdotl - xn * temp1 * x1mth2 * sin2u / xke;
1734 rvdot = rvdotl + xn * temp1 * (x1mth2 * cos2u + con41 * 1.5) / xke;
1735
1736 /* Orientation vectors. */
1737
1738 sinsu = sin(su);
1739 cossu = cos(su);
1740 snod = sin(xnode);
1741 cnod = cos(xnode);
1742 sini = sin(xinc);
1743 cosi = cos(xinc);
1744 xmx = -snod * cosi;
1745 xmy = cnod * cosi;
1746 ux = xmx * sinsu + cnod * cossu;
1747 uy = xmy * sinsu + snod * cossu;
1748 uz = sini * sinsu;
1749 vx = xmx * cossu - cnod * sinsu;
1750 vy = xmy * cossu - snod * sinsu;
1751 vz = sini * cossu;
1752
1753 /* Position and velocity. */
1754
1755 state[0] = mr * ux * er;
1756 state[1] = mr * uy * er;
1757 state[2] = mr * uz * er;
1758 state[3] = (mv * ux + rvdot * vx) * kps;
1759 state[4] = (mv * uy + rvdot * vy) * kps;
1760 state[5] = (mv * uz + rvdot * vz) * kps;
1761
1762 /* sgp4fix for decaying satellites */
1763
1764 /* Place this test here to ensure evaluation of STATE. */
1765 /* The result may be physically invalid. */
1766
1767 if (mr < 1.) {
1768 setmsg_("Satellite has decayed.", (ftnlen)22);
1769 sigerr_("SPICE(ORBITDECAY)", (ftnlen)17);
1770 chkout_("XXSGP4E", (ftnlen)7);
1771 return 0;
1772 }
1773 chkout_("XXSGP4E", (ftnlen)7);
1774 return 0;
1775 } /* zzsgp4_ */
1776
zzsgp4_(doublereal * geophs,doublereal * elems,integer * opmode,doublereal * t,doublereal * state)1777 /* Subroutine */ int zzsgp4_(doublereal *geophs, doublereal *elems, integer *
1778 opmode, doublereal *t, doublereal *state)
1779 {
1780 return zzsgp4_0_(0, geophs, elems, opmode, t, state);
1781 }
1782
xxsgp4i_(doublereal * geophs,doublereal * elems,integer * opmode)1783 /* Subroutine */ int xxsgp4i_(doublereal *geophs, doublereal *elems, integer *
1784 opmode)
1785 {
1786 return zzsgp4_0_(1, geophs, elems, opmode, (doublereal *)0, (doublereal *)
1787 0);
1788 }
1789
xxsgp4e_(doublereal * t,doublereal * state)1790 /* Subroutine */ int xxsgp4e_(doublereal *t, doublereal *state)
1791 {
1792 return zzsgp4_0_(2, (doublereal *)0, (doublereal *)0, (integer *)0, t,
1793 state);
1794 }
1795
1796