1 /* spkw20.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__50 = 50;
11 static integer c__40 = 40;
12 static integer c__2 = 2;
13 static integer c__6 = 6;
14 static integer c__1 = 1;
15
16 /* $Procedure SPKW20 ( SPK, write segment, type 20 ) */
spkw20_(integer * handle,integer * body,integer * center,char * frame,doublereal * first,doublereal * last,char * segid,doublereal * intlen,integer * n,integer * polydg,doublereal * cdata,doublereal * dscale,doublereal * tscale,doublereal * initjd,doublereal * initfr,ftnlen frame_len,ftnlen segid_len)17 /* Subroutine */ int spkw20_(integer *handle, integer *body, integer *center,
18 char *frame, doublereal *first, doublereal *last, char *segid,
19 doublereal *intlen, integer *n, integer *polydg, doublereal *cdata,
20 doublereal *dscale, doublereal *tscale, doublereal *initjd,
21 doublereal *initfr, ftnlen frame_len, ftnlen segid_len)
22 {
23 /* System generated locals */
24 integer i__1;
25 doublereal d__1, d__2;
26
27 /* Local variables */
28 extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
29 char *, ftnlen), dafps_(integer *, integer *, doublereal *,
30 integer *, doublereal *);
31 doublereal btime, descr[5];
32 extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
33 doublereal ltime;
34 extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
35 char etstr[40];
36 extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_(
37 integer *, doublereal *, char *, ftnlen), dafena_(void);
38 extern logical failed_(void);
39 extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen,
40 ftnlen);
41 integer refcod, ninrec;
42 extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
43 doublereal numrec;
44 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
45 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
46 ftnlen);
47 extern logical return_(void);
48 char netstr[40];
49 doublereal dcd[2];
50 extern doublereal j2000_(void);
51 integer icd[6];
52 extern doublereal spd_(void);
53 doublereal tol;
54
55 /* $ Abstract */
56
57 /* Write a type 20 segment to an SPK file. */
58
59 /* $ Disclaimer */
60
61 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
62 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
63 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
64 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
65 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
66 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
67 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
68 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
69 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
70 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
71
72 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
73 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
74 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
75 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
76 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
77 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
78
79 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
80 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
81 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
82 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
83
84 /* $ Required_Reading */
85
86 /* DAF */
87 /* NAIF_IDS */
88 /* TIME */
89 /* SPK */
90
91 /* $ Keywords */
92
93 /* EPHEMERIS */
94
95 /* $ Declarations */
96 /* $ Abstract */
97
98 /* Declare parameters specific to SPK type 20. */
99
100 /* $ Disclaimer */
101
102 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
103 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
104 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
105 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
106 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
107 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
108 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
109 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
110 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
111 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
112
113 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
114 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
115 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
116 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
117 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
118 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
119
120 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
121 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
122 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
123 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
124
125 /* $ Required_Reading */
126
127 /* SPK */
128
129 /* $ Keywords */
130
131 /* SPK */
132
133 /* $ Restrictions */
134
135 /* None. */
136
137 /* $ Author_and_Institution */
138
139 /* N.J. Bachman (JPL) */
140
141 /* $ Literature_References */
142
143 /* None. */
144
145 /* $ Version */
146
147 /* - SPICELIB Version 1.0.0, 30-DEC-2013 (NJB) */
148
149 /* -& */
150 /* MAXDEG is the maximum allowed degree of the input */
151 /* Chebyshev expansions. If the value of MAXDEG is */
152 /* increased, the SPICELIB routine SPKPVN must be */
153 /* changed accordingly. In particular, the size of */
154 /* the record passed to SPKRnn and SPKEnn must be */
155 /* increased, and comments describing the record size */
156 /* must be changed. */
157
158 /* The record size requirement is */
159
160 /* MAXREC = 3 * ( MAXDEG + 3 ) */
161
162
163
164 /* TOLSCL is a tolerance scale factor (also called a */
165 /* "relative tolerance") used for time coverage */
166 /* bound checking. TOLSCL is unitless. TOLSCL */
167 /* produces a tolerance value via the formula */
168
169 /* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */
170
171 /* where FIRST and LAST are the coverage time bounds */
172 /* of a type 20 segment, expressed as seconds past */
173 /* J2000 TDB. */
174
175 /* The resulting parameter TOL is used as a tolerance */
176 /* for comparing the input segment descriptor time */
177 /* bounds to the first and last epoch covered by the */
178 /* sequence of time intervals defined by the inputs */
179 /* to SPKW20: */
180
181 /* INITJD */
182 /* INITFR */
183 /* INTLEN */
184 /* N */
185
186 /* Tolerance scale for coverage gap at the endpoints */
187 /* of the segment coverage interval: */
188
189
190 /* End of include file spk20.inc. */
191
192 /* $ Brief_I/O */
193
194 /* Variable I/O Description */
195 /* -------- --- -------------------------------------------------- */
196 /* HANDLE I Handle of SPK file open for writing. */
197 /* BODY I NAIF code for ephemeris object. */
198 /* CENTER I NAIF code for the center of motion of the body. */
199 /* FRAME I Reference frame name. */
200 /* FIRST I Start time of interval covered by segment. */
201 /* LAST I End time of interval covered by segment. */
202 /* SEGID I Segment identifier. */
203 /* INTLEN I Length of time covered by logical record (days). */
204 /* N I Number of logical records in segment. */
205 /* POLYDG I Chebyshev polynomial degree. */
206 /* CDATA I Array of Chebyshev coefficients and positions. */
207 /* DSCALE I Distance scale of data. */
208 /* TSCALE I Time scale of data. */
209 /* INITJD I Integer part of begin time (TDB Julian date) of */
210 /* first record. */
211 /* INITFR I Fractional part of begin time (TDB Julian date) of */
212 /* first record. */
213 /* MAXDEG P Maximum allowed degree of Chebyshev expansions. */
214 /* TOLSCL P Tolerance scale for coverage bound checking. */
215
216 /* $ Detailed_Input */
217
218 /* HANDLE is the DAF handle of an SPK file to which a type 20 */
219 /* segment is to be added. The SPK file must be open */
220 /* for writing. */
221
222 /* BODY is the NAIF integer code for an ephemeris object */
223 /* whose state relative to another body is described */
224 /* by the segment to be created. */
225
226 /* CENTER is the NAIF integer code for the center of motion */
227 /* of the object identified by BODY. */
228
229 /* FRAME is the NAIF name for a reference frame relative to */
230 /* which the state information for BODY is specified. */
231
232 /* FIRST, */
233 /* LAST are the start and stop times of the time interval */
234 /* over which the segment defines the state of the */
235 /* object identified by BODY. */
236
237 /* SEGID is a segment identifier. An SPK segment identifier */
238 /* may contain up to 40 characters. */
239
240 /* INTLEN is the length of time, in TDB Julian days, covered */
241 /* by each set of Chebyshev polynomial coefficients */
242 /* (each logical record). */
243
244 /* N is the number of logical records to be stored in */
245 /* the segment. There is one logical record for each */
246 /* time period. Each logical record contains three */
247 /* sets of Chebyshev coefficients---one for each */
248 /* coordinate---and three position vector components. */
249
250 /* POLYDG is the degree of each set of Chebyshev */
251 /* polynomials, i.e. the number of Chebyshev */
252 /* coefficients per coordinate minus one. POLYDG must */
253 /* be less than or equal to the parameter MAXDEG. */
254
255 /* CDATA is an array containing all the sets of Chebyshev */
256 /* polynomial coefficients and position components to */
257 /* be placed in the new segment of the SPK file. */
258 /* There are three sets of coefficients and position */
259 /* components for each time interval covered by the */
260 /* segment. */
261
262 /* The coefficients and position components are */
263 /* stored in CDATA in order as follows: */
264
265 /* the (POLYDG + 1) coefficients for the first */
266 /* coordinate of the first logical record, */
267 /* followed by the X component of position at the */
268 /* first interval midpoint. The first coefficient */
269 /* is that of the constant term of the expansion. */
270
271 /* the coefficients for the second coordinate, */
272 /* followed by the Y component of position at the */
273 /* first interval midpoint. */
274
275 /* the coefficients for the third coordinate, */
276 /* followed by the Z component of position at the */
277 /* first interval midpoint. */
278
279 /* the coefficients for the first coordinate for */
280 /* the second logical record, followed by the X */
281 /* component of position at the second interval */
282 /* midpoint. */
283
284 /* and so on. */
285
286 /* The logical data records are stored contiguously: */
287
288 /* +----------+ */
289 /* | Record 1 | */
290 /* +----------+ */
291 /* | Record 2 | */
292 /* +----------+ */
293 /* ... */
294 /* +----------+ */
295 /* | Record N | */
296 /* +----------+ */
297
298 /* The contents of an individual record are: */
299
300 /* +--------------------------------------+ */
301 /* | Coeff set for X velocity component | */
302 /* +--------------------------------------+ */
303 /* | X position component | */
304 /* +--------------------------------------+ */
305 /* | Coeff set for Y velocity component | */
306 /* +--------------------------------------+ */
307 /* | Y position component | */
308 /* +--------------------------------------+ */
309 /* | Coeff set for Z velocity component | */
310 /* +--------------------------------------+ */
311 /* | Z position component | */
312 /* +--------------------------------------+ */
313
314 /* Each coefficient set has the structure: */
315
316 /* +--------------------------------------+ */
317 /* | Coefficient of T_0 | */
318 /* +--------------------------------------+ */
319 /* | Coefficient of T_1 | */
320 /* +--------------------------------------+ */
321 /* ... */
322 /* +--------------------------------------+ */
323 /* | Coefficient of T_POLYDG | */
324 /* +--------------------------------------+ */
325
326 /* Where T_n represents the Chebyshev polynomial */
327 /* of the first kind of degree n. */
328
329
330 /* DSCALE, */
331 /* TSCALE are, respectively, the distance scale of the input */
332 /* position and velocity data in km, and the time */
333 /* scale of the input velocity data in TDB seconds. */
334
335 /* For example, if the input distance data have units */
336 /* of astronomical units (AU), DSCALE should be set */
337 /* to the number of km in one AU. If the input */
338 /* velocity data have time units of Julian days, then */
339 /* TSCALE should be set to the number of seconds per */
340 /* Julian day (86400). */
341
342
343 /* INITJD is the integer part of the Julian ephemeris date */
344 /* of initial epoch of the first record. INITJD may */
345 /* be less than, equal to, or greater than the */
346 /* initial epoch. */
347
348 /* INITFR is the fractional part of the Julian ephemeris date */
349 /* of initial epoch of the first record. INITFR has */
350 /* units of Julian days. INITFR has magnitude */
351 /* strictly less than 1 day. The sum */
352
353 /* INITJD + INITFR */
354
355 /* equals the Julian ephemeris date of the initial */
356 /* epoch of the first record. */
357
358
359 /* $ Detailed_Output */
360
361 /* None. This routine writes data to an SPK file. */
362
363 /* $ Parameters */
364
365 /* The parameters described in this section are declared in the */
366 /* Fortran INCLUDE file spk20.inc */
367
368
369 /* MAXDEG is the maximum allowed degree of the input */
370 /* Chebyshev expansions. */
371
372
373 /* TOLSCL is a tolerance scale factor (also called a */
374 /* "relative tolerance") used for time coverage */
375 /* bound checking. TOLSCL is unitless. TOLSCL */
376 /* produces a tolerance value via the formula */
377
378 /* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */
379
380 /* where FIRST and LAST are the coverage time bounds */
381 /* of a type 20 segment, expressed as seconds past */
382 /* J2000 TDB. */
383
384 /* The resulting parameter TOL is used as a tolerance */
385 /* for comparing the input segment descriptor time */
386 /* bounds to the first and last epoch covered by the */
387 /* sequence of time intervals defined by the inputs */
388
389 /* INITJD */
390 /* INITFR */
391 /* INTLEN */
392 /* N */
393
394 /* See the Exceptions section below for a description */
395 /* of the error check using this tolerance. */
396
397 /* $ Exceptions */
398
399 /* 1) If the number of sets of coefficients is not positive */
400 /* SPICE(INVALIDCOUNT) is signaled. */
401
402 /* 2) If the interval length is not positive, SPICE(INTLENNOTPOS) */
403 /* is signaled. */
404
405 /* 3) If the name of the reference frame is not recognized, */
406 /* SPICE(INVALIDREFFRAME) is signaled. */
407
408 /* 4) If segment stop time is not greater than or equal to */
409 /* the begin time, SPICE(BADDESCRTIMES) is signaled. */
410
411 /* 5) If the start time of the first record exceeds the descriptor */
412 /* begin time by more than a computed tolerance, or if the end */
413 /* time of the last record precedes the descriptor end time by */
414 /* more than a computed tolerance, the error SPICE(COVERAGEGAP) */
415 /* is signaled. See the Parameters section above for a */
416 /* description of the tolerance. */
417
418 /* 6) If the input degree POLYDG is less than 0 or greater than */
419 /* MAXDEG, the error SPICE(INVALIDDEGREE) is signaled. */
420
421 /* 7) If the last non-blank character of SEGID occurs past index */
422 /* 40, or if SEGID contains any nonprintable characters, the */
423 /* error will be diagnosed by a routine in the call tree of this */
424 /* routine. */
425
426 /* 8) If either the distance or time scale is non-positive, the */
427 /* error SPICE(NONPOSITIVESCALE) will be signaled. */
428
429 /* $ Files */
430
431 /* A new type 20 SPK segment is written to the SPK file attached */
432 /* to HANDLE. */
433
434 /* $ Particulars */
435
436 /* This routine writes an SPK type 20 data segment to the designated */
437 /* SPK file, according to the format described in the SPK Required */
438 /* Reading. */
439
440 /* Each segment can contain data for only one target, central body, */
441 /* and reference frame. The Chebyshev polynomial degree and length */
442 /* of time covered by each logical record are also fixed. However, */
443 /* an arbitrary number of logical records of Chebyshev polynomial */
444 /* coefficients can be written in each segment. Minimizing the */
445 /* number of segments in an SPK file will help optimize how the */
446 /* SPICE system accesses the file. */
447
448 /* $ Examples */
449
450 /* Suppose that you have in an array CDATA sets of Chebyshev */
451 /* polynomial coefficients and position vectors representing the */
452 /* state of the moon (NAIF ID = 301), relative to the Earth-moon */
453 /* barycenter (NAIF ID = 3), in the J2000 reference frame, and you */
454 /* want to put these into a type 20 segment in an existing SPK file. */
455 /* The following code could be used to add one new type 20 segment. */
456 /* To add multiple segments, put the call to SPKW20 in a loop. */
457
458 /* C */
459 /* C First open the SPK file and get a handle for it. */
460 /* C */
461 /* CALL DAFOPW ( SPKNAM, HANDLE ) */
462
463 /* C */
464 /* C Create a segment identifier. */
465 /* C */
466 /* SEGID = 'MY_SAMPLE_SPK_TYPE_20_SEGMENT' */
467
468 /* C */
469 /* C Note that the interval length INTLEN has units */
470 /* C of Julian days. The start time of the first record */
471 /* C is expressed using two inputs: integer and fractional */
472 /* C portions of the Julian ephemeris date of the start */
473 /* C time. */
474 /* C */
475 /* C Write the segment. */
476 /* C */
477 /* CALL SPKW20 ( HANDLE, 301, 3, 'J2000', */
478 /* . FIRST, LAST, SEGID, INTLEN, */
479 /* . N, POLYDG, CDATA, DSCALE, */
480 /* . TSCALE, INITJD, INITFR ) */
481
482 /* C */
483 /* C Close the file. */
484 /* C */
485 /* CALL DAFCLS ( HANDLE ) */
486
487 /* $ Restrictions */
488
489 /* None. */
490
491 /* $ Literature_References */
492
493 /* None. */
494
495 /* $ Author_and_Institution */
496
497 /* N.J. Bachman (JPL) */
498 /* K.S. Zukor (JPL) */
499
500 /* $ Version */
501
502 /* - SPICELIB Version 1.0.0, 17-JAN-2017 (NJB) (KSZ) */
503
504 /* -& */
505 /* $ Index_Entries */
506
507 /* write spk type_20 data segment */
508
509 /* -& */
510
511 /* SPICELIB functions */
512
513
514 /* Local Parameters */
515
516
517 /* DTYPE is the SPK data type. */
518
519
520 /* ND is the number of double precision components in an SPK */
521 /* segment descriptor. SPK uses ND = 2. */
522
523
524 /* NI is the number of integer components in an SPK segment */
525 /* descriptor. SPK uses NI = 6. */
526
527
528 /* NS is the size of a packed SPK segment descriptor. */
529
530
531 /* SIDLEN is the maximum number of characters allowed in an */
532 /* SPK segment identifier. */
533
534
535 /* Local variables */
536
537
538
539 /* Standard SPICE error handling. */
540
541 if (return_()) {
542 return 0;
543 }
544 chkin_("SPKW20", (ftnlen)6);
545
546 /* The number of sets of coefficients must be positive. */
547
548 if (*n <= 0) {
549 setmsg_("The number of sets of coordinate coefficients is not positi"
550 "ve. N = # ", (ftnlen)69);
551 errint_("#", n, (ftnlen)1);
552 sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
553 chkout_("SPKW20", (ftnlen)6);
554 return 0;
555 }
556
557 /* Make sure that the degree of the interpolating polynomials is */
558 /* in range. */
559
560 if (*polydg < 0 || *polydg > 50) {
561 setmsg_("The interpolating polynomials have degree #; the valid degr"
562 "ee range is [0, #].", (ftnlen)78);
563 errint_("#", polydg, (ftnlen)1);
564 errint_("#", &c__50, (ftnlen)1);
565 sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
566 chkout_("SPKW20", (ftnlen)6);
567 return 0;
568 }
569
570 /* The interval length must be positive. */
571
572 if (*intlen <= 0.) {
573 setmsg_("The interval length is not positive.N = #", (ftnlen)41);
574 errdp_("#", intlen, (ftnlen)1);
575 sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19);
576 chkout_("SPKW20", (ftnlen)6);
577 return 0;
578 }
579
580 /* Get the NAIF integer code for the reference frame. */
581
582 namfrm_(frame, &refcod, frame_len);
583 if (refcod == 0) {
584 setmsg_("The reference frame # is not supported.", (ftnlen)39);
585 errch_("#", frame, (ftnlen)1, frame_len);
586 sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
587 chkout_("SPKW20", (ftnlen)6);
588 return 0;
589 }
590
591 /* The segment stop time must be greater than or equal to the begin */
592 /* time. */
593
594 if (*first > *last) {
595 setmsg_("The segment start time: # (# TDB) is greater than the segme"
596 "nt end time: (# TDB).", (ftnlen)80);
597 etcal_(first, etstr, (ftnlen)40);
598 errch_("#", etstr, (ftnlen)1, (ftnlen)40);
599 errdp_("#", first, (ftnlen)1);
600 etcal_(last, netstr, (ftnlen)40);
601 errch_("#", netstr, (ftnlen)1, (ftnlen)40);
602 errdp_("#", last, (ftnlen)1);
603 sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
604 chkout_("SPKW20", (ftnlen)6);
605 return 0;
606 }
607
608 /* The distance and time scales must be positive. */
609
610 if (*dscale <= 0.) {
611 setmsg_("The distance scale is not positive.DSCALE = #", (ftnlen)45);
612 errdp_("#", dscale, (ftnlen)1);
613 sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23);
614 chkout_("SPKW20", (ftnlen)6);
615 return 0;
616 }
617 if (*tscale <= 0.) {
618 setmsg_("The time scale is not positive.TSCALE = #", (ftnlen)41);
619 errdp_("#", tscale, (ftnlen)1);
620 sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23);
621 chkout_("SPKW20", (ftnlen)6);
622 return 0;
623 }
624
625 /* The begin time of the first record must be less than or equal */
626 /* to the begin time of the segment. Convert the two-part input */
627 /* epoch to seconds past J2000 for the purpose of this check. */
628
629 btime = spd_() * (*initjd - j2000_() + *initfr);
630 ltime = btime + *n * *intlen * spd_();
631
632 /* Compute the tolerance to use for descriptor time bound checks. */
633
634 /* Computing MAX */
635 d__1 = abs(btime), d__2 = abs(ltime);
636 tol = max(d__1,d__2) * 1e-13;
637 if (*first < btime - tol) {
638 setmsg_("The segment descriptor start time # is too much less than t"
639 "he beginning time of the segment data # (in seconds past J20"
640 "00: #). The difference is # seconds; the tolerance is # seco"
641 "nds.", (ftnlen)183);
642 etcal_(first, etstr, (ftnlen)40);
643 errch_("#", etstr, (ftnlen)1, (ftnlen)40);
644 etcal_(&btime, etstr, (ftnlen)40);
645 errch_("#", etstr, (ftnlen)1, (ftnlen)40);
646 errdp_("#", first, (ftnlen)1);
647 d__1 = btime - *first;
648 errdp_("#", &d__1, (ftnlen)1);
649 errdp_("#", &tol, (ftnlen)1);
650 sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
651 chkout_("SPKW20", (ftnlen)6);
652 return 0;
653 }
654
655 /* The end time of the final record must be greater than or */
656 /* equal to the end time of the segment. */
657
658 if (*last > ltime + tol) {
659 setmsg_("The segment descriptor end time # is too much greater than "
660 "the end time of the segment data # (in seconds past J2000: #"
661 "). The difference is # seconds; the tolerance is # seconds.",
662 (ftnlen)178);
663 etcal_(last, etstr, (ftnlen)40);
664 errch_("#", etstr, (ftnlen)1, (ftnlen)40);
665 etcal_(<ime, etstr, (ftnlen)40);
666 errch_("#", etstr, (ftnlen)1, (ftnlen)40);
667 errdp_("#", last, (ftnlen)1);
668 d__1 = *last - ltime;
669 errdp_("#", &d__1, (ftnlen)1);
670 errdp_("#", &tol, (ftnlen)1);
671 sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
672 chkout_("SPKW20", (ftnlen)6);
673 return 0;
674 }
675
676 /* Now check the validity of the segment identifier. */
677
678 chckid_("SPK segment identifier", &c__40, segid, (ftnlen)22, segid_len);
679 if (failed_()) {
680 chkout_("SPKW20", (ftnlen)6);
681 return 0;
682 }
683
684 /* Store the start and end times to be associated */
685 /* with this segment. */
686
687 dcd[0] = *first;
688 dcd[1] = *last;
689
690 /* Create the integer portion of the descriptor. */
691
692 icd[0] = *body;
693 icd[1] = *center;
694 icd[2] = refcod;
695 icd[3] = 20;
696
697 /* Pack the segment descriptor. */
698
699 dafps_(&c__2, &c__6, dcd, icd, descr);
700
701 /* Begin a new segment of SPK type 20 form: */
702
703 /* Record 1 */
704 /* Record 2 */
705 /* ... */
706 /* Record N */
707 /* DSCALE ( distance scale in km ) */
708 /* TSCALE ( time scale in seconds ) */
709 /* INITJD ( integer part of initial epoch of first record, */
710 /* expressed as a TDB Julian date ) */
711 /* INITFR ( fractional part of initial epoch, in units of */
712 /* TDB Julian days ) */
713 /* INTLEN ( length of interval covered by each record, in */
714 /* units of TDB Julian days ) */
715 /* RSIZE ( number of data elements in each record ) */
716 /* N ( number of records in segment ) */
717
718 /* Each record will have the form: */
719
720 /* X coefficients */
721 /* X position component at interval midpoint */
722 /* Y coefficients */
723 /* Y position component at interval midpoint */
724 /* Z coefficients */
725 /* Z position component at interval midpoint */
726
727
728 dafbna_(handle, descr, segid, segid_len);
729
730 /* Calculate the number of entries in a record. */
731
732 ninrec = (*polydg + 2) * 3;
733
734 /* Fill segment with N records of data. */
735
736 i__1 = *n * ninrec;
737 dafada_(cdata, &i__1);
738
739 /* Store the distance and time scales. */
740
741 dafada_(dscale, &c__1);
742 dafada_(tscale, &c__1);
743
744 /* Store the integer and fractional parts of the initial epoch of */
745 /* the first record. */
746
747 dafada_(initjd, &c__1);
748 dafada_(initfr, &c__1);
749
750 /* Store the length of interval covered by each record. */
751
752 dafada_(intlen, &c__1);
753
754 /* Store the size of each record (total number of array elements). */
755 /* Note that this size is smaller by 2 than the size of a type 2 */
756 /* record of the same degree, since the record coverage midpoint */
757 /* and radius are not stored. */
758
759 d__1 = (doublereal) ninrec;
760 dafada_(&d__1, &c__1);
761
762 /* Store the number of records contained in the segment. */
763
764 numrec = (doublereal) (*n);
765 dafada_(&numrec, &c__1);
766
767 /* End this segment. */
768
769 dafena_();
770 chkout_("SPKW20", (ftnlen)6);
771 return 0;
772 } /* spkw20_ */
773
774