1 /* zzckcv06.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 /* $Procedure ZZCKCV06 ( Private --- C-kernel segment coverage, type 06 ) */
zzckcv06_(integer * handle,integer * arrbeg,integer * arrend,integer * sclkid,doublereal * dc,doublereal * tol,char * timsys,doublereal * schedl,ftnlen timsys_len)9 /* Subroutine */ int zzckcv06_(integer *handle, integer *arrbeg, integer *
10 	arrend, integer *sclkid, doublereal *dc, doublereal *tol, char *
11 	timsys, doublereal *schedl, ftnlen timsys_len)
12 {
13     /* System generated locals */
14     integer i__1, i__2, i__3;
15     doublereal d__1;
16 
17     /* Builtin functions */
18     integer i_dnnt(doublereal *);
19 
20     /* Local variables */
21     integer nrec, ndir;
22     extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
23     integer i__;
24     doublereal begin;
25     extern /* Subroutine */ int chkin_(char *, ftnlen);
26     integer minie;
27     extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
28     logical istdb;
29     extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
30     extern logical eqstr_(char *, char *, ftnlen, ftnlen);
31     extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
32 	    doublereal *);
33     extern logical failed_(void);
34     doublereal et;
35     integer epaddr;
36     doublereal buffer[4], finish;
37     integer ivlbas;
38     doublereal ivlbds[2], lstepc;
39     integer nivdir, ptrbas;
40     extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
41 	    ftnlen), setmsg_(char *, ftnlen), wninsd_(doublereal *,
42 	    doublereal *, doublereal *);
43     integer nintvl;
44     extern logical return_(void);
45 
46 /* $ Abstract */
47 
48 /*     SPICE Private routine intended solely for the support of SPICE */
49 /*     routines.Users should not call this routine directly due */
50 /*     to the volatile nature of this routine. */
51 
52 /*     Determine the "window" of coverage of a type 06 C-kernel segment. */
53 
54 /* $ Disclaimer */
55 
56 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
57 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
58 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
59 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
60 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
61 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
62 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
63 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
64 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
65 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
66 
67 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
68 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
69 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
70 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
71 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
72 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
73 
74 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
75 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
76 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
77 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
78 
79 /* $ Required_Reading */
80 
81 /*     CK */
82 /*     DAF */
83 
84 /* $ Keywords */
85 
86 /*     CK */
87 /*     UTILITY */
88 /*     PRIVATE */
89 
90 /* $ Declarations */
91 /* $ Abstract */
92 
93 /*     Declare parameters specific to CK type 06. */
94 
95 /* $ Disclaimer */
96 
97 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
98 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
99 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
100 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
101 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
102 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
103 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
104 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
105 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
106 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
107 
108 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
109 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
110 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
111 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
112 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
113 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
114 
115 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
116 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
117 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
118 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
119 
120 /* $ Required_Reading */
121 
122 /*     CK */
123 
124 /* $ Keywords */
125 
126 /*     CK */
127 
128 /* $ Restrictions */
129 
130 /*     None. */
131 
132 /* $ Author_and_Institution */
133 
134 /*     N.J. Bachman      (JPL) */
135 /*     B.V. Semenov      (JPL) */
136 
137 /* $ Literature_References */
138 
139 /*     None. */
140 
141 /* $ Version */
142 
143 /* -    SPICELIB Version 1.0.0, 10-MAR-2014 (NJB) (BVS) */
144 
145 /* -& */
146 
147 /*     Maximum polynomial degree supported by the current */
148 /*     implementation of this CK type. */
149 
150 
151 /*     Integer code indicating `true': */
152 
153 
154 /*     Integer code indicating `false': */
155 
156 
157 /*     CK type 6 subtype codes: */
158 
159 
160 /*     Subtype 0:  Hermite interpolation, 8-element packets. Quaternion */
161 /*                 and quaternion derivatives only, no angular velocity */
162 /*                 vector provided. Quaternion elements are listed */
163 /*                 first, followed by derivatives. Angular velocity is */
164 /*                 derived from the quaternions and quaternion */
165 /*                 derivatives. */
166 
167 
168 /*     Subtype 1:  Lagrange interpolation, 4-element packets. Quaternion */
169 /*                 only. Angular velocity is derived by differentiating */
170 /*                 the interpolating polynomials. */
171 
172 
173 /*     Subtype 2:  Hermite interpolation, 14-element packets. */
174 /*                 Quaternion and angular angular velocity vector, as */
175 /*                 well as derivatives of each, are provided. The */
176 /*                 quaternion comes first, then quaternion derivatives, */
177 /*                 then angular velocity and its derivatives. */
178 
179 
180 /*     Subtype 3:  Lagrange interpolation, 7-element packets. Quaternion */
181 /*                 and angular velocity vector provided.  The quaternion */
182 /*                 comes first. */
183 
184 
185 /*     Number of subtypes: */
186 
187 
188 /*     Packet sizes associated with the various subtypes: */
189 
190 
191 /*     Maximum packet size for type 6: */
192 
193 
194 /*     Minimum packet size for type 6: */
195 
196 
197 /*     The CKPFS record size declared in ckparam.inc must be at least as */
198 /*     large as the maximum possible size of a CK type 6 record. */
199 
200 /*     The largest possible CK type 6 record has subtype 3 (note that */
201 /*     records of subtype 2 have half as many epochs as those of subtype */
202 /*     3, for a given polynomial degree). A subtype 3 record contains */
203 
204 /*        - The evaluation epoch */
205 /*        - The subtype and packet count */
206 /*        - MAXDEG+1 packets of size C06PS3 */
207 /*        - MAXDEG+1 time tags */
208 
209 
210 /*     End of file ck06.inc. */
211 
212 /* $ Brief_I/O */
213 
214 /*     VARIABLE  I/O  DESCRIPTION */
215 /*     --------  ---  -------------------------------------------------- */
216 /*     HANDLE     I   Handle of a C-kernel open for read access. */
217 /*     ARRBEG     I   Beginning DAF address. */
218 /*     ARREND     I   Ending DAF address. */
219 /*     SCLKID     I   ID of SCLK associated with segment. */
220 /*     DC         I   D.p. component of CK segment descriptor. */
221 /*     TOL        I   Tolerance in ticks. */
222 /*     TIMSYS     I   Time system used to represent coverage. */
223 /*     SCHEDL    I/O  An initialized window/schedule of interval */
224 
225 /* $ Detailed_Input */
226 
227 /*     HANDLE     is the handle of some DAF that is open for reading. */
228 
229 /*     ARRBEG     is the beginning address of the type 06 segment */
230 /*                to be examined. */
231 
232 /*     ARREND     is the ending address of the type 06 segment. */
233 
234 /*     SCLKID     is the ID code of the spacecraft clock associated with */
235 /*                the object for which the segment contains pointing. */
236 /*                This is the ID code used by the SCLK conversion */
237 /*                routines. */
238 
239 /*     DC         is the double precision component of the descriptor of */
240 /*                the CK segment. The components are the segment start */
241 /*                and stop times. */
242 
243 /*                Each mini-segment interval is replaced with its */
244 /*                intersection with the segment coverage interval */
245 
246 /*                   [ DC(1), DC(2) ] */
247 
248 /*                before being expanded by TOL. Mini-segment intervals */
249 /*                that don't intersect the segment coverage interval are */
250 /*                discarded, even if after expansion by TOL they would */
251 /*                have non-empty intersection with the segment coverage */
252 /*                interval. */
253 
254 /*     TOL        is a tolerance value expressed in ticks of the */
255 /*                spacecraft clock associated with the segment. After */
256 /*                truncation by the segment coverage interval, and */
257 /*                before insertion into the coverage window, each */
258 /*                non-empty truncated mini-segment interval is expanded */
259 /*                by TOL:  the left endpoint of each interval is reduced */
260 /*                by TOL and the right endpoint is increased by TOL. */
261 /*                Any intervals that overlap as a result of the */
262 /*                expansion are merged. */
263 
264 /*                The coverage window returned when TOL > 0 indicates */
265 /*                the coverage provided by the file to the CK readers */
266 /*                CKGPAV and CKGP when that value of TOL is passed to */
267 /*                them as an input. */
268 
269 
270 /*     TIMSYS     is a string indicating the time system used in the */
271 /*                output coverage window.TIMSYS may have the values: */
272 
273 /*                   'SCLK'    Elements of SCHEDL are expressed in */
274 /*                             encoded SCLK ("ticks"), where the clock */
275 /*                             is associated with the object designated */
276 /*                             by IDCODE. */
277 
278 /*                   'TDB'     Elements of SCHEDL are expressed as */
279 /*                             seconds past J2000 TDB. */
280 
281 /*                TIMSYS must be consistent with the system used for */
282 /*                the contents of SCHEDL on input, if any. */
283 
284 
285 /*     SCHEDL     is a schedule (window) of intervals, to which the */
286 /*                intervals of coverage for this segment will be added. */
287 
288 /* $ Detailed_Output */
289 
290 /*     SCHEDL     the input schedule updated to include the intervals */
291 /*                of coverage for this segment. The schedule has */
292 /*                been adjusted to account for the provided tolerance */
293 /*                value. Coverage lying outside the interval */
294 
295 /*                   DC(1) - TOL : DC(2) + TOL */
296 
297 /*                is excluded. */
298 
299 /*                The elements of SCHEDL are given in the time system */
300 /*                indicated by TIMSYS. */
301 
302 /* $ Parameters */
303 
304 /*     Several parameters associated with the type 06 C-kernel */
305 /*     are utilized to compute the packet size of each subtype. */
306 /*     See the include file 'ck06.inc' for details. */
307 
308 /* $ Exceptions */
309 
310 /*     1)  The error SPICE(NOTSUPPORTED) is signaled if the subtype of */
311 /*         the CK type 06 segment is not recognized. */
312 
313 /*     2)  Routines in the call tree of this routine may signal errors */
314 /*         if insufficient room in SCHEDL exists or other error */
315 /*         conditions relating to file access arise. */
316 
317 /*     3)  If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
318 /*         signaled. */
319 
320 /*     4)  If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */
321 /*         is signaled. */
322 
323 /*     5)  If a time conversion error occurs, the error will be */
324 /*         diagnosed by a routine in the call tree of this routine. */
325 
326 /* $ Files */
327 
328 /*     This routine reads the contents of the file associated with */
329 /*     HANDLE to locate coverage intervals. */
330 
331 /* $ Particulars */
332 
333 /*     This is a utility routine that determines the intervals */
334 /*     of coverage for a type 06 C-kernel segment. */
335 
336 /* $ Examples */
337 
338 /*     See CKCOV. */
339 
340 /* $ Restrictions */
341 
342 /*     None. */
343 
344 /* $ Literature_References */
345 
346 /*     None. */
347 
348 /* $ Author_and_Institution */
349 
350 /*     N.J. Bachman    (JPL) */
351 /*     B.V. Semenov    (JPL) */
352 /*     W.L. Taber      (JPL) */
353 /*     F.S. Turner     (JPL) */
354 
355 /* $ Version */
356 
357 /* -    SPICELIB Version 1.0.0, 05-FEB-2014 (NJB) (BVS) (FST) (WLT) */
358 
359 /* -& */
360 
361 /*     SPICELIB Functions */
362 
363 
364 /*     Number of elements in a type 6 mini-segment */
365 /*     interval directory: */
366 
367 
368 /*     Mini-segment epoch directory size: */
369 
370 
371 /*     Type 6 control area size: */
372 
373 
374 /*     Type 6 mini-segment control area size: */
375 
376 
377 /*     Local Variables */
378 
379 
380 /*     Standard SPICE error handling. */
381 
382     if (return_()) {
383 	return 0;
384     }
385     chkin_("ZZCKCV06", (ftnlen)8);
386 
387 /*     Check tolerance value. */
388 
389     if (*tol < 0.) {
390 	setmsg_("Tolerance must be non-negative; actual value was #.", (
391 		ftnlen)51);
392 	errdp_("#", tol, (ftnlen)1);
393 	sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
394 	chkout_("ZZCKCV06", (ftnlen)8);
395 	return 0;
396     }
397 
398 /*     Set a logical flag indicating whether the time system is SCLK. */
399 
400     istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3);
401 
402 /*     Check time system. */
403 
404     if (! istdb) {
405 	if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) {
406 	    setmsg_("Time system spec TIMSYS was #; allowed values are SCLK "
407 		    "and TDB.", (ftnlen)63);
408 	    errch_("#", timsys, (ftnlen)1, timsys_len);
409 	    sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
410 	    chkout_("ZZCKCV06", (ftnlen)8);
411 	    return 0;
412 	}
413     }
414 
415 /*     Fetch the mini-segment count from the segment. */
416 
417     dafgda_(handle, arrend, arrend, buffer);
418     nintvl = i_dnnt(buffer);
419 
420 /*     Each mini-segment contributes a coverage interval to the */
421 /*     total coverage of the segment. Since mini-segments can */
422 /*     contain gaps, we need to examine not only the mini-segment */
423 /*     interval bounds but the final epochs of the mini-segments. */
424 
425 /*     Let IVLBAS be the base address of the mini-segment interval */
426 /*     bounds. Let PTRBAS be the base address of the mini-segment */
427 /*     pointers. */
428 
429 /*     First compute PTRBAS. There are NINTVL+1 pointers. */
430 
431     ptrbas = *arrend - 2 - (nintvl + 1);
432 
433 /*     Compute the number of mini-segment interval directories. */
434 /*     There are NINTVL + 1 interval boundaries, so the directory */
435 /*     count is */
436 
437 /*        (  ( NINTVL + 1 ) - 1  )  /  NVDSIZ */
438 
439 
440     nivdir = nintvl / 100;
441 
442 /*     The interval bounds and their directories precede the */
443 /*     mini-segment pointers. */
444 
445     ivlbas = ptrbas - nivdir - (nintvl + 1);
446 
447 /*     Now loop over the mini-segments and find the contribution */
448 /*     from each one. */
449 
450     i__1 = nintvl;
451     for (i__ = 1; i__ <= i__1; ++i__) {
452 
453 /*        Find the interval bounds for this mini-segment. */
454 
455 	i__2 = ivlbas + i__;
456 	i__3 = ivlbas + i__ + 1;
457 	dafgda_(handle, &i__2, &i__3, ivlbds);
458 	if (failed_()) {
459 	    chkout_("ZZCKCV06", (ftnlen)8);
460 	    return 0;
461 	}
462 
463 /*        Now find the last epoch of this mini-segment, since */
464 /*        there could be a gap at the end. */
465 
466 /*        Find the begin and end pointers for the current */
467 /*        mini-segment. Convert these from relative to */
468 /*        absolute DAF addresses. */
469 
470 	i__2 = ptrbas + i__;
471 	i__3 = ptrbas + i__ + 1;
472 	dafgda_(handle, &i__2, &i__3, buffer);
473 	if (failed_()) {
474 	    chkout_("ZZCKCV06", (ftnlen)8);
475 	    return 0;
476 	}
477 	minie = *arrbeg - 1 + i_dnnt(&buffer[1]) - 1;
478 
479 /*        Fetch the mini-segment's record count NREC. */
480 
481 	dafgda_(handle, &minie, &minie, buffer);
482 	if (failed_()) {
483 	    chkout_("ZZCKCV06", (ftnlen)8);
484 	    return 0;
485 	}
486 	nrec = i_dnnt(buffer);
487 
488 /*        Compute the number of epoch directories for this */
489 /*        mini-segment. */
490 
491 	ndir = (nrec - 1) / 100;
492 
493 /*        The last epoch precedes the mini-segment control */
494 /*        area and the epoch directories. */
495 
496 	epaddr = minie - 4 - ndir;
497 	dafgda_(handle, &epaddr, &epaddr, &lstepc);
498 	if (failed_()) {
499 	    chkout_("ZZCKCV06", (ftnlen)8);
500 	    return 0;
501 	}
502 	begin = ivlbds[0];
503 
504 /*        The smaller of LSTEPC and IVLBDS(2) is the */
505 /*        end of the mini-segment's coverage. */
506 
507 	finish = min(lstepc,ivlbds[1]);
508 
509 /*        Truncate the interval using the segment bounds. */
510 
511 	begin = max(begin,dc[0]);
512 	finish = min(finish,dc[1]);
513 
514 /*        Adjust the interval using the tolerance. Empty */
515 /*        intervals *do not get expanded*; this choice is */
516 /*        consistent with the type 6 reading algorithm. */
517 
518 	if (begin <= finish) {
519 	    if (*tol > 0.) {
520 /* Computing MAX */
521 		d__1 = begin - *tol;
522 		begin = max(d__1,0.);
523 		finish += *tol;
524 	    }
525 	}
526 
527 /*        Convert the time to TDB if necessary. */
528 
529 	if (istdb) {
530 	    sct2e_(sclkid, &begin, &et);
531 	    begin = et;
532 	    sct2e_(sclkid, &finish, &et);
533 	    finish = et;
534 	    if (failed_()) {
535 		chkout_("ZZCKCV06", (ftnlen)8);
536 		return 0;
537 	    }
538 	}
539 
540 /*        Insert the interval into the window. */
541 
542 	if (begin <= finish) {
543 	    wninsd_(&begin, &finish, schedl);
544 	    if (failed_()) {
545 		chkout_("ZZCKCV06", (ftnlen)8);
546 		return 0;
547 	    }
548 	}
549     }
550     chkout_("ZZCKCV06", (ftnlen)8);
551     return 0;
552 } /* zzckcv06_ */
553 
554