1 /* zzdspc.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 /* $Procedure ZZDSPC ( SGP4 deep space routine ) */
zzdspc_(integer * irez,doublereal * d2201,doublereal * d2211,doublereal * d3210,doublereal * d3222,doublereal * d4410,doublereal * d4422,doublereal * d5220,doublereal * d5232,doublereal * d5421,doublereal * d5433,doublereal * dedt,doublereal * del1,doublereal * del2,doublereal * del3,doublereal * didt,doublereal * dmdt,doublereal * dnodt,doublereal * domdt,doublereal * argpo,doublereal * argpdot,doublereal * t,doublereal * tc,doublereal * gsto,doublereal * xfact,doublereal * xlamo,doublereal * no,doublereal * atime,doublereal * eccm,doublereal * argpm,doublereal * inclm,doublereal * xli,doublereal * mm,doublereal * xni,doublereal * nodem,doublereal * dndt,doublereal * xn)9 /* Subroutine */ int zzdspc_(integer *irez, doublereal *d2201, doublereal *
10 d2211, doublereal *d3210, doublereal *d3222, doublereal *d4410,
11 doublereal *d4422, doublereal *d5220, doublereal *d5232, doublereal *
12 d5421, doublereal *d5433, doublereal *dedt, doublereal *del1,
13 doublereal *del2, doublereal *del3, doublereal *didt, doublereal *
14 dmdt, doublereal *dnodt, doublereal *domdt, doublereal *argpo,
15 doublereal *argpdot, doublereal *t, doublereal *tc, doublereal *gsto,
16 doublereal *xfact, doublereal *xlamo, doublereal *no, doublereal *
17 atime, doublereal *eccm, doublereal *argpm, doublereal *inclm,
18 doublereal *xli, doublereal *mm, doublereal *xni, doublereal *nodem,
19 doublereal *dndt, doublereal *xn)
20 {
21 /* System generated locals */
22 doublereal d__1, d__2;
23
24 /* Builtin functions */
25 double d_mod(doublereal *, doublereal *), sin(doublereal), cos(doublereal)
26 ;
27
28 /* Local variables */
29 doublereal delt;
30 integer iret;
31 doublereal xndt, xomi, fasx2, fasx4, fasx6, step2, x2omi;
32 extern /* Subroutine */ int chkin_(char *, ftnlen);
33 doublereal theta, xnddt;
34 integer iretn;
35 doublereal stepn, xldot, rptim, stepp;
36 extern doublereal twopi_(void);
37 doublereal g22, g32, g52, g44, g54, ft, xl;
38 extern /* Subroutine */ int chkout_(char *, ftnlen);
39 extern logical return_(void);
40 doublereal x2li;
41
42 /* $ Abstract */
43
44 /* This subroutine provides deep space contributions to mean */
45 /* elements for perturbing third body. These effects have been */
46 /* averaged over one revolution of the sun and moon. For earth */
47 /* resonance effects, the effects have been averaged over NO */
48 /* revolutions of the satellite. */
49
50 /* $ Disclaimer */
51
52 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
53 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
54 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
55 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
56 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
57 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
58 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
59 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
60 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
61 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
62
63 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
64 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
65 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
66 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
67 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
68 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
69
70 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
71 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
72 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
73 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
74
75 /* $ Required_Reading */
76
77 /* None. */
78
79 /* $ Keywords */
80
81 /* None. */
82
83 /* $ Declarations */
84 /* $ Brief_I/O */
85
86 /* See Detailed_input and Detailed_Output. */
87
88 /* $ Detailed_Input */
89
90 /* D2201 D coeffcients */
91
92 /* D2211 ... */
93
94 /* D3210 ... */
95
96 /* D3222 ... */
97
98 /* D4410 ... */
99
100 /* D4422 ... */
101
102 /* D5220 ... */
103
104 /* D5232 ... */
105
106 /* D5421 ... */
107
108 /* D5433 ... */
109
110 /* DEDT Internal SGD4 parameter. */
111
112 /* DEL1 Internal SGD4 parameter. */
113
114 /* DEL2 Internal SGD4 parameter. */
115
116 /* DEL3 Internal SGD4 parameter. */
117
118 /* DIDT Internal SGD4 parameter. */
119
120 /* DMDT Internal SGD4 parameter. */
121
122 /* DNODT Internal SGD4 parameter. */
123
124 /* DOMDT Internal SGD4 parameter. */
125
126 /* IREZ Flag for resonance: 0-none, 1-one day, 2-half day */
127 /* . */
128 /* ARGPO Argument of perigee */
129
130 /* ARGPDOT Argument of perigee dot (rate) */
131
132 /* T Time of evaluation. */
133
134 /* TC Internal SGD4 parameter. */
135
136 /* GSTO Grenwich Sidereal Time */
137
138 /* XFACT Internal SGD4 parameter. */
139
140 /* XLAMO Internal SGD4 parameter. */
141
142 /* NO Mean motion. */
143
144 /* ATIME Internal SGD4 parameter. */
145
146 /* EM Eccentricity. */
147
148 /* FT Internal SGD4 parameter. */
149
150 /* ARGPM Argument of perigee */
151
152 /* INCLM Inclination. */
153
154 /* XLI Internal SGD4 parameter. */
155
156 /* MM Mean anomaly. */
157
158 /* XNI Mean motion. */
159
160 /* NODEM Right ascension of ascending node */
161
162 /* $ Detailed_Output */
163
164 /* ATIME Internal SGD4 parameter. */
165
166 /* EM Calculated mean eccentricity. */
167
168 /* ARGPM Calculated mean argument of perigee. */
169
170 /* INCLM Calculated mean inclination. */
171
172 /* XLI Internal SGD4 parameter. */
173
174 /* MM Calculated mean anomaly. */
175
176 /* XNI Calculated mean motion. */
177
178 /* NODEM Calculated mean right ascension of */
179 /* ascending node. */
180
181 /* DNDT Value XN-NO. */
182
183 /* NM Calculated mean motion. */
184
185 /* $ Parameters */
186
187 /* None. */
188
189 /* $ Exceptions */
190
191 /* None. */
192
193 /* $ Files */
194
195 /* None. */
196
197 /* $ Particulars */
198
199 /* This routine is based on the DSPACE code by David Vallado */
200 /* corresponding to "Revisiting Spacetrack Report #3" [4]. */
201 /* The intent is to maintain the original Vallado algorithm, */
202 /* changing code only to meet NAIF format standards and to */
203 /* integrate with SPICELIB. */
204
205 /* Capitalize all variables. */
206
207 /* ENDIF replaced with END IF. */
208
209 /* ENDDO replaced with END DO. */
210
211 /* $ Examples */
212
213 /* None. */
214
215 /* $ Restrictions */
216
217 /* None. */
218
219 /* $ Literature_References */
220
221 /* [1] Hoots, F. R., and Roehrich, R. L. 1980. "Models for */
222 /* Propagation of the NORAD Element Sets." Spacetrack Report #3. */
223 /* U.S. Air Force: Aerospace Defense Command. */
224
225 /* [2] Hoots, Felix R. "Spacetrack Report #6: Models for Propagation */
226 /* of Space Command Element Sets." Space Command, */
227 /* U. S. Air Force, CO. */
228
229 /* [3] Hoots, Felix R., P. W. Schumacher, and R. A. Glover. 2004. */
230 /* History of Analytical Orbit Modeling in the U. S. Space */
231 /* Surveillance System. Journal of Guidance, Control, and */
232 /* Dynamics. 27(2):174-185. */
233
234 /* [4] Vallado, David, Crawford, Paul, Hujsak, Richard, */
235 /* and Kelso, T.S. 2006. Revisiting Spacetrack Report #3. Paper */
236 /* AIAA 2006-6753 presented at the AIAA/AAS Astrodynamics */
237 /* Specialist Conference, August 21-24, 2006. Keystone, CO. */
238
239 /* $ Author_and_Institution */
240
241 /* David Vallado (AGI) */
242 /* E. D. Wright (JPL) */
243
244 /* $ Version */
245
246 /* - SPICELIB Version 1.0.0, OCT-14-2014 (EDW) */
247
248 /* Based on routine DPSPACE, 28-JUN-2005, Vallado 2006 [4]. */
249
250 /* -& */
251 /* $ Index_Entries */
252
253 /* SGP4 */
254
255 /* -& */
256
257 /* Local Variables */
258
259
260 /* SPICELIB routines. */
261
262
263 /* Standard SPICE error handling. */
264
265 if (return_()) {
266 return 0;
267 }
268 chkin_("ZZDSPC", (ftnlen)6);
269
270 /* Constants */
271
272 fasx2 = .13130908;
273 fasx4 = 2.8843198;
274 fasx6 = .37448087;
275 g22 = 5.7686396;
276 g32 = .95240898;
277 g44 = 1.8014998;
278 g52 = 1.050833;
279 g54 = 4.4108898;
280 rptim = .00437526908801129966;
281 stepp = 720.;
282 stepn = -720.;
283 step2 = 259200.;
284
285 /* Calculate deep space resonance effects. */
286
287 *dndt = 0.;
288 d__1 = *gsto + *tc * rptim;
289 d__2 = twopi_();
290 theta = d_mod(&d__1, &d__2);
291 *eccm += *dedt * *t;
292 *inclm += *didt * *t;
293 *argpm += *domdt * *t;
294 *nodem += *dnodt * *t;
295 *mm += *dmdt * *t;
296
297 /* sgp4fix for negative inclinations */
298 /* the following if statement should be commented out */
299
300 /* IF( INCLM .LT. 0.0D0) THEN */
301 /* INCLM = -INCLM */
302 /* ARGPM = ARGPM-PI */
303 /* NODEM = NODEM+PI */
304 /* END IF */
305
306
307 /* sgp4fix for propagator problems */
308
309 /* The following integration works for negative time steps and */
310 /* periods. The specific changes are unknown because the original */
311 /* code was so convoluted */
312
313 /* sgp4fix Take out atime = 0.0 and fix for faster operation */
314
315
316 /* Just in case - should be set in loops if used. */
317
318 ft = 0.;
319 if (*irez != 0) {
320
321 /* UPDATE RESONANCES : NUMERICAL (EULER-MACLAURIN) INTEGRATION */
322
323 /* EPOCH RESTART */
324
325
326 /* sgp4fix streamline check */
327
328 if (*atime == 0. || *t * *atime <= 0. || abs(*t) < abs(*atime)) {
329 *atime = 0.;
330 *xni = *no;
331 *xli = *xlamo;
332 }
333
334 /* sgp4fix move check outside loop */
335
336 if (*t > 0.) {
337 delt = stepp;
338 } else {
339 delt = stepn;
340 }
341
342 /* ADDED FOR DO LOOP */
343
344 iretn = 381;
345
346 /* ADDED FOR LOOP */
347
348 iret = 0;
349 while(iretn == 381) {
350
351 /* DOT TERMS CALCULATED */
352
353 /* NEAR - SYNCHRONOUS RESONANCE TERMS */
354
355 if (*irez != 2) {
356 xndt = *del1 * sin(*xli - fasx2) + *del2 * sin((*xli - fasx4)
357 * 2.) + *del3 * sin((*xli - fasx6) * 3.);
358 xldot = *xni + *xfact;
359 xnddt = *del1 * cos(*xli - fasx2) + *del2 * 2. * cos((*xli -
360 fasx4) * 2.) + *del3 * 3. * cos((*xli - fasx6) * 3.);
361 xnddt *= xldot;
362 } else {
363
364 /* NEAR - HALF-DAY RESONANCE TERMS */
365
366 xomi = *argpo + *argpdot * *atime;
367 x2omi = xomi + xomi;
368 x2li = *xli + *xli;
369 xndt = *d2201 * sin(x2omi + *xli - g22) + *d2211 * sin(*xli -
370 g22) + *d3210 * sin(xomi + *xli - g32) + *d3222 * sin(
371 -xomi + *xli - g32) + *d4410 * sin(x2omi + x2li - g44)
372 + *d4422 * sin(x2li - g44) + *d5220 * sin(xomi + *
373 xli - g52) + *d5232 * sin(-xomi + *xli - g52) + *
374 d5421 * sin(xomi + x2li - g54) + *d5433 * sin(-xomi +
375 x2li - g54);
376 xldot = *xni + *xfact;
377 xnddt = *d2201 * cos(x2omi + *xli - g22) + *d2211 * cos(*xli
378 - g22) + *d3210 * cos(xomi + *xli - g32) + *d3222 *
379 cos(-xomi + *xli - g32) + *d5220 * cos(xomi + *xli -
380 g52) + *d5232 * cos(-xomi + *xli - g52) + (*d4410 *
381 cos(x2omi + x2li - g44) + *d4422 * cos(x2li - g44) + *
382 d5421 * cos(xomi + x2li - g54) + *d5433 * cos(-xomi +
383 x2li - g54)) * 2.;
384 xnddt *= xldot;
385 }
386
387 /* INTEGRATOR */
388
389 /* sgp4fix move end checks to end of routine */
390
391 if ((d__1 = *t - *atime, abs(d__1)) >= stepp) {
392 iret = 0;
393 iretn = 381;
394 } else {
395 ft = *t - *atime;
396 iretn = 0;
397 }
398 if (iretn == 381) {
399 *xli = *xli + xldot * delt + xndt * step2;
400 *xni = *xni + xndt * delt + xnddt * step2;
401 *atime += delt;
402 }
403 }
404 *xn = *xni + xndt * ft + xnddt * ft * ft * .5;
405 xl = *xli + xldot * ft + xndt * ft * ft * .5;
406 if (*irez != 1) {
407 *mm = xl - *nodem * 2. + theta * 2.;
408 *dndt = *xn - *no;
409 } else {
410 *mm = xl - *nodem - *argpm + theta;
411 *dndt = *xn - *no;
412 }
413 *xn = *no + *dndt;
414 }
415 chkout_("ZZDSPC", (ftnlen)6);
416 return 0;
417 } /* zzdspc_ */
418
419