1 /* ckw06.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__196 = 196;
11 static integer c__340 = 340;
12 static integer c__23 = 23;
13 static integer c__4 = 4;
14 static integer c__2 = 2;
15 static integer c__6 = 6;
16 static integer c__1 = 1;
17
18 /* $Procedure CKW06 ( CK, Write segment, type 6 ) */
ckw06_(integer * handle,integer * inst,char * ref,logical * avflag,doublereal * first,doublereal * last,char * segid,integer * nmini,integer * npkts,integer * subtps,integer * degres,doublereal * packts,doublereal * rates,doublereal * sclkdp,doublereal * ivlbds,logical * sellst,ftnlen ref_len,ftnlen segid_len)19 /* Subroutine */ int ckw06_(integer *handle, integer *inst, char *ref,
20 logical *avflag, doublereal *first, doublereal *last, char *segid,
21 integer *nmini, integer *npkts, integer *subtps, integer *degres,
22 doublereal *packts, doublereal *rates, doublereal *sclkdp, doublereal
23 *ivlbds, logical *sellst, ftnlen ref_len, ftnlen segid_len)
24 {
25 /* Initialized data */
26
27 static integer pktszs[4] = { 8,4,14,7 };
28
29 /* System generated locals */
30 integer i__1, i__2, i__3;
31 doublereal d__1;
32
33 /* Builtin functions */
34 integer s_rnge(char *, integer, char *, integer);
35
36 /* Local variables */
37 integer addr__;
38 doublereal qneg[4];
39 integer isel;
40 extern logical even_(integer *);
41 integer ndir, i__, j, k;
42 doublereal q[4];
43 extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
44 integer *, doublereal *, integer *, doublereal *);
45 doublereal descr[5];
46 extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
47 integer bepix, eepix;
48 extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), moved_(
49 doublereal *, integer *, doublereal *);
50 doublereal prevq[4];
51 extern /* Subroutine */ int dafada_(doublereal *, integer *);
52 doublereal dc[2];
53 extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *,
54 ftnlen);
55 integer ic[6];
56 extern logical failed_(void);
57 extern /* Subroutine */ int dafena_(void);
58 integer segbeg, chrcod, refcod, segend, pktbeg;
59 extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
60 extern integer lastnb_(char *, ftnlen);
61 integer pktend;
62 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
63 ftnlen);
64 extern doublereal vdistg_(doublereal *, doublereal *, integer *);
65 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
66 integer *, ftnlen), vminug_(doublereal *, integer *, doublereal *)
67 ;
68 integer minisz;
69 extern logical vzerog_(doublereal *, integer *), return_(void);
70 integer pktdsz, winsiz, pktsiz, subtyp;
71 extern logical odd_(integer *);
72
73 /* $ Abstract */
74
75 /* Write a type 6 segment to a CK file. */
76
77 /* $ Disclaimer */
78
79 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
80 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
81 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
82 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
83 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
84 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
85 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
86 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
87 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
88 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
89
90 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
91 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
92 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
93 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
94 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
95 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
96
97 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
98 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
99 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
100 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
101
102 /* $ Required_Reading */
103
104 /* CK */
105 /* DAF */
106 /* NAIF_IDS */
107 /* SCLK */
108 /* SPC */
109 /* TIME */
110
111 /* $ Keywords */
112
113 /* ATTITUDE */
114 /* FILES */
115 /* POINTING */
116
117 /* $ Declarations */
118 /* $ Abstract */
119
120 /* Declare parameters specific to CK type 06. */
121
122 /* $ Disclaimer */
123
124 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
125 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
126 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
127 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
128 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
129 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
130 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
131 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
132 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
133 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
134
135 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
136 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
137 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
138 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
139 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
140 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
141
142 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
143 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
144 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
145 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
146
147 /* $ Required_Reading */
148
149 /* CK */
150
151 /* $ Keywords */
152
153 /* CK */
154
155 /* $ Restrictions */
156
157 /* None. */
158
159 /* $ Author_and_Institution */
160
161 /* N.J. Bachman (JPL) */
162 /* B.V. Semenov (JPL) */
163
164 /* $ Literature_References */
165
166 /* None. */
167
168 /* $ Version */
169
170 /* - SPICELIB Version 1.0.0, 10-MAR-2014 (NJB) (BVS) */
171
172 /* -& */
173
174 /* Maximum polynomial degree supported by the current */
175 /* implementation of this CK type. */
176
177
178 /* Integer code indicating `true': */
179
180
181 /* Integer code indicating `false': */
182
183
184 /* CK type 6 subtype codes: */
185
186
187 /* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */
188 /* and quaternion derivatives only, no angular velocity */
189 /* vector provided. Quaternion elements are listed */
190 /* first, followed by derivatives. Angular velocity is */
191 /* derived from the quaternions and quaternion */
192 /* derivatives. */
193
194
195 /* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */
196 /* only. Angular velocity is derived by differentiating */
197 /* the interpolating polynomials. */
198
199
200 /* Subtype 2: Hermite interpolation, 14-element packets. */
201 /* Quaternion and angular angular velocity vector, as */
202 /* well as derivatives of each, are provided. The */
203 /* quaternion comes first, then quaternion derivatives, */
204 /* then angular velocity and its derivatives. */
205
206
207 /* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */
208 /* and angular velocity vector provided. The quaternion */
209 /* comes first. */
210
211
212 /* Number of subtypes: */
213
214
215 /* Packet sizes associated with the various subtypes: */
216
217
218 /* Maximum packet size for type 6: */
219
220
221 /* Minimum packet size for type 6: */
222
223
224 /* The CKPFS record size declared in ckparam.inc must be at least as */
225 /* large as the maximum possible size of a CK type 6 record. */
226
227 /* The largest possible CK type 6 record has subtype 3 (note that */
228 /* records of subtype 2 have half as many epochs as those of subtype */
229 /* 3, for a given polynomial degree). A subtype 3 record contains */
230
231 /* - The evaluation epoch */
232 /* - The subtype and packet count */
233 /* - MAXDEG+1 packets of size C06PS3 */
234 /* - MAXDEG+1 time tags */
235
236
237 /* End of file ck06.inc. */
238
239 /* $ Abstract */
240
241 /* Declarations of the CK data type specific and general CK low */
242 /* level routine parameters. */
243
244 /* $ Disclaimer */
245
246 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
247 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
248 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
249 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
250 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
251 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
252 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
253 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
254 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
255 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
256
257 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
258 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
259 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
260 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
261 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
262 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
263
264 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
265 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
266 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
267 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
268
269 /* $ Required_Reading */
270
271 /* CK.REQ */
272
273 /* $ Keywords */
274
275 /* CK */
276
277 /* $ Restrictions */
278
279 /* 1) If new CK types are added, the size of the record passed */
280 /* between CKRxx and CKExx must be registered as separate */
281 /* parameter. If this size will be greater than current value */
282 /* of the CKMRSZ parameter (which specifies the maximum record */
283 /* size for the record buffer used inside CKPFS) then it should */
284 /* be assigned to CKMRSZ as a new value. */
285
286 /* $ Author_and_Institution */
287
288 /* N.J. Bachman (JPL) */
289 /* B.V. Semenov (JPL) */
290
291 /* $ Literature_References */
292
293 /* CK Required Reading. */
294
295 /* $ Version */
296
297 /* - SPICELIB Version 3.0.0, 27-JAN-2014 (NJB) */
298
299 /* Updated to support CK type 6. Maximum degree for */
300 /* type 5 was updated to be consistent with the */
301 /* maximum degree for type 6. */
302
303 /* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
304
305 /* Updated to support CK type 5. */
306
307 /* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
308
309 /* -& */
310
311 /* Number of quaternion components and number of quaternion and */
312 /* angular rate components together. */
313
314
315 /* CK Type 1 parameters: */
316
317 /* CK1DTP CK data type 1 ID; */
318
319 /* CK1RSZ maximum size of a record passed between CKR01 */
320 /* and CKE01. */
321
322
323 /* CK Type 2 parameters: */
324
325 /* CK2DTP CK data type 2 ID; */
326
327 /* CK2RSZ maximum size of a record passed between CKR02 */
328 /* and CKE02. */
329
330
331 /* CK Type 3 parameters: */
332
333 /* CK3DTP CK data type 3 ID; */
334
335 /* CK3RSZ maximum size of a record passed between CKR03 */
336 /* and CKE03. */
337
338
339 /* CK Type 4 parameters: */
340
341 /* CK4DTP CK data type 4 ID; */
342
343 /* CK4PCD parameter defining integer to DP packing schema that */
344 /* is applied when seven number integer array containing */
345 /* polynomial degrees for quaternion and angular rate */
346 /* components packed into a single DP number stored in */
347 /* actual CK records in a file; the value of must not be */
348 /* changed or compatibility with existing type 4 CK files */
349 /* will be lost. */
350
351 /* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
352 /* records; the value of this parameter must never exceed */
353 /* value of the CK4PCD; */
354
355 /* CK4SFT number of additional DPs, which are not polynomial */
356 /* coefficients, located at the beginning of a type 4 */
357 /* CK record that passed between routines CKR04 and CKE04; */
358
359 /* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
360 /* and CKE04; CK4RSZ is computed as follows: */
361
362 /* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
363
364
365 /* CK Type 5 parameters: */
366
367
368 /* CK5DTP CK data type 5 ID; */
369
370 /* CK5MXD maximum polynomial degree allowed in type 5 */
371 /* records. */
372
373 /* CK5MET number of additional DPs, which are not polynomial */
374 /* coefficients, located at the beginning of a type 5 */
375 /* CK record that passed between routines CKR05 and CKE05; */
376
377 /* CK5MXP maximum packet size for any subtype. Subtype 2 */
378 /* has the greatest packet size, since these packets */
379 /* contain a quaternion, its derivative, an angular */
380 /* velocity vector, and its derivative. See ck05.inc */
381 /* for a description of the subtypes. */
382
383 /* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
384 /* and CKE05; CK5RSZ is computed as follows: */
385
386 /* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
387
388
389 /* CK Type 6 parameters: */
390
391
392 /* CK6DTP CK data type 6 ID; */
393
394 /* CK6MXD maximum polynomial degree allowed in type 6 */
395 /* records. */
396
397 /* CK6MET number of additional DPs, which are not polynomial */
398 /* coefficients, located at the beginning of a type 6 */
399 /* CK record that passed between routines CKR06 and CKE06; */
400
401 /* CK6MXP maximum packet size for any subtype. Subtype 2 */
402 /* has the greatest packet size, since these packets */
403 /* contain a quaternion, its derivative, an angular */
404 /* velocity vector, and its derivative. See ck06.inc */
405 /* for a description of the subtypes. */
406
407 /* CK6RSZ maximum size of type 6 CK record passed between CKR06 */
408 /* and CKE06; CK6RSZ is computed as follows: */
409
410 /* CK6RSZ = CK6MET + ( CK6MXD + 1 ) * ( CK6PS3 + 1 ) */
411
412 /* where CK6PS3 is equal to the parameter CK06PS3 defined */
413 /* in ck06.inc. Note that the subtype having the largest */
414 /* packet size (subtype 2) does not give rise to the */
415 /* largest record size, because that type is Hermite and */
416 /* requires half the window size used by subtype 3 for a */
417 /* given polynomial degree. */
418
419
420 /* The parameter CK6PS3 must be in sync with C06PS3 defined in */
421 /* ck06.inc. */
422
423
424
425 /* Maximum record size that can be handled by CKPFS. This value */
426 /* must be set to the maximum of all CKxRSZ parameters (currently */
427 /* CK5RSZ.) */
428
429 /* $ Brief_I/O */
430
431 /* Variable I/O Description */
432 /* -------- --- -------------------------------------------------- */
433 /* HANDLE I Handle of a CK file open for writing. */
434 /* INST I NAIF instrument ID code. */
435 /* REF I Reference frame name. */
436 /* AVFLAG I True if the segment will contain angular velocity. */
437 /* FIRST I Start time of interval covered by segment. */
438 /* LAST I End time of interval covered by segment. */
439 /* SEGID I Segment identifier. */
440 /* NMINI I Number of mini-segments. */
441 /* NPKTS I Array of packet counts of mini-segments. */
442 /* SUBTPS I Array of segment subtypes of mini-segments. */
443 /* DEGRES I Array of polynomial degrees of mini-segments. */
444 /* PACKTS I Array of data packets of mini-segments. */
445 /* RATES I Nominal SCLK rates in seconds per tick. */
446 /* SCLKDP I Array of epochs of mini-segments. */
447 /* IVLBDS I Mini-segment interval bounds. */
448 /* SELLST I Interval selection flag. */
449 /* MAXDEG P Maximum allowed degree of interpolating polynomial. */
450
451 /* $ Detailed_Input */
452
453 /* HANDLE is the handle of a CK file that has been opened */
454 /* for writing. */
455
456
457 /* INST is a NAIF integer code associated with an */
458 /* instrument or spacecraft structure whose */
459 /* orientation is described by the segment to be */
460 /* created. INST is treated by the SPICE frame */
461 /* subsystem as a CK frame class ID (see the */
462 /* Frames Required Reading for details). */
463
464
465 /* AVFLAG is a logical flag which indicates whether or not */
466 /* the segment will contain angular velocity. */
467
468
469 /* REF is the NAIF name for a reference frame relative to */
470 /* which the pointing (attitude) information for INST */
471 /* is specified. */
472
473 /* FIRST, */
474 /* LAST are, respectively, the bounds of the time interval */
475 /* over which the segment defines the attitude of */
476 /* INST. FIRST and LAST are encoded SCLK times. */
477
478 /* FIRST must be greater than or equal to the first */
479 /* mini-segment interval start time; LAST must be */
480 /* less than or equal to the last mini-segment */
481 /* interval stop time. See the description of IVLBDS */
482 /* below. */
483
484
485 /* SEGID is the segment identifier. A CK segment */
486 /* identifier may contain up to 40 characters. */
487
488
489 /* NMINI is the number of mini-segments comprised by */
490 /* the input data. Each mini-segment contains data */
491 /* that could be stored in a type 5 segment. */
492 /* The parameters and data of a mini-segment are: */
493
494 /* - a packet count */
495 /* - a type 6 subtype */
496 /* - an interpolating polynomial degree */
497 /* - a nominal SCLK rate in seconds/tick */
498 /* - a sequence of type 6 data packets */
499 /* - a sequence of packet epochs */
500
501 /* These inputs are described below. */
502
503
504 /* NPKTS is an array of packet counts. The Ith element of */
505 /* NPKTS is the packet count of the Ith mini-segment. */
506
507 /* NPKTS has dimension NMINI. */
508
509
510 /* SUBTPS is an array of type 6 subtypes. The Ith element of */
511 /* SUBTPS is the subtype of the packets associated */
512 /* with the Ith mini-segment. */
513
514 /* SUBTPS has dimension NMINI. */
515
516
517 /* DEGRES is an array of interpolating polynomial degrees. */
518 /* The Ith element of DEGRES is the polynomial degree */
519 /* of the packets associated with the Ith */
520 /* mini-segment. */
521
522 /* For subtypes 0 and 2, interpolation degrees must be */
523 /* equivalent to 3 mod 4, that is, they must be in */
524 /* the set */
525
526 /* { 3, 7, 11, ..., MAXDEG } */
527
528 /* For subtypes 1 and 3, interpolation degrees must */
529 /* be odd and must be in the range 1:MAXDEG. */
530
531 /* DEGRES has dimension NMINI. */
532
533
534 /* PACKTS is an array of data packets representing the */
535 /* orientation of INST relative to the frame REF. The */
536 /* packets for a given mini-segment are stored */
537 /* contiguously in increasing time order. The order */
538 /* of the sets of packets for different mini-segments */
539 /* is the same as the order of their corresponding */
540 /* mini-segment intervals. */
541
542 /* Each packet contains a SPICE-style quaternion and */
543 /* optionally, depending on the segment subtype, */
544 /* attitude derivative data, from which a C-matrix */
545 /* and an angular velocity vector may be derived. */
546
547 /* See the discussion of quaternion styles in */
548 /* Particulars below. */
549
550 /* The C-matrix CMAT represented by the Ith data */
551 /* packet is a rotation matrix that transforms the */
552 /* components of a vector expressed in the base frame */
553 /* specified by REF to components expressed in the */
554 /* instrument fixed frame at the time SCLKDP(I). */
555
556 /* Thus, if a vector V has components x, y, z in the */
557 /* base frame, then V has components x', y', z' */
558 /* in the instrument fixed frame where: */
559
560 /* [ x' ] [ ] [ x ] */
561 /* | y' | = | CMAT | | y | */
562 /* [ z' ] [ ] [ z ] */
563
564 /* Attitude derivative information either explicitly */
565 /* contained in, or else derived from, PACKTS(I) */
566 /* gives the angular velocity of the instrument fixed */
567 /* frame at time SCLKDP(I) with respect to the */
568 /* reference frame specified by REF. */
569
570 /* The direction of an angular velocity vector gives */
571 /* the right-handed axis about which the instrument */
572 /* fixed reference frame is rotating. The magnitude */
573 /* of the vector is the magnitude of the */
574 /* instantaneous velocity of the rotation, in radians */
575 /* per second. */
576
577 /* Packet contents and the corresponding */
578 /* interpolation methods depend on the segment */
579 /* subtype, and are as follows: */
580
581 /* Subtype 0: Hermite interpolation, 8-element */
582 /* packets. Quaternion and quaternion */
583 /* derivatives only, no angular */
584 /* velocity vector provided. */
585 /* Quaternion elements are listed */
586 /* first, followed by derivatives. */
587 /* Angular velocity is derived from */
588 /* the quaternions and quaternion */
589 /* derivatives. */
590
591 /* Subtype 1: Lagrange interpolation, 4-element */
592 /* packets. Quaternion only. Angular */
593 /* velocity is derived by */
594 /* differentiating the interpolating */
595 /* polynomials. */
596
597 /* Subtype 2: Hermite interpolation, 14-element */
598 /* packets. Quaternion and angular */
599 /* velocity vector, as well as */
600 /* derivatives of each, are provided. */
601 /* The quaternion comes first, then */
602 /* quaternion derivatives, then */
603 /* angular velocity and its */
604 /* derivatives. */
605
606 /* Subtype 3: Lagrange interpolation, 7-element */
607 /* packets. Quaternion and angular */
608 /* velocity vector provided. The */
609 /* quaternion comes first. */
610
611 /* Angular velocity is always specified relative to */
612 /* the base frame. */
613
614 /* Units of the input data are: */
615
616 /* Quaternions unitless */
617 /* Quaternion derivatives 1/TDB second */
618 /* Angular velocity radians/TDB second */
619 /* Angular acceleration radians/TDB second**2 */
620
621 /* For the Hermite subtypes (0 and 2), quaternion */
622 /* representations must be selected so that, for */
623 /* consecutive quaternions Q(I) and Q(I+1) in a */
624 /* mini-segment, the distance between Q and Q(I+1) is */
625 /* less than the distance between Q and -Q(I+1). The */
626 /* Lagrange subtypes do not have this restriction. */
627
628
629 /* RATES is an array of nominal rates of the spacecraft */
630 /* clock associated with INST. The Ith element of */
631 /* rates is the clock rate for the packets associated */
632 /* with the Ith mini-segment. Units are seconds per */
633 /* tick. Spacecraft clock rates are used to scale */
634 /* angular velocity to radians/second. */
635
636
637 /* SCLKDP is an array containing epochs for all input */
638 /* mini-segments. The epochs have a one-to-one */
639 /* relationship with the packets in the input */
640 /* packet array. The epochs are encoded SCLK times. */
641
642 /* The epochs for a given mini-segment are stored */
643 /* contiguously in increasing order. The order of the */
644 /* sets of epochs for different mini-segments is the */
645 /* same as the order of their corresponding */
646 /* mini-segment intervals. */
647
648 /* For each mini-segment, "padding" is allowed: the */
649 /* sequence of epochs for that mini-segment may start */
650 /* before the corresponding mini-segment interval */
651 /* start time and end after the corresponding */
652 /* mini-segment interval stop time. Padding is used */
653 /* to control behavior of interpolating polynomials */
654 /* near mini-segment interval boundaries. */
655
656 /* Due to possible use of padding, the elements of */
657 /* SCLKDP, taken as a whole, might not be in */
658 /* increasing order. */
659
660
661 /* IVLBDS is an array of mini-segment interval boundary */
662 /* times. This array is a strictly increasing list of */
663 /* the mini-segment interval start times, to which */
664 /* the end time for the last interval is appended. */
665 /* The interval bounds are encoded SCLK times. */
666
667 /* The Ith mini-segment interval is the time */
668 /* coverage interval of the Ith mini-segment (see the */
669 /* description of NPKTS above). */
670
671 /* For each mini-segment, the corresponding */
672 /* mini-segment interval's start time is greater */
673 /* than or equal to the mini-segment's first epoch. */
674 /* The interval's stop time may exceed the */
675 /* mini-segment's last epoch, allowing a single */
676 /* coverage gap to exist between a mini-segment's */
677 /* last epoch and its interval stop time. */
678
679 /* The "interpolation interval" of the ith */
680 /* mini-segment is contained in the ith mini-segment */
681 /* interval: the interpolation interval extends from */
682 /* IVLBDS(I) to the minimum of IVLBDS(I+1) and the */
683 /* last epoch of the mini-segment. */
684
685 /* For each mini-segment interval other than the */
686 /* last, the interval's coverage stop time coincides */
687 /* with the coverage start time of the next interval. */
688
689 /* IVLBDS has dimension NMINI+1. */
690
691
692 /* SELLST is a logical flag indicating to the CK type 6 */
693 /* segment reader CKR06 how to select the */
694 /* mini-segment interval when a request time */
695 /* coincides with a time boundary shared by two */
696 /* mini-segment intervals. When SELLST ("select */
697 /* last") is .TRUE., the later interval is selected; */
698 /* otherwise the earlier interval is selected. */
699
700 /* $ Detailed_Output */
701
702 /* None. See $Particulars for a description of the effect of this */
703 /* routine. */
704
705 /* $ Parameters */
706
707 /* MAXDEG is the maximum allowed degree of the interpolating */
708 /* polynomial. */
709
710 /* See the INCLUDE file ck06.inc for the value of */
711 /* MAXDEG. */
712
713 /* $ Exceptions */
714
715 /* If any of the following exceptions occur, this routine will return */
716 /* without creating a new segment. */
717
718
719 /* 1) If FIRST is greater than LAST then the error */
720 /* SPICE(BADDESCRTIMES) will be signaled. */
721
722 /* 2) If REF is not a recognized name, the error */
723 /* SPICE(INVALIDREFFRAME) is signaled. */
724
725 /* 3) If the last non-blank character of SEGID occurs past index */
726 /* 40, the error SPICE(SEGIDTOOLONG) is signaled. */
727
728 /* 4) If SEGID contains any nonprintable characters, the error */
729 /* SPICE(NONPRINTABLECHARS) is signaled. */
730
731 /* 5) If NMINI is not at least 1, the error SPICE(INVALIDCOUNT) */
732 /* is signaled. */
733
734 /* 6) If the elements of the array IVLBDS are not in strictly */
735 /* increasing order, the error SPICE(BOUNDSOUTOFORDER) will be */
736 /* signaled. */
737
738 /* 7) If the first interval start time IVLBDS(1) is greater than */
739 /* FIRST, or if the last interval end time IVLBDS(NMINI+1) is */
740 /* less than LAST, the error SPICE(COVERAGEGAP) will be */
741 /* signaled. */
742
743 /* 8) If any packet count in the array NPKTS is not at least 2, the */
744 /* error SPICE(TOOFEWPACKETS) will be signaled. */
745
746 /* 9) If any subtype code in the array SUBTPS is not recognized, */
747 /* the error SPICE(INVALIDSUBTYPE) will be signaled. */
748
749 /* 10) If any interpolation degree in the array DEGRES is not at */
750 /* least 1 or is greater than MAXDEG, the error */
751 /* SPICE(INVALIDDEGREE) is signaled. */
752
753 /* 11) If the window size implied by any element of the array DEGRES */
754 /* is odd, the error SPICE(BADWINDOWSIZE) is signaled. */
755
756 /* 12) If the elements of the array SCLKDP corresponding */
757 /* to a given mini-segment are not in strictly */
758 /* increasing order, the error SPICE(TIMESOUTOFORDER) will be */
759 /* signaled. */
760
761 /* 13) If the first epoch of a mini-segment exceeds the start time */
762 /* of the associated mini-segment interval, or if the last */
763 /* epoch of a mini-segment is less than the interval start */
764 /* time, the error SPICE(BOUNDSDISAGREE) is signaled. However, */
765 /* the last epoch of a mini-segment may be less than the end */
766 /* time of the corresponding mini-segment interval. */
767
768 /* 14) If any quaternion has magnitude zero, the error */
769 /* SPICE(ZEROQUATERNION) is signaled. */
770
771 /* 15) Any error that occurs while writing the output segment will */
772 /* be diagnosed by routines in the call tree of this routine. */
773
774 /* 16) This routine assumes that the rotation between adjacent */
775 /* quaternions that are stored in the same interval has a */
776 /* rotation angle of THETA radians, where */
777
778 /* 0 < THETA < pi. */
779 /* _ */
780
781 /* The routines that evaluate the data in the segment produced */
782 /* by this routine cannot distinguish between rotations of THETA */
783 /* radians, where THETA is in the interval [0, pi), and */
784 /* rotations of */
785
786 /* THETA + 2 * k * pi */
787
788 /* radians, where k is any integer. These "large" rotations will */
789 /* yield invalid results when interpolated. The segment creator */
790 /* must ensure that the data stored in the segment will not be */
791 /* subject to this sort of ambiguity. */
792
793 /* 17) For the Hermite subtypes (0 and 2), quaternion */
794 /* representations must be selected so that, for consecutive */
795 /* quaternions Q(I) and Q(I+1) in a mini-segment, the distance */
796 /* between Q and Q(I+1) is less than the distance between Q and */
797 /* -Q(I+1). */
798
799 /* If a pair of quaternions violating this condition is found */
800 /* in the input array PACKTS, the error SPICE(BADQUATSIGN) will */
801 /* be signaled. */
802
803 /* 18) If any element of the input RATES array is non-positive, the */
804 /* error SPICE(INVALIDSCLKRATE) will be signaled. */
805
806 /* $ Files */
807
808 /* A new type 6 CK segment is written to the CK file attached */
809 /* to HANDLE. */
810
811 /* $ Particulars */
812
813 /* This routine writes a CK type 6 data segment to the open CK */
814 /* file according to the format described in the type 6 section of */
815 /* the CK Required Reading. The CK file must have been opened with */
816 /* write access. */
817
818
819 /* Quaternion Styles */
820 /* ----------------- */
821
822 /* There are different "styles" of quaternions used in */
823 /* science and engineering applications. Quaternion styles */
824 /* are characterized by */
825
826 /* - The order of quaternion elements */
827
828 /* - The quaternion multiplication formula */
829
830 /* - The convention for associating quaternions */
831 /* with rotation matrices */
832
833 /* Two of the commonly used styles are */
834
835 /* - "SPICE" */
836
837 /* > Invented by Sir William Rowan Hamilton */
838 /* > Frequently used in mathematics and physics textbooks */
839
840 /* - "Engineering" */
841
842 /* > Widely used in aerospace engineering applications */
843
844
845 /* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */
846 /* Quaternions of any other style must be converted to SPICE */
847 /* quaternions before they are passed to SPICELIB routines. */
848
849
850 /* Relationship between SPICE and Engineering Quaternions */
851 /* ------------------------------------------------------ */
852
853 /* Let M be a rotation matrix such that for any vector V, */
854
855 /* M*V */
856
857 /* is the result of rotating V by theta radians in the */
858 /* counterclockwise direction about unit rotation axis vector A. */
859 /* Then the SPICE quaternions representing M are */
860
861 /* (+/-) ( cos(theta/2), */
862 /* sin(theta/2) A(1), */
863 /* sin(theta/2) A(2), */
864 /* sin(theta/2) A(3) ) */
865
866 /* while the engineering quaternions representing M are */
867
868 /* (+/-) ( -sin(theta/2) A(1), */
869 /* -sin(theta/2) A(2), */
870 /* -sin(theta/2) A(3), */
871 /* cos(theta/2) ) */
872
873 /* For both styles of quaternions, if a quaternion q represents */
874 /* a rotation matrix M, then -q represents M as well. */
875
876 /* Given an engineering quaternion */
877
878 /* QENG = ( q0, q1, q2, q3 ) */
879
880 /* the equivalent SPICE quaternion is */
881
882 /* QSPICE = ( q3, -q0, -q1, -q2 ) */
883
884
885 /* Associating SPICE Quaternions with Rotation Matrices */
886 /* ---------------------------------------------------- */
887
888 /* Let FROM and TO be two right-handed reference frames, for */
889 /* example, an inertial frame and a spacecraft-fixed frame. Let the */
890 /* symbols */
891
892 /* V , V */
893 /* FROM TO */
894
895 /* denote, respectively, an arbitrary vector expressed relative to */
896 /* the FROM and TO frames. Let M denote the transformation matrix */
897 /* that transforms vectors from frame FROM to frame TO; then */
898
899 /* V = M * V */
900 /* TO FROM */
901
902 /* where the expression on the right hand side represents left */
903 /* multiplication of the vector by the matrix. */
904
905 /* Then if the unit-length SPICE quaternion q represents M, where */
906
907 /* q = (q0, q1, q2, q3) */
908
909 /* the elements of M are derived from the elements of q as follows: */
910
911 /* +- -+ */
912 /* | 2 2 | */
913 /* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */
914 /* | | */
915 /* | | */
916 /* | 2 2 | */
917 /* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */
918 /* | | */
919 /* | | */
920 /* | 2 2 | */
921 /* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */
922 /* | | */
923 /* +- -+ */
924
925 /* Note that substituting the elements of -q for those of q in the */
926 /* right hand side leaves each element of M unchanged; this shows */
927 /* that if a quaternion q represents a matrix M, then so does the */
928 /* quaternion -q. */
929
930 /* To map the rotation matrix M to a unit quaternion, we start by */
931 /* decomposing the rotation matrix as a sum of symmetric */
932 /* and skew-symmetric parts: */
933
934 /* 2 */
935 /* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */
936
937 /* symmetric skew-symmetric */
938
939
940 /* OMEGA is a skew-symmetric matrix of the form */
941
942 /* +- -+ */
943 /* | 0 -n3 n2 | */
944 /* | | */
945 /* OMEGA = | n3 0 -n1 | */
946 /* | | */
947 /* | -n2 n1 0 | */
948 /* +- -+ */
949
950 /* The vector N of matrix entries (n1, n2, n3) is the rotation axis */
951 /* of M and theta is M's rotation angle. Note that N and theta */
952 /* are not unique. */
953
954 /* Let */
955
956 /* C = cos(theta/2) */
957 /* S = sin(theta/2) */
958
959 /* Then the unit quaternions Q corresponding to M are */
960
961 /* Q = +/- ( C, S*n1, S*n2, S*n3 ) */
962
963 /* The mappings between quaternions and the corresponding rotations */
964 /* are carried out by the SPICELIB routines */
965
966 /* Q2M {quaternion to matrix} */
967 /* M2Q {matrix to quaternion} */
968
969 /* M2Q always returns a quaternion with scalar part greater than */
970 /* or equal to zero. */
971
972
973 /* SPICE Quaternion Multiplication Formula */
974 /* --------------------------------------- */
975
976 /* Given a SPICE quaternion */
977
978 /* Q = ( q0, q1, q2, q3 ) */
979
980 /* corresponding to rotation axis A and angle theta as above, we can */
981 /* represent Q using "scalar + vector" notation as follows: */
982
983 /* s = q0 = cos(theta/2) */
984
985 /* v = ( q1, q2, q3 ) = sin(theta/2) * A */
986
987 /* Q = s + v */
988
989 /* Let Q1 and Q2 be SPICE quaternions with respective scalar */
990 /* and vector parts s1, s2 and v1, v2: */
991
992 /* Q1 = s1 + v1 */
993 /* Q2 = s2 + v2 */
994
995 /* We represent the dot product of v1 and v2 by */
996
997 /* <v1, v2> */
998
999 /* and the cross product of v1 and v2 by */
1000
1001 /* v1 x v2 */
1002
1003 /* Then the SPICE quaternion product is */
1004
1005 /* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */
1006
1007 /* If Q1 and Q2 represent the rotation matrices M1 and M2 */
1008 /* respectively, then the quaternion product */
1009
1010 /* Q1*Q2 */
1011
1012 /* represents the matrix product */
1013
1014 /* M1*M2 */
1015
1016
1017 /* $ Examples */
1018
1019 /* Suppose that you have states and are prepared to produce */
1020 /* a segment of type 6 in a CK file. */
1021
1022 /* The following code fragment could be used to add the new segment */
1023 /* to a previously opened CK file attached to HANDLE. The file must */
1024 /* have been opened with write access. */
1025
1026 /* C */
1027 /* C Create a segment identifier. */
1028 /* C */
1029 /* SEGID = 'MY_SAMPLE_CK_TYPE_6_SEGMENT' */
1030
1031 /* C */
1032 /* C Write the segment. */
1033 /* C */
1034 /* CALL CKW06 ( HANDLE, INST, REF, AVFLAG, */
1035 /* . FIRST, LAST, SEGID, NMINI, */
1036 /* . NPKTS, SUBTPS, DEGRES, PACKTS, */
1037 /* . RATES, SCLKDP, IVLBDS, SELLST ) */
1038
1039
1040 /* $ Restrictions */
1041
1042 /* None. */
1043
1044 /* $ Literature_References */
1045
1046 /* None. */
1047
1048 /* $ Author_and_Institution */
1049
1050 /* N.J. Bachman (JPL) */
1051 /* B.V. Semenov (JPL) */
1052
1053 /* $ Version */
1054
1055 /* - SPICELIB Version 2.0.0, 11-AUG-2015 (NJB) */
1056
1057 /* Added check for invalid SCLK rates. */
1058
1059 /* Corrected error in header Exceptions section: changed */
1060 /* subscript N+1 to NMINI+1. Corrected typo in description */
1061 /* of subtype 2 data. Added mention of angular acceleration */
1062 /* units. */
1063
1064 /* - SPICELIB Version 1.0.0, 14-MAR-2014 (NJB) (BVS) */
1065
1066 /* -& */
1067 /* $ Index_Entries */
1068
1069 /* write spk type_6 ephemeris data segment */
1070
1071 /* -& */
1072
1073 /* SPICELIB functions */
1074
1075
1076 /* Local parameters */
1077
1078
1079 /* Packet structure parameters */
1080
1081
1082 /* Local variables */
1083
1084
1085 /* Saved values */
1086
1087
1088 /* Initial values */
1089
1090
1091 /* Standard SPICE error handling. */
1092
1093 if (return_()) {
1094 return 0;
1095 }
1096 chkin_("CKW06", (ftnlen)5);
1097
1098 /* Start with a parameter compatibility check. */
1099
1100 if (FALSE_) {
1101 setmsg_("CK type 6 record size is #, but CKPFS record size is #.is #."
1102 , (ftnlen)60);
1103 errint_("#", &c__196, (ftnlen)1);
1104 errint_("#", &c__340, (ftnlen)1);
1105 sigerr_("SPICE(BUG)", (ftnlen)10);
1106 chkout_("CKW06", (ftnlen)5);
1107 return 0;
1108 }
1109
1110 /* Make sure the segment descriptor bounds are */
1111 /* correctly ordered. */
1112
1113 if (*last < *first) {
1114 setmsg_("Segment start time is #; stop time is #; bounds must be in "
1115 "nondecreasing order.", (ftnlen)79);
1116 errdp_("#", first, (ftnlen)1);
1117 errdp_("#", last, (ftnlen)1);
1118 sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
1119 chkout_("CKW06", (ftnlen)5);
1120 return 0;
1121 }
1122
1123 /* Get the NAIF integer code for the reference frame. */
1124
1125 namfrm_(ref, &refcod, ref_len);
1126 if (refcod == 0) {
1127 setmsg_("The reference frame # is not supported.", (ftnlen)39);
1128 errch_("#", ref, (ftnlen)1, ref_len);
1129 sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
1130 chkout_("CKW06", (ftnlen)5);
1131 return 0;
1132 }
1133
1134 /* Check to see if the segment identifier is too long. */
1135
1136 if (lastnb_(segid, segid_len) > 40) {
1137 setmsg_("Segment identifier contains more than 40 characters.", (
1138 ftnlen)52);
1139 sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
1140 chkout_("CKW06", (ftnlen)5);
1141 return 0;
1142 }
1143
1144 /* Now check that all the characters in the segment identifier */
1145 /* can be printed. */
1146
1147 i__1 = lastnb_(segid, segid_len);
1148 for (i__ = 1; i__ <= i__1; ++i__) {
1149 chrcod = *(unsigned char *)&segid[i__ - 1];
1150 if (chrcod < 32 || chrcod > 126) {
1151 setmsg_("The segment identifier contains nonprintable characters",
1152 (ftnlen)55);
1153 sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
1154 chkout_("CKW06", (ftnlen)5);
1155 return 0;
1156 }
1157 }
1158
1159 /* The mini-segment count must be positive. */
1160
1161 if (*nmini < 1) {
1162 setmsg_("Mini-segment count was #; this count must be positive.", (
1163 ftnlen)54);
1164 errint_("#", nmini, (ftnlen)1);
1165 sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
1166 chkout_("CKW06", (ftnlen)5);
1167 return 0;
1168 }
1169
1170 /* Make sure the interval bounds form a strictly */
1171 /* increasing sequence. */
1172
1173 /* Note that there are NMINI+1 bounds. */
1174
1175 i__1 = *nmini;
1176 for (i__ = 1; i__ <= i__1; ++i__) {
1177 if (ivlbds[i__ - 1] >= ivlbds[i__]) {
1178 setmsg_("Mini-segment interval bounds at indices # and # are # a"
1179 "nd # respectively. The difference is #. The bounds are r"
1180 "equired to be strictly increasing.", (ftnlen)145);
1181 errint_("#", &i__, (ftnlen)1);
1182 i__2 = i__ + 1;
1183 errint_("#", &i__2, (ftnlen)1);
1184 errdp_("#", &ivlbds[i__ - 1], (ftnlen)1);
1185 errdp_("#", &ivlbds[i__], (ftnlen)1);
1186 d__1 = ivlbds[i__] - ivlbds[i__ - 1];
1187 errdp_("#", &d__1, (ftnlen)1);
1188 sigerr_("SPICE(BOUNDSOUTOFORDER)", (ftnlen)23);
1189 chkout_("CKW06", (ftnlen)5);
1190 return 0;
1191 }
1192 }
1193
1194 /* Make sure the time span of the descriptor doesn't extend */
1195 /* beyond the span of the interval bounds. */
1196
1197 if (*first < ivlbds[0] || *last > ivlbds[*nmini]) {
1198 setmsg_("First mini-segment interval start time is #; segment start "
1199 "time is #; segment stop time is #; last mini-segment interva"
1200 "l stop time is #. This sequence of times is required to be n"
1201 "on-decreasing: segment coverage must be contained within the"
1202 " union of the mini-segment intervals.", (ftnlen)276);
1203 errdp_("#", ivlbds, (ftnlen)1);
1204 errdp_("#", first, (ftnlen)1);
1205 errdp_("#", last, (ftnlen)1);
1206 errdp_("#", &ivlbds[*nmini], (ftnlen)1);
1207 sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
1208 chkout_("CKW06", (ftnlen)5);
1209 return 0;
1210 }
1211
1212 /* Check the input data before writing to the file. */
1213
1214 /* This order of operations entails some redundant */
1215 /* calculations, but it allows for rapid error */
1216 /* detection. */
1217
1218 /* Initialize the mini-segment packet array indices, */
1219 /* and those of the mini-segment epoch array as well. */
1220
1221 pktbeg = 0;
1222 pktend = 0;
1223 bepix = 0;
1224 eepix = 0;
1225 i__1 = *nmini;
1226 for (i__ = 1; i__ <= i__1; ++i__) {
1227
1228 /* First, just make sure the packet count for the current */
1229 /* mini-segment is at least two. This check reduces our chances */
1230 /* of a subscript range violation. */
1231
1232 /* Check the number of packets. */
1233
1234 if (npkts[i__ - 1] < 2) {
1235 setmsg_("At least 2 packets are required for CK type 6. Number o"
1236 "f packets supplied was # in mini-segment at index #.", (
1237 ftnlen)107);
1238 errint_("#", &npkts[i__ - 1], (ftnlen)1);
1239 errint_("#", &i__, (ftnlen)1);
1240 sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20);
1241 chkout_("CKW06", (ftnlen)5);
1242 return 0;
1243 }
1244
1245 /* Set the packet size, which is a function of the subtype. Also */
1246 /* set the window size. First check the subtype, which will be */
1247 /* used as an array index. */
1248
1249 subtyp = subtps[i__ - 1];
1250 if (subtyp < 0 || subtyp > 3) {
1251 setmsg_("Unexpected CK type 6 subtype # found in mini-segment #.",
1252 (ftnlen)55);
1253 errint_("#", &subtyp, (ftnlen)1);
1254 errint_("#", &i__, (ftnlen)1);
1255 sigerr_("SPICE(INVALIDSUBTYPE)", (ftnlen)21);
1256 chkout_("CKW06", (ftnlen)5);
1257 return 0;
1258 }
1259 pktsiz = pktszs[(i__2 = subtyp) < 4 && 0 <= i__2 ? i__2 : s_rnge(
1260 "pktszs", i__2, "ckw06_", (ftnlen)1024)];
1261 if (odd_(&subtyp)) {
1262 winsiz = degres[i__ - 1] + 1;
1263 } else {
1264 winsiz = (degres[i__ - 1] + 1) / 2;
1265 }
1266
1267 /* Make sure the SCLK rates in this mini-segment are positive. */
1268
1269 if (rates[i__ - 1] <= 0.) {
1270 setmsg_("SCLK rate at index # was #; rate must be positive.", (
1271 ftnlen)50);
1272 errint_("#", &i__, (ftnlen)1);
1273 errdp_("#", &rates[i__ - 1], (ftnlen)1);
1274 sigerr_("SPICE(INVALIDSCLKRATE)", (ftnlen)22);
1275 chkout_("CKW06", (ftnlen)5);
1276 return 0;
1277 }
1278
1279 /* Update the packet range pointers for this mini-segment. */
1280
1281 pktbeg = pktend + 1;
1282 pktend = pktbeg - 1 + npkts[i__ - 1] * pktsiz;
1283
1284 /* Make sure that the degree of the interpolating polynomials is */
1285 /* in range. */
1286
1287 if (degres[i__ - 1] < 1 || degres[i__ - 1] > 23) {
1288 setmsg_("The interpolating polynomials of mini-segment # have de"
1289 "gree #; the valid degree range is [1, #]", (ftnlen)95);
1290 errint_("#", &i__, (ftnlen)1);
1291 errint_("#", °res[i__ - 1], (ftnlen)1);
1292 errint_("#", &c__23, (ftnlen)1);
1293 sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
1294 chkout_("CKW06", (ftnlen)5);
1295 return 0;
1296 }
1297
1298 /* Make sure that the window size is even. */
1299
1300 if (odd_(&winsiz)) {
1301 setmsg_("The interpolating polynomials of mini-segment # have wi"
1302 "ndow size # and degree # for CK type 6. The mini-segment"
1303 " subtype is #. The degree must be equivalent to 3 mod 4 "
1304 "for subtypes 0 or 2 (Hermite interpolation) and odd for "
1305 "subtypes 1 or 3 (Lagrange interpolation).", (ftnlen)264);
1306 errint_("#", &i__, (ftnlen)1);
1307 errint_("#", &winsiz, (ftnlen)1);
1308 errint_("#", °res[i__ - 1], (ftnlen)1);
1309 errint_("#", &subtps[i__ - 1], (ftnlen)1);
1310 sigerr_("SPICE(BADWINDOWSIZE)", (ftnlen)20);
1311 chkout_("CKW06", (ftnlen)5);
1312 return 0;
1313 }
1314
1315 /* Make sure the epochs of the Ith mini-segment form a */
1316 /* strictly increasing sequence. */
1317
1318 /* To start out, determine the indices of the epoch sequence */
1319 /* of the Ith mini-segment. We'll call the begin and end */
1320 /* epoch indices BEPIX and EEPIX respectively. */
1321
1322 bepix = eepix + 1;
1323 eepix = bepix - 1 + npkts[i__ - 1];
1324 i__2 = npkts[i__ - 1] - 1;
1325 for (j = 1; j <= i__2; ++j) {
1326 k = bepix + j - 1;
1327 if (sclkdp[k - 1] >= sclkdp[k]) {
1328 setmsg_("In mini-segment #, epoch # having mini-segment-rela"
1329 "tive index # and array-relative index # is greater t"
1330 "han or equal to its successor #.", (ftnlen)135);
1331 errint_("#", &i__, (ftnlen)1);
1332 errdp_("#", &sclkdp[k - 1], (ftnlen)1);
1333 errint_("#", &j, (ftnlen)1);
1334 errint_("#", &k, (ftnlen)1);
1335 errdp_("#", &sclkdp[k], (ftnlen)1);
1336 sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
1337 chkout_("CKW06", (ftnlen)5);
1338 return 0;
1339 }
1340 }
1341
1342 /* Make sure that the span of the input epochs of the Ith */
1343 /* mini-segment includes the start of the Ith mini-segment */
1344 /* interval. Note that the stop time need not be covered, since */
1345 /* gaps are allowed at the right ends of mini-segment intervals. */
1346
1347 if (sclkdp[bepix - 1] > ivlbds[i__ - 1]) {
1348 setmsg_("Mini-segment interval # start time # precedes mini-segm"
1349 "ent's first epoch #.", (ftnlen)75);
1350 errint_("#", &i__, (ftnlen)1);
1351 errdp_("#", &ivlbds[i__ - 1], (ftnlen)1);
1352 errdp_("#", &sclkdp[bepix - 1], (ftnlen)1);
1353 sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21);
1354 chkout_("CKW06", (ftnlen)5);
1355 return 0;
1356 } else if (sclkdp[eepix - 1] < ivlbds[i__ - 1]) {
1357 setmsg_("Mini-segment interval # start time # follows mini-segme"
1358 "nt's last epoch #.", (ftnlen)73);
1359 errint_("#", &i__, (ftnlen)1);
1360 errdp_("#", &ivlbds[i__ - 1], (ftnlen)1);
1361 errdp_("#", &sclkdp[eepix - 1], (ftnlen)1);
1362 sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21);
1363 chkout_("CKW06", (ftnlen)5);
1364 return 0;
1365 }
1366
1367 /* Make sure that the quaternions are non-zero. This is just a */
1368 /* check for uninitialized data. */
1369
1370 /* For the Hermite subtypes, make sure quaternions are suitable */
1371 /* for interpolation. */
1372
1373 i__2 = npkts[i__ - 1];
1374 for (j = 1; j <= i__2; ++j) {
1375
1376 /* We have to address the quaternion explicitly, since the */
1377 /* shape of the packet array is not known at compile time. */
1378
1379 addr__ = pktbeg + pktsiz * (j - 1);
1380 if (vzerog_(&packts[addr__ - 1], &c__4)) {
1381 setmsg_("The quaternion in packet # within mini-segment # ha"
1382 "s magnitude zero.", (ftnlen)68);
1383 errint_("#", &j, (ftnlen)1);
1384 errint_("#", &i__, (ftnlen)1);
1385 sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21);
1386 chkout_("CKW06", (ftnlen)5);
1387 return 0;
1388 }
1389
1390 /* For the Hermite subtypes, each quaternion must be closer */
1391 /* than its negative to its predecessor in the quaternion */
1392 /* sequence. */
1393
1394 if (j > 1 && even_(&subtyp)) {
1395
1396 /* Compare the distance between the current quaternion */
1397 /* and its predecessor vs the distance between the */
1398 /* negative of the current quaternion and its predecessor. */
1399
1400 moved_(&packts[addr__ - 1], &c__4, q);
1401 moved_(&packts[addr__ - pktsiz - 1], &c__4, prevq);
1402 vminug_(q, &c__4, qneg);
1403 if (vdistg_(prevq, qneg, &c__4) < vdistg_(prevq, q, &c__4)) {
1404 setmsg_("The quaternion in packet # within mini-segment "
1405 "# is farther than its negative from its predeces"
1406 "sor at index #. This makes the quaternion sequen"
1407 "ce unsuitable for Hermite interpolation. The qua"
1408 "ternions, and if applicable, their derivatives, "
1409 "must be adjusted before they are passed to this "
1410 "routine.", (ftnlen)295);
1411 errint_("#", &j, (ftnlen)1);
1412 errint_("#", &i__, (ftnlen)1);
1413 i__3 = j - 1;
1414 errint_("#", &i__3, (ftnlen)1);
1415 sigerr_("SPICE(BADQUATSIGN)", (ftnlen)18);
1416 chkout_("CKW06", (ftnlen)5);
1417 return 0;
1418 }
1419 }
1420 }
1421 }
1422
1423 /* If we made it this far, we're ready to start writing the segment. */
1424
1425 /* The type 6 segment structure is eloquently described by this */
1426 /* diagram from the CK Required Reading: */
1427
1428 /* +---------------------------------------+ */
1429 /* | Mini-segment 1 | */
1430 /* +---------------------------------------+ */
1431 /* . */
1432 /* . */
1433 /* . */
1434 /* +---------------------------------------+ */
1435 /* | Mini-segment N | */
1436 /* +---------------------------------------+ */
1437 /* | Mini-segment interval 1 start time | */
1438 /* +---------------------------------------+ */
1439 /* . */
1440 /* . */
1441 /* . */
1442 /* +---------------------------------------+ */
1443 /* | Mini-segment interval N start time | */
1444 /* +---------------------------------------+ */
1445 /* | Mini-segment interval N stop time | */
1446 /* +---------------------------------------+ */
1447 /* | Mini-seg. interval start time 100 | (First interval */
1448 /* +---------------------------------------+ directory) */
1449 /* . */
1450 /* . */
1451 /* . */
1452 /* +---------------------------------------+ */
1453 /* | Mini-seg. ival. start time (N/100)*100| (Last interval */
1454 /* +---------------------------------------+ directory) */
1455 /* | Mini-segment 1 start pointer | */
1456 /* +---------------------------------------+ */
1457 /* . */
1458 /* . */
1459 /* . */
1460 /* +---------------------------------------+ */
1461 /* | Mini-segment N start pointer | */
1462 /* +---------------------------------------+ */
1463 /* | Mini-segment N stop pointer + 1 | */
1464 /* +---------------------------------------+ */
1465 /* | Boundary choice flag | */
1466 /* +---------------------------------------+ */
1467 /* | Number of intervals | */
1468 /* +---------------------------------------+ */
1469
1470 /* CK type 6 mini-segments have the following structure: */
1471
1472 /* +-----------------------+ */
1473 /* | Packet 1 | */
1474 /* +-----------------------+ */
1475 /* . */
1476 /* . */
1477 /* . */
1478 /* +-----------------------+ */
1479 /* | Packet M | */
1480 /* +-----------------------+ */
1481 /* | Epoch 1 | */
1482 /* +-----------------------+ */
1483 /* . */
1484 /* . */
1485 /* . */
1486 /* +-----------------------+ */
1487 /* | Epoch M | */
1488 /* +-----------------------+ */
1489 /* | Epoch 100 | (First time tag directory) */
1490 /* +-----------------------+ */
1491 /* . */
1492 /* . */
1493 /* . */
1494 /* +-----------------------+ */
1495 /* | Epoch ((M-1)/100)*100 | (Last time tag directory) */
1496 /* +-----------------------+ */
1497 /* | Clock rate (sec/tick) | */
1498 /* +-----------------------+ */
1499 /* | Subtype code | */
1500 /* +-----------------------+ */
1501 /* | Window size | */
1502 /* +-----------------------+ */
1503 /* | Number of packets | */
1504 /* +-----------------------+ */
1505
1506 /* Note that the set of parameters at the end of a mini-segment does */
1507 /* not contain an mini-segment interval count. This is because, */
1508 /* unlike a CK type 5 segment, a CK type 6 segment can contain at */
1509 /* most one gap. If present, the gap is located at the end of */
1510 /* mini-segment's mini-segment interval. */
1511
1512 /* Create the segment descriptor. We don't use CKPDS because */
1513 /* that routine doesn't allow creation of a singleton segment. */
1514
1515 ic[0] = *inst;
1516 ic[1] = refcod;
1517 ic[2] = 6;
1518 if (*avflag) {
1519 ic[3] = 1;
1520 } else {
1521 ic[3] = 0;
1522 }
1523 dc[0] = *first;
1524 dc[1] = *last;
1525 dafps_(&c__2, &c__6, dc, ic, descr);
1526
1527 /* Begin a new segment. */
1528
1529 dafbna_(handle, descr, segid, segid_len);
1530 if (failed_()) {
1531 chkout_("CKW06", (ftnlen)5);
1532 return 0;
1533 }
1534
1535 /* Re-initialize the mini-segment packet array indices, */
1536 /* and those of the mini-segment epoch array as well. */
1537
1538 pktbeg = 0;
1539 pktend = 0;
1540 bepix = 0;
1541 eepix = 0;
1542
1543 /* Write data for each mini-segment to the file. */
1544
1545 i__1 = *nmini;
1546 for (i__ = 1; i__ <= i__1; ++i__) {
1547
1548 /* Set the packet size, which is a function of the subtype. */
1549
1550 subtyp = subtps[i__ - 1];
1551 pktsiz = pktszs[(i__2 = subtyp) < 4 && 0 <= i__2 ? i__2 : s_rnge(
1552 "pktszs", i__2, "ckw06_", (ftnlen)1367)];
1553 if (odd_(&subtyp)) {
1554 winsiz = degres[i__ - 1] + 1;
1555 } else {
1556 winsiz = (degres[i__ - 1] + 1) / 2;
1557 }
1558
1559 /* Now that we have the packet size, we can compute */
1560 /* mini-segment packet index range. We'll let PKTDSZ */
1561 /* be the total count of packet data entries for this */
1562 /* mini-segment. */
1563
1564 pktdsz = npkts[i__ - 1] * pktsiz;
1565 pktbeg = pktend + 1;
1566 pktend = pktbeg - 1 + pktdsz;
1567
1568 /* At this point, we're read to start writing the */
1569 /* current mini-segment to the file. Start with the */
1570 /* packet data. */
1571
1572 dafada_(&packts[pktbeg - 1], &pktdsz);
1573
1574 /* Write the epochs for this mini-segment. */
1575
1576 bepix = eepix + 1;
1577 eepix = bepix - 1 + npkts[i__ - 1];
1578 dafada_(&sclkdp[bepix - 1], &npkts[i__ - 1]);
1579
1580 /* Compute the number of epoch directories for the */
1581 /* current mini-segment. */
1582
1583 ndir = (npkts[i__ - 1] - 1) / 100;
1584
1585 /* Write the epoch directories to the segment. */
1586
1587 i__2 = ndir;
1588 for (j = 1; j <= i__2; ++j) {
1589 k = bepix - 1 + j * 100;
1590 dafada_(&sclkdp[k - 1], &c__1);
1591 }
1592
1593 /* Write the mini-segment's SCLK rate, subtype, window size, and */
1594 /* packet count to the segment. */
1595
1596 dafada_(&rates[i__ - 1], &c__1);
1597 d__1 = (doublereal) subtps[i__ - 1];
1598 dafada_(&d__1, &c__1);
1599 d__1 = (doublereal) winsiz;
1600 dafada_(&d__1, &c__1);
1601 d__1 = (doublereal) npkts[i__ - 1];
1602 dafada_(&d__1, &c__1);
1603 if (failed_()) {
1604 chkout_("CKW06", (ftnlen)5);
1605 return 0;
1606 }
1607 }
1608
1609 /* We've finished writing the mini-segments. */
1610
1611 /* Next write the mini-segment interval bounds. */
1612
1613 i__1 = *nmini + 1;
1614 dafada_(ivlbds, &i__1);
1615
1616 /* Create and write directories for the interval */
1617 /* bounds. */
1618
1619 /* The directory count is the interval bound count */
1620 /* (N+1), minus 1, divided by the directory size. */
1621
1622 ndir = *nmini / 100;
1623 i__1 = ndir;
1624 for (i__ = 1; i__ <= i__1; ++i__) {
1625 dafada_(&ivlbds[i__ * 100 - 1], &c__1);
1626 }
1627
1628 /* Now we compute and write the start/stop pointers */
1629 /* for each mini-segment. */
1630
1631 /* The pointers are relative to the DAF address */
1632 /* preceding the segment. For example, a pointer */
1633 /* to the first DAF address in the segment has */
1634 /* value 1. */
1635
1636 segend = 0;
1637 i__1 = *nmini;
1638 for (i__ = 1; i__ <= i__1; ++i__) {
1639
1640 /* Set the packet size, which is a function of the subtype. Also */
1641 /* set the window size. First check the subtype, which will be */
1642 /* used as an array index. */
1643
1644 pktsiz = pktszs[(i__2 = subtps[i__ - 1]) < 4 && 0 <= i__2 ? i__2 :
1645 s_rnge("pktszs", i__2, "ckw06_", (ftnlen)1472)];
1646
1647 /* In order to compute the end pointer of the current */
1648 /* mini-segment, we must compute the size, in terms */
1649 /* of DAF addresses, of this mini-segment. The formula */
1650 /* for the size is */
1651
1652 /* size = n_packets * packet_size */
1653 /* + n_epochs */
1654 /* + n_epoch_directories */
1655 /* + 4 */
1656
1657 /* = n_packets * ( packet_size + 1 ) */
1658 /* + ( n_packets - 1 ) / DIRSIZ */
1659 /* + 4 */
1660
1661 minisz = npkts[i__ - 1] * (pktsiz + 1) + (npkts[i__ - 1] - 1) / 100 +
1662 4;
1663 segbeg = segend + 1;
1664 segend = segbeg + minisz - 1;
1665
1666 /* Write the mini-segment begin pointer. */
1667
1668 /* After the loop terminates, the final end pointer, incremented */
1669 /* by 1, will be written. */
1670
1671 d__1 = (doublereal) segbeg;
1672 dafada_(&d__1, &c__1);
1673 }
1674
1675 /* Write the last mini-segment end pointer, incremented by one. */
1676 /* SEGEND was computed on the last iteration of the above loop. */
1677
1678 d__1 = (doublereal) (segend + 1);
1679 dafada_(&d__1, &c__1);
1680
1681 /* Write out the interval selection flag. The input */
1682 /* boolean value is represented by a numeric constant. */
1683
1684 if (*sellst) {
1685 isel = 1;
1686 } else {
1687 isel = -1;
1688 }
1689 d__1 = (doublereal) isel;
1690 dafada_(&d__1, &c__1);
1691
1692 /* Write the mini-segment/mini-segment interval count. */
1693
1694 d__1 = (doublereal) (*nmini);
1695 dafada_(&d__1, &c__1);
1696
1697 /* End the segment. */
1698
1699 dafena_();
1700 chkout_("CKW06", (ftnlen)5);
1701 return 0;
1702 } /* ckw06_ */
1703
1704