1 /* ckr03.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__2 = 2;
11 static integer c__6 = 6;
12
13 /* $Procedure CKR03 ( C-kernel, read pointing record, data type 3 ) */
ckr03_(integer * handle,doublereal * descr,doublereal * sclkdp,doublereal * tol,logical * needav,doublereal * record,logical * found)14 /* Subroutine */ int ckr03_(integer *handle, doublereal *descr, doublereal *
15 sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
16 *found)
17 {
18 /* Initialized data */
19
20 static doublereal prevs = -1.;
21 static doublereal prevn = -1.;
22 static integer lhand = 0;
23 static integer lbeg = -1;
24 static integer lend = -1;
25
26 /* System generated locals */
27 integer i__1, i__2;
28
29 /* Builtin functions */
30 integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
31
32 /* Local variables */
33 integer addr__, skip, psiz, i__, n;
34 doublereal ldiff;
35 integer laddr;
36 doublereal rdiff;
37 integer raddr;
38 extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
39 integer *, integer *, doublereal *, integer *);
40 integer nidir;
41 doublereal lsclk;
42 extern doublereal dpmax_(void);
43 extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
44 integer nrdir;
45 doublereal rsclk;
46 integer group;
47 doublereal start;
48 extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
49 doublereal *);
50 extern logical failed_(void);
51 integer grpadd;
52 doublereal buffer[100];
53 integer remain, dirloc;
54 extern integer lstled_(doublereal *, integer *, doublereal *);
55 integer numrec;
56 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
57 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
58 ftnlen);
59 extern integer lstltd_(doublereal *, integer *, doublereal *);
60 integer numint;
61 doublereal nstart;
62 extern logical return_(void);
63 doublereal dcd[2];
64 integer beg, icd[6], end;
65 logical fnd;
66
67 /* $ Abstract */
68
69 /* Read a pointing record from a CK segment, data type 3. */
70
71 /* $ Disclaimer */
72
73 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
74 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
75 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
76 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
77 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
78 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
79 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
80 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
81 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
82 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
83
84 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
85 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
86 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
87 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
88 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
89 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
90
91 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
92 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
93 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
94 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
95
96 /* $ Required_Reading */
97
98 /* CK */
99 /* DAF */
100
101 /* $ Keywords */
102
103 /* POINTING */
104
105 /* $ Declarations */
106 /* $ Brief_I/O */
107
108 /* Variable I/O Description */
109 /* -------- --- -------------------------------------------------- */
110 /* HANDLE I File handle. */
111 /* DESCR I Segment descriptor. */
112 /* SCLKDP I Pointing request time. */
113 /* TOL I Time tolerance. */
114 /* NEEDAV I Angular velocity request flag. */
115 /* RECORD O Pointing data record. */
116 /* FOUND O True when data is found. */
117
118 /* $ Detailed_Input */
119
120 /* HANDLE is the integer handle of the CK file containing the */
121 /* segment. */
122
123 /* DESCR is the descriptor of the segment. */
124
125 /* SCLKDP is the encoded spacecraft clock time for which */
126 /* pointing is being requested. */
127
128 /* TOL is a time tolerance, measured in the same units as */
129 /* encoded spacecraft clock. */
130
131 /* When SCLKDP falls within the bounds of one of the */
132 /* interpolation intervals then the tolerance has no */
133 /* effect because pointing will be returned at the */
134 /* request time. */
135
136 /* However, if the request time is not in one of the */
137 /* intervals, then the tolerance is used to determine */
138 /* if pointing at one of the interval endpoints should */
139 /* be returned. */
140
141 /* NEEDAV is true if angular velocity is requested. */
142
143 /* $ Detailed_Output */
144
145 /* RECORD is the record that CKE03 will evaluate to determine */
146 /* the pointing. */
147
148 /* When the request time falls within an interval for */
149 /* which linear interpolation is valid, the values of */
150 /* the two pointing instances that bracket the request */
151 /* time are returned in RECORD as follows: */
152
153 /* RECORD( 1 ) = Left bracketing SCLK time. */
154
155 /* RECORD( 2 ) = lq0 \ */
156 /* RECORD( 3 ) = lq1 \ Left bracketing */
157 /* RECORD( 4 ) = lq2 / quaternion. */
158 /* RECORD( 5 ) = lq3 / */
159
160 /* RECORD( 6 ) = lav1 \ Left bracketing */
161 /* RECORD( 7 ) = lav2 angular velocity */
162 /* RECORD( 8 ) = lav3 / ( optional ) */
163
164 /* RECORD( 9 ) = Right bracketing SCLK time. */
165
166 /* RECORD( 10 ) = rq0 \ */
167 /* RECORD( 11 ) = rq1 \ Right bracketing */
168 /* RECORD( 12 ) = rq2 / quaternion. */
169 /* RECORD( 13 ) = rq3 / */
170
171 /* RECORD( 14 ) = rav1 \ Right bracketing */
172 /* RECORD( 15 ) = rav2 angular velocity */
173 /* RECORD( 16 ) = rav3 / ( optional ) */
174
175 /* RECORD( 17 ) = pointing request time, SCLKDP. */
176
177 /* The quantities lq0 - lq3 and rq0 - rq3 are the */
178 /* components of the quaternions that represent the */
179 /* C-matrices associated with the times that bracket */
180 /* the requested time. */
181
182 /* The quantities lav1, lav2, lav3 and rav1, rav2, rav3 */
183 /* are the components of the angular velocity vectors at */
184 /* the respective bracketing times. The components of the */
185 /* angular velocity vectors are specified relative to */
186 /* the inertial reference frame of the segment. */
187
188 /* If the request time does not fall within an */
189 /* interpolation interval, but is within TOL of an */
190 /* interval endpoint, the values of that pointing */
191 /* instance are returned in both parts of RECORD */
192 /* ( i.e. RECORD(1-9) and RECORD(10-16) ). */
193
194 /* FOUND is true if a record was found to satisfy the pointing */
195 /* request. This occurs when the time for which pointing */
196 /* is requested falls inside one of the interpolation */
197 /* intervals, or when the request time is within the */
198 /* tolerance of an interval endpoint. */
199
200 /* $ Parameters */
201
202 /* None. */
203
204 /* $ Exceptions */
205
206 /* 1) If the specified handle does not belong to an open DAF file, */
207 /* an error is diagnosed by a routine that this routine calls. */
208
209 /* 2) If DESCR is not a valid descriptor of a segment in the CK */
210 /* file specified by HANDLE, the results of this routine are */
211 /* unpredictable. */
212
213 /* 3) If the segment is not of data type 3, as specified in the */
214 /* third integer component of the segment descriptor, then */
215 /* the error SPICE(WRONGDATATYPE) is signalled. */
216
217 /* 4) If angular velocity data was requested but the segment */
218 /* contains no such data, the error SPICE(NOAVDATA) is signalled. */
219
220 /* $ Files */
221
222 /* The file containing the segment is specified by its handle and */
223 /* should be opened for read or write access, either by CKLPF, */
224 /* DAFOPR, or DAFOPW. */
225
226 /* $ Particulars */
227
228 /* See the CK Required Reading file for a detailed description of */
229 /* the structure of a type 3 pointing segment. */
230
231 /* When the time for which pointing was requested falls within an */
232 /* interpolation interval, then FOUND will be true and RECORD will */
233 /* contain the pointing instances in the segment that bracket the */
234 /* request time. CKE03 will evaluate RECORD to give pointing at */
235 /* the request time. */
236
237 /* However, when the request time is not within any of the */
238 /* interpolation intervals, then FOUND will be true only if the */
239 /* interval endpoint closest to the request time is within the */
240 /* tolerance specified by the user. In this case both parts of */
241 /* RECORD will contain this closest pointing instance, and CKE03 */
242 /* will evaluate RECORD to give pointing at the time associated */
243 /* with the returned pointing instance. */
244
245 /* $ Examples */
246
247 /* The CKRnn routines are usually used in tandem with the CKEnn */
248 /* routines, which evaluate the record returned by CKRnn to give */
249 /* the pointing information and output time. */
250
251 /* The following code fragment searches through all of the segments */
252 /* in a file applicable to the Mars Observer spacecraft bus that */
253 /* are of data type 3, for a particular spacecraft clock time. */
254 /* It then evaluates the pointing for that epoch and prints the */
255 /* result. */
256
257 /* CHARACTER*(20) SCLKCH */
258 /* CHARACTER*(20) SCTIME */
259 /* CHARACTER*(40) IDENT */
260
261 /* INTEGER I */
262 /* INTEGER SC */
263 /* INTEGER INST */
264 /* INTEGER HANDLE */
265 /* INTEGER DTYPE */
266 /* INTEGER ICD ( 6 ) */
267
268 /* DOUBLE PRECISION SCLKDP */
269 /* DOUBLE PRECISION TOL */
270 /* DOUBLE PRECISION CLKOUT */
271 /* DOUBLE PRECISION DESCR ( 5 ) */
272 /* DOUBLE PRECISION DCD ( 2 ) */
273 /* DOUBLE PRECISION RECORD ( 17 ) */
274 /* DOUBLE PRECISION CMAT ( 3, 3 ) */
275 /* DOUBLE PRECISION AV ( 3 ) */
276
277 /* LOGICAL NEEDAV */
278 /* LOGICAL FND */
279 /* LOGICAL SFND */
280
281
282 /* SC = -94 */
283 /* INST = -94000 */
284 /* DTYPE = 3 */
285 /* NEEDAV = .FALSE. */
286
287 /* C */
288 /* C Load the MO SCLK kernel and the C-kernel. */
289 /* C */
290 /* CALL FURNSH ( 'MO_SCLK.TSC' ) */
291 /* CALL DAFOPR ( 'MO_CK.BC', HANDLE ) */
292 /* C */
293 /* C Get the spacecraft clock time. Then encode it for use */
294 /* C in the C-kernel. */
295 /* C */
296 /* WRITE (*,*) 'Enter spacecraft clock time string:' */
297 /* READ (*,FMT='(A)') SCLKCH */
298
299 /* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */
300 /* C */
301 /* C Use a tolerance of 2 seconds ( half of the nominal */
302 /* C separation between MO pointing instances ). */
303 /* C */
304 /* CALL SCTIKS ( SC, '0000000002:000', TOL ) */
305
306 /* C */
307 /* C Search from the beginning of the CK file through all */
308 /* C of the segments. */
309 /* C */
310 /* CALL DAFBFS ( HANDLE ) */
311 /* CALL DAFFNA ( SFND ) */
312
313 /* FND = .FALSE. */
314
315 /* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */
316
317 /* C */
318 /* C Get the segment identifier and descriptor. */
319 /* C */
320
321 /* CALL DAFGN ( IDENT ) */
322 /* CALL DAFGS ( DESCR ) */
323 /* C */
324 /* C Unpack the segment descriptor into its integer and */
325 /* C double precision components. */
326 /* C */
327 /* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
328
329 /* C */
330 /* C Determine if this segment should be processed. */
331 /* C */
332 /* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */
333 /* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */
334 /* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */
335 /* . ( DTYPE .EQ. ICD( 3 ) ) ) THEN */
336
337
338 /* CALL CKR03 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
339 /* . RECORD, FND ) */
340
341 /* IF ( FND ) THEN */
342
343 /* CALL CKE03 (NEEDAV,RECORD,CMAT,AV,CLKOUT) */
344
345 /* CALL SCDECD ( SC, CLKOUT, SCTIME ) */
346
347 /* WRITE (*,*) */
348 /* WRITE (*,*) 'Segment identifier: ', IDENT */
349 /* WRITE (*,*) */
350 /* WRITE (*,*) 'Pointing returned for time: ', */
351 /* . SCTIME */
352 /* WRITE (*,*) */
353 /* WRITE (*,*) 'C-matrix:' */
354 /* WRITE (*,*) */
355 /* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */
356 /* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */
357 /* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */
358 /* WRITE (*,*) */
359
360 /* END IF */
361
362 /* END IF */
363
364 /* CALL DAFFNA ( SFND ) */
365
366 /* END DO */
367
368 /* $ Restrictions */
369
370 /* 1) The file containing the segment should be opened for read */
371 /* or write access either by CKLPF, DAFOPR, or DAFOPW. */
372
373 /* 2) The record returned by this routine is intended to be */
374 /* evaluated by CKE03. */
375
376 /* $ Literature_References */
377
378 /* None. */
379
380 /* $ Author_and_Institution */
381
382 /* J.M. Lynch (JPL) */
383
384 /* $ Version */
385
386 /* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */
387
388 /* Replaced references to LDPOOL with references */
389 /* to FURNSH. */
390
391 /* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
392
393 /* Replaced DAFRDA call with DAFGDA. */
394 /* Added IMPLICIT NONE. */
395
396 /* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */
397
398 /* -& */
399 /* $ Index_Entries */
400
401 /* read ck type_3 pointing data record */
402
403 /* -& */
404
405 /* SPICELIB functions */
406
407
408 /* Local parameters */
409
410 /* DIRSIZ is the directory size. */
411
412 /* BUFSIZ is the maximum number of double precision numbers */
413 /* that we will read from the DAF file at one time. */
414 /* BUFSIZ is normally set equal to DIRSIZ. */
415
416 /* ND is the number of double precision components in an */
417 /* unpacked C-kernel segment descriptor. */
418
419 /* NI is the number of integer components in an unpacked */
420 /* C-kernel segment descriptor. */
421
422 /* QSIZ is the number of double precision numbers making up */
423 /* the quaternion portion of a pointing record. */
424
425 /* QAVSIZ is the number of double precision numbers making up */
426 /* the quaternion and angular velocity portion of a */
427 /* pointing record. */
428
429 /* DTYPE is the data type of the segment that this routine */
430 /* operates on. */
431
432
433
434 /* Local variables */
435
436
437 /* Saved variables. */
438
439
440 /* Initial values. */
441
442
443 /* Standard SPICE error handling. */
444
445 if (return_()) {
446 return 0;
447 } else {
448 chkin_("CKR03", (ftnlen)5);
449 }
450
451 /* Start off with FOUND equal to false just in case a SPICELIB error */
452 /* is signalled and the return mode is not set to ABORT. */
453
454 *found = FALSE_;
455
456 /* We need to look at a few of the descriptor components. */
457
458 /* The unpacked descriptor contains the following information */
459 /* about the segment: */
460
461 /* DCD(1) Initial encoded SCLK */
462 /* DCD(2) Final encoded SCLK */
463 /* ICD(1) Instrument */
464 /* ICD(2) Inertial reference frame */
465 /* ICD(3) Data type */
466 /* ICD(4) Angular velocity flag */
467 /* ICD(5) Initial address of segment data */
468 /* ICD(6) Final address of segment data */
469
470 dafus_(descr, &c__2, &c__6, dcd, icd);
471
472 /* Check to make sure that the segment is type 3. */
473
474 if (icd[2] != 3) {
475 setmsg_("The segment is not a type 3 segment. Type is #", (ftnlen)47)
476 ;
477 errint_("#", &icd[2], (ftnlen)1);
478 sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20);
479 chkout_("CKR03", (ftnlen)5);
480 return 0;
481 }
482
483 /* Does this segment contain angular velocity? */
484
485 if (icd[3] == 1) {
486 psiz = 7;
487 } else {
488 psiz = 4;
489 if (*needav) {
490 setmsg_("Segment does not contain angular velocity data.", (
491 ftnlen)47);
492 sigerr_("SPICE(NOAVDATA)", (ftnlen)15);
493 chkout_("CKR03", (ftnlen)5);
494 return 0;
495 }
496 }
497
498 /* The beginning and ending addresses of the segment are in the */
499 /* descriptor. */
500
501 beg = icd[4];
502 end = icd[5];
503
504 /* The procedure used in finding a record to satisfy the request */
505 /* for pointing is as follows: */
506
507 /* 1) Find the two pointing instances in the segment that bracket */
508 /* the request time. */
509
510 /* The pointing instance that brackets the request time on the */
511 /* left is defined to be the one associated with the largest */
512 /* time in the segment that is less than or equal to SCLKDP. */
513
514 /* The pointing instance that brackets the request time on the */
515 /* right is defined to be the one associated with the first */
516 /* time in the segment greater than SCLKDP. */
517
518 /* Since the times in the segment are strictly increasing the */
519 /* left and right bracketing pointing instances are always */
520 /* adjacent. */
521
522 /* 2) Determine if the bracketing times are in the same */
523 /* interpolation interval. */
524
525 /* 3) If they are, then pointing at the request time may be */
526 /* linearly interpolated from the bracketing times. */
527
528 /* 4) If the times that bracket the request time are not in the */
529 /* same interval then, since they are adjacent in the segment */
530 /* and since intervals begin and end at actual times, they must */
531 /* both be interval endpoints. Return the pointing instance */
532 /* associated with the endpoint closest to the request time, */
533 /* provided that it is within the tolerance. */
534
535
536 /* Get the number of intervals and pointing instances ( records ) */
537 /* in this segment, and from that determine the number of respective */
538 /* directory epochs. */
539
540 i__1 = end - 1;
541 dafgda_(handle, &i__1, &end, buffer);
542 numint = i_dnnt(buffer);
543 numrec = i_dnnt(&buffer[1]);
544 nidir = (numint - 1) / 100;
545 nrdir = (numrec - 1) / 100;
546
547 /* Check the FAILED flag just in case HANDLE is not attached to */
548 /* any DAF file and the error action is not set to ABORT. You need */
549 /* need to do this only after the first call to DAFGDA. */
550
551 if (failed_()) {
552 chkout_("CKR03", (ftnlen)5);
553 return 0;
554 }
555
556 /* To find the times that bracket the request time we will first */
557 /* find the greatest directory time less than the request time. */
558 /* This will narrow down the search to a group of DIRSIZ or fewer */
559 /* times where the Jth group is defined to contain SCLK times */
560 /* ((J-1)*DIRSIZ + 1) through (J*DIRSIZ). */
561
562 /* For example if DIRSIZ = 100 then: */
563
564 /* group first time # last time # */
565 /* ----- --------------- ------------ */
566 /* 1 1 100 */
567 /* 2 101 200 */
568 /* . . . */
569 /* . . . */
570 /* 10 901 1000 */
571 /* . . . */
572 /* . . . */
573 /* NRDIR+1 (NRDIR)*100+1 NUMREC */
574
575
576 /* Thus if the Ith directory time is the largest one less than */
577 /* our request time SCLKDP, then we know that: */
578
579 /* SCLKS ( DIRSIZ * I ) < SCLKDP <= SCLKS ( DIRSIZ * (I+1) ) */
580
581 /* where SCLKS is taken to be the array of NUMREC times associated */
582 /* with the pointing instances. */
583
584 /* Therefore, at least one of the bracketing times will come from */
585 /* the (I+1)th group. */
586
587
588 /* There is only one group if there are no directory epochs. */
589
590 if (nrdir == 0) {
591 group = 1;
592 } else {
593
594 /* Compute the location of the first directory epoch. From the */
595 /* beginning of the segment, we need to go through all of the */
596 /* pointing numbers (PSIZ*NUMREC of them) and then through all of */
597 /* the NUMREC SCLK times. */
598
599 dirloc = beg + (psiz + 1) * numrec;
600
601 /* Search through the directory times. Read in as many as BUFSIZ */
602 /* directory epochs at a time for comparison. */
603
604 fnd = FALSE_;
605 remain = nrdir;
606 group = 0;
607 while(! fnd) {
608
609 /* The number of records to read into the buffer. */
610
611 n = min(remain,100);
612 i__1 = dirloc + n - 1;
613 dafgda_(handle, &dirloc, &i__1, buffer);
614 remain -= n;
615
616 /* Determine the last directory element in BUFFER that's less */
617 /* than SCLKDP. */
618
619 i__ = lstltd_(sclkdp, &n, buffer);
620 if (i__ < n) {
621 group = group + i__ + 1;
622 fnd = TRUE_;
623 } else if (remain == 0) {
624
625 /* The request time is greater than the last directory time */
626 /* so we want the last group in the segment. */
627
628 group = nrdir + 1;
629 fnd = TRUE_;
630 } else {
631
632 /* Need to read another block of directory times. */
633
634 dirloc += n;
635 group += n;
636 }
637 }
638 }
639
640 /* Now we know which group of DIRSIZ (or less) times to look at. */
641 /* Out of the NUMREC SCLK times, the number that we should skip over */
642 /* to get to the proper group is DIRSIZ * ( GROUP - 1 ). */
643
644 skip = (group - 1) * 100;
645
646 /* From this we can compute the address in the segment of the group */
647 /* of times we want. From the beginning, we need to pass through */
648 /* PSIZ * NUMREC pointing numbers to get to the first SCLK time. */
649 /* Then we skip over the number just computed above. */
650
651 grpadd = beg + numrec * psiz + skip;
652
653 /* The number of times that we have to look at may be less than */
654 /* DIRSIZ. However many there are, go ahead and read them into the */
655 /* buffer. */
656
657 /* Computing MIN */
658 i__1 = 100, i__2 = numrec - skip;
659 n = min(i__1,i__2);
660 i__1 = grpadd + n - 1;
661 dafgda_(handle, &grpadd, &i__1, buffer);
662
663 /* Find the largest time in the group less than or equal to the input */
664 /* time. */
665
666 i__ = lstled_(sclkdp, &n, buffer);
667
668 /* Find the pointing instances in the segment that bracket the */
669 /* request time and calculate the addresses for the pointing data */
670 /* associated with these times. For cases in which the request time */
671 /* is equal to one of the times in the segment, that time will be */
672 /* the left bracketing time of the returned pair. */
673
674 /* Need to handle the cases when the request time is greater than */
675 /* the last or less than the first time in the segment separately. */
676
677 if (i__ == 0) {
678 if (group == 1) {
679
680 /* The time occurs before the first time in the segment. Since */
681 /* this time cannot possibly be in any of the intervals, the */
682 /* first time can satisfy the request for pointing only if it */
683 /* is within the tolerance of the request time. */
684
685 if (buffer[0] - *sclkdp <= *tol) {
686 record[0] = buffer[0];
687 record[8] = buffer[0];
688
689 /* Calculate the address of the quaternion and angular */
690 /* velocity data. Then read it from the file. */
691
692 i__1 = beg + psiz - 1;
693 dafgda_(handle, &beg, &i__1, buffer);
694 moved_(buffer, &psiz, &record[1]);
695 moved_(buffer, &psiz, &record[9]);
696 record[16] = *sclkdp;
697 *found = TRUE_;
698 }
699 chkout_("CKR03", (ftnlen)5);
700 return 0;
701 } else {
702
703 /* The first time in the current group brackets the request */
704 /* time on the right and the last time from the preceding */
705 /* group brackets on the left. */
706
707 rsclk = buffer[0];
708 raddr = beg + skip * psiz;
709 i__1 = grpadd - 1;
710 i__2 = grpadd - 1;
711 dafgda_(handle, &i__1, &i__2, &lsclk);
712 laddr = raddr - psiz;
713 }
714 } else if (i__ == n) {
715
716 /* There are two possible cases, but the same action can handle */
717 /* both. */
718
719 /* 1) If this is the last group ( NRDIR + 1 ) then the request */
720 /* time occurs on or after the last time in the segment. */
721 /* In either case this last time can satisfy the request for */
722 /* pointing only if it is within the tolerance of the request */
723 /* time. */
724
725 /* 2) The request time is greater than or equal to the last time */
726 /* in this group. Since this time is the same as the (I+1)th */
727 /* directory time, and since the search on the directory times */
728 /* used a strictly less than test, we know that the request */
729 /* time must be equal to this time. Just return the pointing */
730 /* instance associated with the request time. ( Note that */
731 /* SCLKDP - BUFFER(N) will be zero in this case. ) */
732
733 if (*sclkdp - buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
734 s_rnge("buffer", i__1, "ckr03_", (ftnlen)826)] <= *tol) {
735 record[0] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
736 s_rnge("buffer", i__1, "ckr03_", (ftnlen)828)];
737 record[8] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
738 s_rnge("buffer", i__1, "ckr03_", (ftnlen)829)];
739
740 /* Calculate the address of the quaternion and angular */
741 /* velocity data. Then read it from the file. */
742
743 addr__ = beg + psiz * (skip + n - 1);
744 i__1 = addr__ + psiz - 1;
745 dafgda_(handle, &addr__, &i__1, buffer);
746 moved_(buffer, &psiz, &record[1]);
747 moved_(buffer, &psiz, &record[9]);
748 record[16] = *sclkdp;
749 *found = TRUE_;
750 }
751 chkout_("CKR03", (ftnlen)5);
752 return 0;
753 } else {
754
755 /* The bracketing times are contained in this group. */
756
757 lsclk = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge(
758 "buffer", i__1, "ckr03_", (ftnlen)855)];
759 rsclk = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge("buff"
760 "er", i__1, "ckr03_", (ftnlen)856)];
761 laddr = beg + (skip + i__ - 1) * psiz;
762 raddr = laddr + psiz;
763 }
764
765 /* At this point we have the two times in the segment that bracket */
766 /* the request time. We also have the addresses of the pointing */
767 /* data associated with those times. The task now is to determine */
768 /* if the bracketing times fall in the same interval. If so then */
769 /* we can interpolate between them. If they don't then return */
770 /* pointing for whichever of the two times is closest to the */
771 /* request time, provided that it is within the tolerance. */
772
773
774 /* Find the interpolation interval that the request time is in and */
775 /* determine if the bracketing SCLK's are both in it. */
776
777 /* First check if the request time falls in the same interval as */
778 /* it did last time. We need to make sure that we are dealing */
779 /* with the same segment as well as the same time range. */
780
781
782 /* PREVS is the start time of the interval that satisfied */
783 /* the previous request for pointing. */
784
785 /* PREVN is the start time of the interval that followed */
786 /* the interval specified above. */
787
788 /* LHAND is the handle of the file that PREVS and PREVN */
789 /* were found in. */
790
791 /* LBEG, are the beginning and ending addresses of the */
792 /* LEND segment in the file LHAND that PREVS and PREVN */
793 /* were found in. */
794
795 if (*handle == lhand && beg == lbeg && end == lend && *sclkdp >= prevs &&
796 *sclkdp < prevn) {
797 start = prevs;
798 nstart = prevn;
799 } else {
800
801 /* The START times of all of the intervals are stored in the */
802 /* segment and a directory of every hundredth START is also */
803 /* stored. The procedure to find the bracketing interval start */
804 /* times is identical to the one used above for finding the */
805 /* bracketing times. */
806
807 /* The directory epochs narrow down the search for the times that */
808 /* bracket the request time to a group of DIRSIZ or fewer records. */
809
810
811 /* There is only one group if there are no directory epochs. */
812
813 if (nidir == 0) {
814 group = 1;
815 } else {
816
817 /* Compute the location of the first directory epoch. From the */
818 /* beginning of the segment, we need to go through all of the */
819 /* pointing numbers (PSIZ*NUMREC of them), then through all of */
820 /* the NUMREC SCLK times and NRDIR directory times, and then */
821 /* finally through the NUMINT interval start times. */
822
823 dirloc = beg + (psiz + 1) * numrec + nrdir + numint;
824
825 /* Locate the largest directory time less than the */
826 /* request time SCLKDP. */
827
828 /* Read in as many as BUFSIZ directory epochs at a time for */
829 /* comparison. */
830
831 fnd = FALSE_;
832 remain = nidir;
833 group = 0;
834 while(! fnd) {
835
836 /* The number of records to read into the buffer. */
837
838 n = min(remain,100);
839 i__1 = dirloc + n - 1;
840 dafgda_(handle, &dirloc, &i__1, buffer);
841 remain -= n;
842
843 /* Determine the last directory element in BUFFER that's */
844 /* less than SCLKDP. */
845
846 i__ = lstltd_(sclkdp, &n, buffer);
847 if (i__ < n) {
848 group = group + i__ + 1;
849 fnd = TRUE_;
850 } else if (remain == 0) {
851
852 /* The request time is greater than the last directory */
853 /* time so we want the last group in the segment. */
854
855 group = nidir + 1;
856 fnd = TRUE_;
857 } else {
858
859 /* Need to read another block of directory times. */
860
861 dirloc += n;
862 group += n;
863 }
864 }
865 }
866
867 /* Now we know which group of DIRSIZ (or less) times to look at. */
868 /* Out of the NUMINT SCLK START times, the number that we should */
869 /* skip over to get to the proper group is DIRSIZ * ( GROUP - 1 ). */
870
871 skip = (group - 1) * 100;
872
873 /* From this we can compute the address in the segment of the */
874 /* group of times we want. To get to the first interval start */
875 /* time we must pass over PSIZ * NUMREC pointing numbers, NUMREC */
876 /* SCLK times, and NRDIR SCLK directory times. Then we skip */
877 /* over the number just computed above. */
878
879 grpadd = beg + (psiz + 1) * numrec + nrdir + skip;
880
881 /* The number of times that we have to look at may be less than */
882 /* DIRSIZ. However many there are, go ahead and read them into */
883 /* the buffer. */
884
885 /* Computing MIN */
886 i__1 = 100, i__2 = numint - skip;
887 n = min(i__1,i__2);
888 i__1 = grpadd + n - 1;
889 dafgda_(handle, &grpadd, &i__1, buffer);
890
891 /* Find the index of the largest time in the group that is less */
892 /* than or equal to the input time. */
893
894 i__ = lstled_(sclkdp, &n, buffer);
895 if (i__ == 0) {
896
897 /* The first start time in the buffer is the start of the */
898 /* interval following the one containing the request time. */
899
900 /* We don't need to check if GROUP = 1 because the case of */
901 /* the request time occurring before the first time in the */
902 /* segment has already been handled. */
903
904 nstart = buffer[0];
905 addr__ = grpadd - 1;
906 dafgda_(handle, &addr__, &addr__, &start);
907 } else if (i__ == n) {
908 if (group == nidir + 1) {
909
910 /* This is the last interval in the segment. */
911
912 start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
913 s_rnge("buffer", i__1, "ckr03_", (ftnlen)1040)];
914 nstart = dpmax_();
915 } else {
916
917 /* The last START time in this group is equal to the */
918 /* request time. */
919
920 start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
921 s_rnge("buffer", i__1, "ckr03_", (ftnlen)1049)];
922 addr__ = grpadd + n;
923 dafgda_(handle, &addr__, &addr__, &nstart);
924 }
925 } else {
926
927 /* The bracketing START times are contained in this group. */
928
929 start = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 :
930 s_rnge("buffer", i__1, "ckr03_", (ftnlen)1061)];
931 nstart = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge(
932 "buffer", i__1, "ckr03_", (ftnlen)1062)];
933 }
934
935 /* Save the information about the interval and segment. */
936
937 lhand = *handle;
938 lbeg = beg;
939 lend = end;
940 prevs = start;
941 prevn = nstart;
942 }
943
944 /* Check and see if the bracketing pointing instances belong */
945 /* to the same interval. If they do then we can interpolate */
946 /* between them, if not then check to see if the closer of */
947 /* the two to the request time lies within the tolerance. */
948
949 /* The left bracketing time will always belong to the same */
950 /* interval as the request time, therefore we need to check */
951 /* only that the right bracketing time is less than the start */
952 /* time of the next interval. */
953
954 if (rsclk < nstart) {
955 record[0] = lsclk;
956 i__1 = laddr + psiz - 1;
957 dafgda_(handle, &laddr, &i__1, &record[1]);
958 record[8] = rsclk;
959 i__1 = raddr + psiz - 1;
960 dafgda_(handle, &raddr, &i__1, &record[9]);
961 record[16] = *sclkdp;
962 *found = TRUE_;
963 } else {
964 ldiff = *sclkdp - lsclk;
965 rdiff = rsclk - *sclkdp;
966 if (ldiff <= *tol || rdiff <= *tol) {
967
968 /* Return the pointing instance closest to the request time. */
969
970 /* If the request time is midway between LSCLK and RSCLK then */
971 /* grab the pointing instance associated with the greater time. */
972
973 if (ldiff < rdiff) {
974 record[0] = lsclk;
975 record[8] = lsclk;
976 i__1 = laddr + psiz - 1;
977 dafgda_(handle, &laddr, &i__1, buffer);
978 moved_(buffer, &psiz, &record[1]);
979 moved_(buffer, &psiz, &record[9]);
980 } else {
981 record[0] = rsclk;
982 record[8] = rsclk;
983 i__1 = raddr + psiz - 1;
984 dafgda_(handle, &raddr, &i__1, buffer);
985 moved_(buffer, &psiz, &record[1]);
986 moved_(buffer, &psiz, &record[9]);
987 }
988 record[16] = *sclkdp;
989 *found = TRUE_;
990 }
991 }
992 chkout_("CKR03", (ftnlen)5);
993 return 0;
994 } /* ckr03_ */
995
996