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