1 /* spkw01.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__1 = 1;
11
12 /* $Procedure SPKW01 ( Write SPK segment, type 1 ) */
spkw01_(integer * handle,integer * body,integer * center,char * frame,doublereal * first,doublereal * last,char * segid,integer * n,doublereal * dlines,doublereal * epochs,ftnlen frame_len,ftnlen segid_len)13 /* Subroutine */ int spkw01_(integer *handle, integer *body, integer *center,
14 char *frame, doublereal *first, doublereal *last, char *segid,
15 integer *n, doublereal *dlines, doublereal *epochs, ftnlen frame_len,
16 ftnlen segid_len)
17 {
18 /* System generated locals */
19 integer i__1;
20 doublereal d__1;
21
22 /* Local variables */
23 integer i__;
24 extern /* Subroutine */ int chkin_(char *, ftnlen);
25 doublereal descr[5];
26 extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
27 errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *,
28 integer *), dafbna_(integer *, doublereal *, char *, ftnlen),
29 dafena_(void);
30 extern logical failed_(void);
31 integer chrcod, refcod;
32 extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
33 extern integer lastnb_(char *, ftnlen);
34 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
35 ftnlen);
36 doublereal maxtim;
37 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
38 integer *, ftnlen), spkpds_(integer *, integer *, char *, integer
39 *, doublereal *, doublereal *, doublereal *, ftnlen);
40 extern logical return_(void);
41
42 /* $ Abstract */
43
44 /* Write a type 1 segment to an SPK file. */
45
46 /* $ Disclaimer */
47
48 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
49 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
50 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
51 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
52 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
53 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
54 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
55 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
56 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
57 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
58
59 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
60 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
61 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
62 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
63 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
64 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
65
66 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
67 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
68 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
69 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
70
71 /* $ Required_Reading */
72
73 /* NAIF_IDS */
74 /* SPK */
75 /* TIME */
76
77 /* $ Keywords */
78
79 /* EPHEMERIS */
80 /* FILES */
81
82 /* $ Declarations */
83 /* $ Brief_I/O */
84
85 /* Variable I/O Description */
86 /* -------- --- -------------------------------------------------- */
87 /* HANDLE I Handle of an SPK file open for writing. */
88 /* BODY I NAIF code for an ephemeris object. */
89 /* CENTER I NAIF code for center of motion of BODY. */
90 /* FRAME I Reference frame name. */
91 /* FIRST I Start time of interval covered by segment. */
92 /* LAST I End time of interval covered by segment. */
93 /* SEGID I Segment identifier. */
94 /* N I Number of difference lines in segment. */
95 /* DLINES I Array of difference lines. */
96 /* EPOCHS I Coverage end times of difference lines. */
97
98 /* $ Detailed_Input */
99
100 /* HANDLE is the file handle of an SPK file that has been */
101 /* opened for writing. */
102
103 /* BODY is the NAIF integer code for an ephemeris object */
104 /* whose state relative to another body is described */
105 /* by the segment to be created. */
106
107 /* CENTER is the NAIF integer code for the center of motion */
108 /* of the object identified by BODY. */
109
110 /* FRAME is the NAIF name for a reference frame relative to */
111 /* which the state information for BODY is specified. */
112 /* FIRST, */
113 /* LAST are, respectively, the start and stop times of */
114 /* the time interval over which the segment defines */
115 /* the state of BODY. */
116
117 /* SEGID is the segment identifier. An SPK segment */
118 /* identifier may contain up to 40 characters. */
119
120 /* N is the number of difference lines in the input */
121 /* difference line array. */
122
123 /* DLINES contains a time-ordered array of difference lines */
124 /* The Ith difference line occupies elements (1,I) */
125 /* through (71,I) of DLINES. Each difference line */
126 /* represents the state (x, y, z, dx/dt, dy/dt, */
127 /* dz/dt, in kilometers and kilometers per second) */
128 /* of BODY relative to CENTER, specified relative to */
129 /* FRAME, for an interval of time. The time interval */
130 /* covered by the Ith difference line ends at the */
131 /* Ith element of the array EPOCHS (described below). */
132 /* The interval covered by the first difference line */
133 /* starts at the segment start time. */
134
135 /* The contents of a difference line are as shown */
136 /* below: */
137
138 /* Dimension Description */
139 /* --------- ---------------------------------- */
140 /* 1 Reference epoch of difference line */
141 /* 15 Stepsize function vector */
142 /* 1 Reference position vector, x */
143 /* 1 Reference velocity vector, x */
144 /* 1 Reference position vector, y */
145 /* 1 Reference velocity vector, y */
146 /* 1 Reference position vector, z */
147 /* 1 Reference velocity vector, z */
148 /* 15,3 Modified divided difference */
149 /* arrays (MDAs) */
150 /* 1 Maximum integration order plus 1 */
151 /* 3 Integration order array */
152
153 /* The reference position and velocity are those of */
154 /* BODY relative to CENTER at the reference epoch. */
155 /* (A difference line is essentially a polynomial */
156 /* expansion of acceleration about the reference */
157 /* epoch.) */
158
159
160 /* EPOCHS is an array of epochs corresponding to the members */
161 /* of the state array. The epochs are specified as */
162 /* seconds past J2000, TDB. */
163
164 /* The first difference line covers the time interval */
165 /* from the segment start time to EPOCHS(1). For */
166 /* I > 1, the Ith difference line covers the half-open */
167 /* time interval from, but not including, EPOCHS(I-1) */
168 /* through EPOCHS(I). */
169
170 /* The elements of EPOCHS must be strictly increasing. */
171
172
173 /* $ Detailed_Output */
174
175 /* None. See $Particulars for a description of the effect of this */
176 /* routine. */
177
178 /* $ Parameters */
179
180 /* None. */
181
182 /* $ Exceptions */
183
184 /* If any of the following exceptions occur, this routine will return */
185 /* without creating a new segment. */
186
187 /* 1) If FRAME is not a recognized name, the error */
188 /* SPICE(INVALIDREFFRAME) is signaled. */
189
190 /* 2) If the last non-blank character of SEGID occurs past index 40, */
191 /* the error SPICE(SEGIDTOOLONG) is signaled. */
192
193 /* 3) If SEGID contains any nonprintable characters, the error */
194 /* SPICE(NONPRINTABLECHARS) is signaled. */
195
196 /* 4) If the number of difference lines N is not at least one, */
197 /* the error SPICE(INVALIDCOUNT) will be signaled. */
198
199 /* 5) If FIRST is greater than or equal to LAST then the error */
200 /* SPICE(BADDESCRTIMES) will be signaled. */
201
202 /* 6) If the elements of the array EPOCHS are not in strictly */
203 /* increasing order, the error SPICE(TIMESOUTOFORDER) will be */
204 /* signaled. */
205
206 /* 7) If the last epoch EPOCHS(N) is less than LAST, the error */
207 /* SPICE(BADDESCRTIMES) will be signaled. */
208
209 /* $ Files */
210
211 /* A new type 1 SPK segment is written to the SPK file attached */
212 /* to HANDLE. */
213
214 /* $ Particulars */
215
216 /* This routine writes an SPK type 1 data segment to the open SPK */
217 /* file according to the format described in the type 1 section of */
218 /* the SPK Required Reading. The SPK file must have been opened with */
219 /* write access. */
220
221 /* $ Examples */
222
223 /* Suppose that you have difference lines and are prepared to */
224 /* produce a segment of type 1 in an SPK file. */
225
226 /* The following code fragment could be used to add the new segment */
227 /* to a previously opened SPK file attached to HANDLE. The file must */
228 /* have been opened with write access. */
229
230 /* C */
231 /* C Create a segment identifier. */
232 /* C */
233 /* SEGID = 'MY_SAMPLE_SPK_TYPE_1_SEGMENT' */
234
235 /* C */
236 /* C Write the segment. */
237 /* C */
238 /* CALL SPKW01 ( HANDLE, BODY, CENTER, FRAME, */
239 /* . FIRST, LAST, SEGID, N, */
240 /* . DLINES, EPOCHS ) */
241
242 /* $ Restrictions */
243
244 /* 1) The validity of the difference lines is not checked by */
245 /* this routine. */
246
247 /* $ Literature_References */
248
249 /* None. */
250
251 /* $ Author_and_Institution */
252
253 /* N.J. Bachman (JPL) */
254
255 /* $ Version */
256
257 /* - SPICELIB Version 1.0.1, 07-APR-2010 (NJB) */
258
259 /* Updated Detailed_Input to state that the elements */
260 /* of EPOCHS must be strictly increasing. The Exceptions */
261 /* section already described this error condition. */
262
263 /* - SPICELIB Version 1.0.0, 30-JAN-2003 (NJB) */
264
265 /* -& */
266 /* $ Index_Entries */
267
268 /* write spk type_1 ephemeris data segment */
269
270 /* -& */
271
272 /* SPICELIB functions */
273
274
275 /* Local parameters */
276
277
278 /* Local variables */
279
280
281 /* Local variables */
282
283
284 /* Standard SPICE error handling. */
285
286 if (return_()) {
287 return 0;
288 } else {
289 chkin_("SPKW01", (ftnlen)6);
290 }
291
292 /* Get the NAIF integer code for the reference frame. */
293
294 namfrm_(frame, &refcod, frame_len);
295 if (refcod == 0) {
296 setmsg_("The reference frame # is not supported.", (ftnlen)39);
297 errch_("#", frame, (ftnlen)1, frame_len);
298 sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
299 chkout_("SPKW01", (ftnlen)6);
300 return 0;
301 }
302
303 /* Check to see if the segment identifier is too long. */
304
305 if (lastnb_(segid, segid_len) > 40) {
306 setmsg_("Segment identifier contains more than 40 characters.", (
307 ftnlen)52);
308 sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
309 chkout_("SPKW01", (ftnlen)6);
310 return 0;
311 }
312
313 /* Now check that all the characters in the segment identifier */
314 /* can be printed. */
315
316 i__1 = lastnb_(segid, segid_len);
317 for (i__ = 1; i__ <= i__1; ++i__) {
318 chrcod = *(unsigned char *)&segid[i__ - 1];
319 if (chrcod < 32 || chrcod > 126) {
320 setmsg_("The segment identifier contains nonprintable characters",
321 (ftnlen)55);
322 sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
323 chkout_("SPKW01", (ftnlen)6);
324 return 0;
325 }
326 }
327
328 /* The difference line count must be at least one. */
329
330 if (*n < 1) {
331 setmsg_("The difference line count was #; the count must be at least"
332 " one.", (ftnlen)64);
333 errint_("#", n, (ftnlen)1);
334 sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
335 chkout_("SPKW01", (ftnlen)6);
336 return 0;
337 }
338
339 /* The segment stop time should be greater then the begin time. */
340
341 if (*first >= *last) {
342 setmsg_("The segment start time: # is greater then the segment end t"
343 "ime: #", (ftnlen)65);
344 errdp_("#", first, (ftnlen)1);
345 errdp_("#", last, (ftnlen)1);
346 sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
347 chkout_("SPKW01", (ftnlen)6);
348 return 0;
349 }
350
351 /* Make sure the epochs form a strictly increasing sequence. */
352
353 maxtim = epochs[0];
354 i__1 = *n;
355 for (i__ = 2; i__ <= i__1; ++i__) {
356 if (epochs[i__ - 1] <= maxtim) {
357 setmsg_("EPOCH # having index # is not greater than its predeces"
358 "sor #.", (ftnlen)61);
359 errdp_("#", &epochs[i__ - 1], (ftnlen)1);
360 errint_("#", &i__, (ftnlen)1);
361 errdp_("#", &epochs[i__ - 2], (ftnlen)1);
362 sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
363 chkout_("SPKW01", (ftnlen)6);
364 return 0;
365 } else {
366 maxtim = epochs[i__ - 1];
367 }
368 }
369
370 /* Make sure there's no gap between the last difference line */
371 /* epoch and the end of the time interval defined by the segment */
372 /* descriptor. */
373
374 if (epochs[*n - 1] < *last) {
375 setmsg_("Segment end time # follows last epoch #.", (ftnlen)40);
376 errdp_("#", last, (ftnlen)1);
377 errdp_("#", &epochs[*n - 1], (ftnlen)1);
378 sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
379 chkout_("SPKW01", (ftnlen)6);
380 return 0;
381 }
382
383 /* If we made it this far, we're ready to start writing the segment. */
384
385
386 /* Create the segment descriptor. */
387
388 spkpds_(body, center, frame, &c__1, first, last, descr, frame_len);
389
390 /* Begin a new segment. */
391
392 dafbna_(handle, descr, segid, segid_len);
393 if (failed_()) {
394 chkout_("SPKW01", (ftnlen)6);
395 return 0;
396 }
397
398 /* The type 1 segment structure is shown below: */
399
400 /* +-----------------------+ */
401 /* | Difference line 1 | */
402 /* +-----------------------+ */
403 /* | Difference line 2 | */
404 /* +-----------------------+ */
405 /* . */
406 /* . */
407 /* . */
408 /* +-----------------------+ */
409 /* | Difference line N | */
410 /* +-----------------------+ */
411 /* | Epoch 1 | */
412 /* +-----------------------+ */
413 /* | Epoch 2 | */
414 /* +-----------------------+ */
415 /* . */
416 /* . */
417 /* . */
418 /* +-----------------------+ */
419 /* | Epoch N | */
420 /* +-----------------------+ */
421 /* | Epoch 100 | (First directory) */
422 /* +-----------------------+ */
423 /* . */
424 /* . */
425 /* . */
426 /* +-----------------------+ */
427 /* | Epoch (N/100)*100 | (Last directory) */
428 /* +-----------------------+ */
429 /* | Number of diff lines | */
430 /* +-----------------------+ */
431
432
433 i__1 = *n * 71;
434 dafada_(dlines, &i__1);
435 dafada_(epochs, n);
436 i__1 = *n / 100;
437 for (i__ = 1; i__ <= i__1; ++i__) {
438 dafada_(&epochs[i__ * 100 - 1], &c__1);
439 }
440 d__1 = (doublereal) (*n);
441 dafada_(&d__1, &c__1);
442
443 /* As long as nothing went wrong, end the segment. */
444
445 if (! failed_()) {
446 dafena_();
447 }
448 chkout_("SPKW01", (ftnlen)6);
449 return 0;
450 } /* spkw01_ */
451
452