1 /* spke05.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 integer c__12 = 12;
11 static integer c__6 = 6;
12
13 /* $Procedure SPKE05 ( Evaluate SPK record, type 5 ) */
spke05_(doublereal * et,doublereal * record,doublereal * state)14 /* Subroutine */ int spke05_(doublereal *et, doublereal *record, doublereal *
15 state)
16 {
17 /* System generated locals */
18 doublereal d__1;
19
20 /* Builtin functions */
21 double cos(doublereal), sin(doublereal);
22
23 /* Local variables */
24 extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
25 );
26 doublereal dwdt;
27 extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
28 doublereal w;
29 extern /* Subroutine */ int chkin_(char *, ftnlen);
30 doublereal denom;
31 extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
32 vlcom_(doublereal *, doublereal *, doublereal *, doublereal *,
33 doublereal *);
34 doublereal vcomp[3], numer, s1[6], s2[6], t1, t2;
35 extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
36 doublereal *, doublereal *);
37 doublereal gm;
38 extern doublereal pi_(void);
39 doublereal dargdt, pv[12] /* was [6][2] */;
40 extern /* Subroutine */ int vlcomg_(integer *, doublereal *, doublereal *,
41 doublereal *, doublereal *, doublereal *), chkout_(char *,
42 ftnlen);
43 extern logical return_(void);
44 doublereal arg, vel[3];
45
46 /* $ Abstract */
47
48 /* Evaluate a single SPK data record from a segment of type 5 */
49 /* (two body propagation between discrete state vectors). */
50
51 /* $ Disclaimer */
52
53 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
54 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
55 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
56 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
57 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
58 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
59 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
60 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
61 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
62 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
63
64 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
65 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
66 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
67 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
68 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
69 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
70
71 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
72 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
73 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
74 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
75
76 /* $ Required_Reading */
77
78 /* SPK */
79
80 /* $ Keywords */
81
82 /* EPHEMERIS */
83
84 /* $ Declarations */
85 /* $ Brief_I/O */
86
87 /* Variable I/O Description */
88 /* -------- --- -------------------------------------------------- */
89 /* ET I Target epoch. */
90 /* RECORD I Data record. */
91 /* STATE O State (position and velocity). */
92
93 /* $ Detailed_Input */
94
95 /* ET is a target epoch, specified as ephemeris seconds past */
96 /* J2000, at which a state vector is to be computed. */
97
98 /* RECORD is a data record which, when evaluated at epoch ET, */
99 /* will give the state (position and velocity) of some */
100 /* body, relative to some center, in some inertial */
101 /* reference frame. */
102
103 /* The structure of RECORD is: */
104
105 /* RECORD(1) */
106 /* . state of the body at epoch 1. */
107 /* . */
108 /* . */
109 /* RECORD(6) */
110
111 /* RECORD(7) */
112 /* . */
113 /* . state of the body at epoch 2. */
114 /* . */
115 /* RECORD(12) */
116 /* RECORD(13) epoch 1 in seconds past 2000. */
117 /* RECORD(14) epoch 2 in seconds past 2000. */
118 /* RECORD(15) GM for the center of motion. */
119
120 /* Epoch 1 and epoch 2 are the times in the segment that */
121 /* bracket ET. If ET is less than the first time in the */
122 /* segment then both epochs 1 and 2 are equal to the */
123 /* first time. And if ET is greater than the last time */
124 /* then, epochs 1 and 2 are set equal to this last time. */
125
126 /* $ Detailed_Output */
127
128 /* STATE is the state produced by evaluating RECORD at ET. */
129 /* Units are km and km/sec. */
130
131 /* $ Parameters */
132
133 /* None. */
134
135 /* $ Exceptions */
136
137 /* 1) If there is a problem propagating, subject to the laws of two */
138 /* body motion, either of the states from RECORD to the requested */
139 /* time ET, an error will be signalled by the routine PROP2B. */
140
141 /* $ Files */
142
143 /* None. */
144
145 /* $ Particulars */
146
147 /* This routine interpolates a state from the two reference states */
148 /* contained in RECORD. */
149
150 /* It is assumed that this routine is used in conjunction with */
151 /* the routine SPKR05 as shown here: */
152
153 /* CALL SPKR05 ( HANDLE, DESCR, ET, RECORD ) */
154 /* CALL SPKE05 ( ET, RECORD, STATE ) */
155
156 /* Where it is known in advance that the HANDLE, DESCR pair points */
157 /* to a type 05 data segment. */
158
159 /* $ Examples */
160
161 /* The SPKEnn routines are almost always used in conjunction with */
162 /* the corresponding SPKRnn routines, which read the records from */
163 /* SPK files. */
164
165 /* The data returned by the SPKRnn routine is in its rawest form, */
166 /* taken directly from the segment. As such, it will be meaningless */
167 /* to a user unless he/she understands the structure of the data type */
168 /* completely. Given that understanding, however, the SPKRnn */
169 /* routines might be used to examine raw segment data before */
170 /* evaluating it with the SPKEnn routines. */
171
172
173 /* C */
174 /* C Get a segment applicable to a specified body and epoch. */
175 /* C */
176 /* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
177
178 /* C */
179 /* C Look at parts of the descriptor. */
180 /* C */
181 /* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
182 /* CENTER = ICD( 2 ) */
183 /* REF = ICD( 3 ) */
184 /* TYPE = ICD( 4 ) */
185
186 /* IF ( TYPE .EQ. 5 ) THEN */
187
188 /* CALL SPKR05 ( HANDLE, DESCR, ET, RECORD ) */
189 /* . */
190 /* . Look at the RECORD data. */
191 /* . */
192 /* CALL SPKE05 ( ET, RECORD, STATE ) */
193 /* . */
194 /* . Check out the evaluated state. */
195 /* . */
196 /* END IF */
197
198 /* $ Restrictions */
199
200 /* None. */
201
202 /* $ Literature_References */
203
204 /* None. */
205
206 /* $ Author_and_Institution */
207
208 /* N.J. Bachman (JPL) */
209 /* K.R. Gehringer (JPL) */
210 /* J.M. Lynch (JPL) */
211 /* W.L. Taber (JPL) */
212 /* I.M. Underwood (JPL) */
213
214 /* $ Version */
215
216 /* - SPICELIB Version 1.2.0, 31-AUG-2005 (NJB) */
217
218 /* Updated to remove non-standard use of duplicate arguments */
219 /* in VADD call. */
220
221 /* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
222
223 /* The declaration for the SPICELIB function PI is now */
224 /* preceded by an EXTERNAL statement declaring PI to be an */
225 /* external function. This removes a conflict with any */
226 /* compilers that have a PI intrinsic function. */
227
228 /* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */
229
230 /* -& */
231 /* $ Index_Entries */
232
233 /* evaluate type_5 spk segment */
234
235 /* -& */
236 /* $ Revisions */
237
238 /* - SPICELIB Version 1.2.0, 31-AUG-2005 (NJB) */
239
240 /* Updated to remove non-standard use of duplicate arguments */
241 /* in VADD call. */
242
243 /* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
244
245 /* The declaration for the SPICELIB function PI is now */
246 /* preceded by an EXTERNAL statement declaring PI to be an */
247 /* external function. This removes a conflict with any */
248 /* compilers that have a PI intrinsic function. */
249
250 /* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */
251
252 /* -& */
253
254 /* SPICELIB functions */
255
256
257 /* Local variables */
258
259
260 /* Standard SPICE error handling. */
261
262 if (return_()) {
263 return 0;
264 } else {
265 chkin_("SPKE05", (ftnlen)6);
266 }
267
268 /* Unpack the record, for easier reading. */
269
270 moved_(record, &c__12, pv);
271 t1 = record[12];
272 t2 = record[13];
273 gm = record[14];
274
275 /* Evaluate the two states. Call them s_1(t) and s_2(t). */
276 /* Let the position and velocity components be: p_1, v_1, p_2, v_2. */
277
278 /* The final position is a weighted average. */
279
280 /* Let */
281
282 /* W(t) = 0.5 + 0.5*COS( PI*(t-t1)/(t2-t1) ) */
283
284 /* then */
285
286 /* p = W(t)*p_1(t) + (1 - W(t))*p_2(t) */
287 /* v = W(t)*v_1(t) + (1 - W(t))*v_2(t) + W'(t)*(p_1(t) - p_2(t)) */
288
289 /* If t1 = t2, the state is just s(t1). */
290
291
292 /* Note: there are a number of weighting schemes we could have */
293 /* used. This one has the nice property that */
294
295 /* The graph of W is symmetric about the point */
296
297
298 /* ( (t1+t2)/2, W( (t1+t2)/2 ) */
299
300 /* The range of W is from 1 to 0. And the derivative of W is */
301 /* symmetric and zero at both t1 and t2. */
302
303
304 if (t1 != t2) {
305 d__1 = *et - t1;
306 prop2b_(&gm, pv, &d__1, s1);
307 d__1 = *et - t2;
308 prop2b_(&gm, &pv[6], &d__1, s2);
309 numer = *et - t1;
310 denom = t2 - t1;
311 arg = numer * pi_() / denom;
312 dargdt = pi_() / denom;
313 w = cos(arg) * .5 + .5;
314 dwdt = sin(arg) * -.5 * dargdt;
315 d__1 = 1. - w;
316 vlcomg_(&c__6, &w, s1, &d__1, s2, state);
317 d__1 = -dwdt;
318 vlcom_(&dwdt, s1, &d__1, s2, vcomp);
319 vadd_(&state[3], vcomp, vel);
320 vequ_(vel, &state[3]);
321 } else {
322 d__1 = *et - t1;
323 prop2b_(&gm, pv, &d__1, state);
324 }
325 chkout_("SPKE05", (ftnlen)6);
326 return 0;
327 } /* spke05_ */
328
329