1 /* spkw17.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__9 = 9;
11 static integer c__17 = 17;
12 static integer c__12 = 12;
13
14 /* $Procedure SPKW17 ( SPK, write a type 17 segment ) */
spkw17_(integer * handle,integer * body,integer * center,char * frame,doublereal * first,doublereal * last,char * segid,doublereal * epoch,doublereal * eqel,doublereal * rapol,doublereal * decpol,ftnlen frame_len,ftnlen segid_len)15 /* Subroutine */ int spkw17_(integer *handle, integer *body, integer *center,
16 char *frame, doublereal *first, doublereal *last, char *segid,
17 doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *
18 decpol, ftnlen frame_len, ftnlen segid_len)
19 {
20 /* System generated locals */
21 integer i__1;
22
23 /* Builtin functions */
24 double sqrt(doublereal);
25
26 /* Local variables */
27 doublereal a, h__;
28 integer i__;
29 doublereal k;
30 extern /* Subroutine */ int chkin_(char *, ftnlen);
31 doublereal descr[5];
32 extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
33 integer value;
34 extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_(
35 doublereal *, integer *), dafbna_(integer *, doublereal *, char *,
36 ftnlen), dafena_(void);
37 extern logical failed_(void);
38 doublereal record[12];
39 extern integer lastnb_(char *, ftnlen);
40 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
41 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
42 ftnlen), spkpds_(integer *, integer *, char *, integer *,
43 doublereal *, doublereal *, doublereal *, ftnlen);
44 extern logical return_(void);
45 doublereal ecc;
46
47 /* $ Abstract */
48
49 /* Write an SPK segment of type 17 given a type 17 data record. */
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 /* HANDLE I Handle of an SPK file open for writing. */
90 /* BODY I Body code for ephemeris object. */
91 /* CENTER I Body code for the center of motion of the body. */
92 /* FRAME I The reference frame of the states. */
93 /* FIRST I First valid time for which states can be computed. */
94 /* LAST I Last valid time for which states can be computed. */
95 /* SEGID I Segment identifier. */
96 /* EPOCH I Epoch of elements in seconds past J2000 */
97 /* EQEL I Array of equinoctial elements */
98 /* RAPOL I Right Ascension of the pole of the reference plane */
99 /* DECPOL I Declination of the pole of the reference plane */
100
101 /* $ Detailed_Input */
102
103 /* HANDLE is the file handle of an SPK file that has been */
104 /* opened for writing. */
105
106 /* BODY is the NAIF ID for the body whose states are */
107 /* to be recorded in an SPK file. */
108
109 /* CENTER is the NAIF ID for the center of motion associated */
110 /* with BODY. */
111
112 /* FRAME is the reference frame that states are referenced to, */
113 /* for example 'J2000'. */
114
115 /* FIRST are the bounds on the ephemeris times, expressed as */
116 /* LAST seconds past J2000. */
117
118 /* SEGID is the segment identifier. An SPK segment identifier */
119 /* may contain up to 40 characters. */
120
121 /* EPOCH is the epoch of equinoctial elements in seconds */
122 /* past the J2000 epoch. */
123
124 /* EQEL is an array of 9 double precision numbers that */
125 /* are the equinoctial elements for some orbit relative */
126 /* to the equatorial frame of a central body. */
127
128 /* ( The z-axis of the equatorial frame is the direction */
129 /* of the pole of the central body relative to FRAME. */
130 /* The x-axis is given by the cross product of the */
131 /* Z-axis of FRAME with the direction of the pole of */
132 /* the central body. The Y-axis completes a right */
133 /* handed frame. ) */
134
135 /* The specific arrangement of the elements is spelled */
136 /* out below. The following terms are used in the */
137 /* discussion of elements of EQEL */
138
139 /* INC --- inclination of the orbit */
140 /* ARGP --- argument of periapse */
141 /* NODE --- longitude of the ascending node */
142 /* E --- eccentricity of the orbit */
143
144 /* EQEL(1) is the semi-major axis (A) of the orbit in km. */
145
146 /* EQEL(2) is the value of H at the specified epoch. */
147 /* ( E*SIN(ARGP+NODE) ). */
148
149 /* EQEL(3) is the value of K at the specified epoch */
150 /* ( E*COS(ARGP+NODE) ). */
151
152 /* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */
153 /* the epoch of the elements measured in radians. */
154
155 /* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */
156 /* the specified epoch. */
157
158 /* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */
159 /* the specified epoch. */
160
161 /* EQEL(7) is the rate of the longitude of periapse */
162 /* (dARGP/dt + dNODE/dt ) at the epoch of */
163 /* the elements. This rate is assumed to hold */
164 /* for all time. The rate is measured in */
165 /* radians per second. */
166
167 /* EQEL(8) is the derivative of the mean longitude */
168 /* ( dM/dt + dARGP/dt + dNODE/dt ). This */
169 /* rate is assumed to be constant and is */
170 /* measured in radians/second. */
171
172 /* EQEL(9) is the rate of the longitude of the ascending */
173 /* node ( dNODE/dt). This rate is measured */
174 /* in radians per second. */
175
176 /* RAPOL Right Ascension of the pole of the reference plane */
177 /* relative to FRAME measured in radians. */
178
179 /* DECPOL Declination of the pole of the reference plane */
180 /* relative to FRAME measured in radians. */
181
182 /* $ Detailed_Output */
183
184 /* None. A type 17 segment is written to the file attached */
185 /* to HANDLE. */
186
187 /* $ Parameters */
188
189 /* None. */
190
191 /* $ Exceptions */
192
193 /* 1) If the semi-major axis is less than or equal to zero, the error */
194 /* 'SPICE(BADSEMIAXIS)' is signalled. */
195
196 /* 2) If the eccentricity of the orbit corresponding to the values */
197 /* of H and K ( EQEL(2) and EQEL(3) ) is greater than 0.9 the */
198 /* error 'SPICE(ECCOUTOFRANGE)' is signalled. */
199
200 /* 3) If the segment identifier has more than 40 non-blank characters */
201 /* the error 'SPICE(SEGIDTOOLONG)' is signalled. */
202
203 /* 4) If the segment identifier contains non-printing characters */
204 /* the error 'SPICE(NONPRINTABLECHARS)' is signalled. */
205
206 /* 5) If there are inconsistencies in the BODY, CENTER, FRAME or */
207 /* FIRST and LAST times, the problem will be diagnosed by */
208 /* a routine in the call tree of this routine. */
209
210 /* $ Files */
211
212 /* A new type 17 SPK segment is written to the SPK file attached */
213 /* to HANDLE. */
214
215 /* $ Particulars */
216
217 /* This routine writes an SPK type 17 data segment to the open SPK */
218 /* file according to the format described in the type 17 section of */
219 /* the SPK Required Reading. The SPK file must have been opened with */
220 /* write access. */
221
222 /* $ Examples */
223
224 /* Suppose that at time EPOCH you have the classical elements */
225 /* of some BODY relative to the equatorial frame of some central */
226 /* body CENTER. These can be converted to equinoctial elements */
227 /* and stored in an SPK file as a type 17 segment so that this */
228 /* body can be used within the SPK subsystem of the SPICE system. */
229
230 /* Below is a list of the variables used to represent the */
231 /* classical elements */
232
233 /* Variable Meaning */
234 /* -------- ---------------------------------- */
235 /* A Semi-major axis in km */
236 /* ECC Eccentricity of orbit */
237 /* INC Inclination of orbit */
238 /* NODE Longitude of the ascending node at epoch */
239 /* OMEGA Argument of periapse at epoch */
240 /* M Mean anomaly at epoch */
241 /* DMDT Mean anomaly rate in radians/second */
242 /* DNODE Rate of change of longitude of ascending node */
243 /* in radians/second */
244 /* DOMEGA Rate of change of argument of periapse in */
245 /* radians/second */
246 /* EPOCH is the epoch of the elements in seconds past */
247 /* the J2000 epoch. */
248
249
250 /* These elements are converted to equinoctial elements (in */
251 /* the order compatible with type 17) as shown below. */
252
253 /* EQEL(1) = A */
254 /* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */
255 /* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */
256
257 /* EQEL(4) = M + OMEGA + NODE */
258
259 /* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */
260 /* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */
261
262 /* EQEL(7) = DOMEGA */
263 /* EQEL(8) = DOMEGA + DMDT + DNODE */
264 /* EQEL(9) = DNODE */
265
266
267 /* C */
268 /* C Now add the segment. */
269 /* C */
270
271 /* CALL SPKW17 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */
272 /* . SEGID, EPOCH, EQEL, RAPOL, DECPOL ) */
273
274
275 /* $ Restrictions */
276
277 /* None. */
278
279 /* $ Literature_References */
280
281 /* None. */
282
283 /* $ Author_and_Institution */
284
285 /* W.L. Taber (JPL) */
286
287 /* $ Version */
288
289 /* - SPICELIB Version 1.0.1, 24-Jun-1999 (WLT) */
290
291 /* Corrected typographical errors in the header. */
292
293 /* - SPICELIB Version 1.0.0, 8-Jan-1997 (WLT) */
294
295 /* -& */
296 /* $ Index_Entries */
297
298 /* Write a type 17 spk segment */
299
300 /* -& */
301
302 /* SPICELIB Functions */
303
304
305 /* Local Variables */
306
307
308 /* Segment descriptor size */
309
310
311 /* Segment identifier size */
312
313
314 /* SPK data type */
315
316
317 /* Range of printing characters */
318
319
320 /* Number of items in a segment */
321
322
323 /* Standard SPICE error handling. */
324
325 if (return_()) {
326 return 0;
327 }
328 chkin_("SPKW17", (ftnlen)6);
329
330 /* Fetch the various entities from the inputs and put them into */
331 /* the data record, first the epoch. */
332
333 record[0] = *epoch;
334
335 /* The trajectory pole vector. */
336
337 moved_(eqel, &c__9, &record[1]);
338 record[10] = *rapol;
339 record[11] = *decpol;
340 a = record[1];
341 h__ = record[2];
342 k = record[3];
343 ecc = sqrt(h__ * h__ + k * k);
344
345 /* Check all the inputs here for obvious failures. It's much */
346 /* better to check them now and quit than it is to get a bogus */
347 /* segment into an SPK file and diagnose it later. */
348
349 if (a <= 0.) {
350 setmsg_("The semimajor axis supplied to the SPK type 17 evaluator wa"
351 "s non-positive. This value must be positive. The value supp"
352 "lied was #.", (ftnlen)130);
353 errdp_("#", &a, (ftnlen)1);
354 sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18);
355 chkout_("SPKW17", (ftnlen)6);
356 return 0;
357 } else if (ecc > .9) {
358 setmsg_("The eccentricity supplied for a type 17 segment is greater "
359 "than 0.9. It must be less than 0.9.The value supplied to th"
360 "e type 17 evaluator was #. ", (ftnlen)146);
361 errdp_("#", &ecc, (ftnlen)1);
362 sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
363 chkout_("SPKW17", (ftnlen)6);
364 return 0;
365 }
366
367 /* Make sure the segment identifier is not too long. */
368
369 if (lastnb_(segid, segid_len) > 40) {
370 setmsg_("Segment identifier contains more than 40 characters.", (
371 ftnlen)52);
372 sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
373 chkout_("SPKW17", (ftnlen)6);
374 return 0;
375 }
376
377 /* Make sure the segment identifier has only printing characters. */
378
379 i__1 = lastnb_(segid, segid_len);
380 for (i__ = 1; i__ <= i__1; ++i__) {
381 value = *(unsigned char *)&segid[i__ - 1];
382 if (value < 32 || value > 126) {
383 setmsg_("The segment identifier contains the nonprintable charac"
384 "ter having ascii code #.", (ftnlen)79);
385 errint_("#", &value, (ftnlen)1);
386 sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
387 chkout_("SPKW17", (ftnlen)6);
388 return 0;
389 }
390 }
391
392 /* All of the obvious checks have been performed on the input */
393 /* record. Create the segment descriptor. (FIRST and LAST are */
394 /* checked by SPKPDS as well as consistency between BODY and CENTER). */
395
396 spkpds_(body, center, frame, &c__17, first, last, descr, frame_len);
397 if (failed_()) {
398 chkout_("SPKW17", (ftnlen)6);
399 return 0;
400 }
401
402 /* Begin a new segment. */
403
404 dafbna_(handle, descr, segid, segid_len);
405 if (failed_()) {
406 chkout_("SPKW17", (ftnlen)6);
407 return 0;
408 }
409 dafada_(record, &c__12);
410 if (! failed_()) {
411 dafena_();
412 }
413 chkout_("SPKW17", (ftnlen)6);
414 return 0;
415 } /* spkw17_ */
416
417