1 /* sgfrvi.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__12 = 12;
11 static integer c__7 = 7;
12 static integer c__5 = 5;
13 static integer c__6 = 6;
14 static integer c__0 = 0;
15 static integer c__4 = 4;
16 static integer c__3 = 3;
17
18 /* $Procedure SGFRVI ( Generic Segments: Fetch ref. value and index ) */
sgfrvi_(integer * handle,doublereal * descr,doublereal * x,doublereal * value,integer * indx,logical * found)19 /* Subroutine */ int sgfrvi_(integer *handle, doublereal *descr, doublereal *
20 x, doublereal *value, integer *indx, logical *found)
21 {
22 /* Initialized data */
23
24 static logical first = TRUE_;
25
26 /* System generated locals */
27 integer i__1, i__2;
28
29 /* Builtin functions */
30 integer s_rnge(char *, integer, char *, integer);
31
32 /* Local variables */
33 logical done;
34 integer i__, begin;
35 extern /* Subroutine */ int chkin_(char *, ftnlen);
36 logical myfnd;
37 extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafgda_(
38 integer *, integer *, integer *, doublereal *);
39 extern logical failed_(void);
40 doublereal endref;
41 integer nfetch;
42 doublereal buffer[101];
43 integer bfindx, remain;
44 extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *,
45 integer *);
46 doublereal dpimax;
47 integer myrefb;
48 extern integer lstled_(doublereal *, integer *, doublereal *);
49 doublereal dptemp;
50 integer fullrd, rdridx, myrdrb;
51 extern integer intmax_(void);
52 integer mynref;
53 logical isdirv;
54 integer myindx;
55 extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
56 ftnlen);
57 integer mynrdr;
58 extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
59 doublereal myvalu;
60 extern logical return_(void);
61 extern /* Subroutine */ int sigerr_(char *, ftnlen);
62 integer myrdrt, mynpkt, end;
63
64 /* $ Abstract */
65
66 /* Given the handle of a DAF and the descriptor associated with */
67 /* a generic DAF segment in the file, find the reference value */
68 /* associated with the value X and it's index. */
69
70 /* $ Disclaimer */
71
72 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
73 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
74 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
75 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
76 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
77 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
78 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
79 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
80 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
81 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
82
83 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
84 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
85 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
86 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
87 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
88 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
89
90 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
91 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
92 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
93 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
94
95 /* $ Required_Reading */
96
97 /* DAF Required Reading. */
98
99 /* $ Keywords */
100
101 /* GENERIC SEGMENTS */
102
103 /* $ Declarations */
104 /* $ Brief_I/O */
105
106 /* Variable I/O Description */
107 /* -------- --- -------------------------------------------------- */
108 /* HANDLE I The handle of a DAF open for reading. */
109 /* DESCR I The descriptor for a DAF generic segment. */
110 /* X I The key value used to find a reference and index. */
111 /* VALUE O The reference value associated with X. */
112 /* INDX O The index of VALUE within the reference values. */
113 /* FOUND O A flag indicating whether values for X were found. */
114
115 /* $ Detailed_Input */
116
117 /* HANDLE is the handle of a DAF open for reading */
118
119 /* DESCR is the descriptor of the generic segment that we are */
120 /* going to search for a reference value to associate with */
121 /* X. */
122
123 /* X a value for which the associated reference value */
124 /* and reference index is requested. */
125
126 /* $ Detailed_Output */
127
128 /* VALUE is the reference value associated with the input value */
129 /* X. */
130
131 /* INDX is the index of VALUE within the set of reference */
132 /* values for the generic segment. This value may be used */
133 /* to obtain a particular packet of data from the generic */
134 /* segment. */
135
136 /* FOUND is a logical flag indicating whether a reference value */
137 /* associated with X was found. If a reference value was */
138 /* found, FOUND will have a value of TRUE; otherwise it */
139 /* will have a value of FALSE. */
140
141 /* $ Parameters */
142
143 /* This subroutine makes use of parameters defined in the file */
144 /* 'sgparam.inc'. */
145
146 /* $ Files */
147
148 /* See the description of HANDLE above. */
149
150 /* $ Exceptions */
151
152 /* 1) The error SPICE(UNKNOWNREFDIR) will be signalled if */
153 /* the reference directory structure is unrecognized. The most */
154 /* likely cause of this error is that an upgrade to your */
155 /* version of the SPICE toolkit is needed. */
156
157 /* 2) If a value computed for the index of an implicitly indexed */
158 /* generic segment is too large to be represented as an integer, */
159 /* the error SPICE(INDEXTOOLARGE) will be signalled. */
160
161 /* $ Particulars */
162
163 /* This routine allows you to easily find the index and value */
164 /* of the reference item that should be associated with a */
165 /* value X. Given this information you can then easily retrieve */
166 /* the packet that should be associated with X. */
167
168 /* $ Examples */
169
170 /* Suppose that you have a generic segment that contains the */
171 /* following items. */
172
173 /* 1) Packets that model the motion of a body as a function */
174 /* of time over some interval of time. */
175
176 /* 2) Reference values that are the epochs corresponding */
177 /* to the beginning of the intervals for the packets. */
178
179 /* To retrieve the correct packet to use to compute the position */
180 /* and velocity of the body at a particular epoch, ET, you could */
181 /* use the following code. (Note this block of code assumes that */
182 /* you aren't going to run into any exceptional cases such as ET */
183 /* falling outside the range of times for which the packets can */
184 /* provide ephemeris data.) */
185
186 /* Find out the index of the time that should be associated */
187 /* with the ET we've been given */
188
189 /* CALL SGFRVI ( HANDLE, DESCR, ET, ETFND, INDX, FOUND ) */
190
191 /* Fetch the INDX'th ephemeris packet from the segment. */
192
193 /* CALL SGFPKT ( HANDLE, DESCR, INDX, EPHEM ) */
194
195
196 /* $ Restrictions */
197
198 /* The segment described by DESCR MUST be a generic segment, */
199 /* otherwise the results of this routine are not predictable. */
200
201 /* $ Author_and_Institution */
202
203 /* K.R. Gehringer (JPL) */
204 /* W.L. Taber (JPL) */
205
206 /* $ Literature_References */
207
208 /* None. */
209
210 /* $ Version */
211
212 /* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */
213
214 /* Replaced DAFRDA call with DAFGDA. */
215
216 /* - SPICELIB Version 1.1.0, 08-MAY-1996 (WLT) */
217
218 /* A bug was found in the EXPCLS index case when the */
219 /* trying to retrieve the last value in a generic segment. */
220 /* This bug was discovered by the HP compiler complaining */
221 /* that an index used was not initialized. */
222
223 /* The offending line was */
224
225 /* MYVALU = BUFFER(I) */
226
227 /* The corrected line is: */
228
229 /* MYVALU = BUFFER(BFINDX) */
230
231 /* - SPICELIB Version 1.0.0, 28-Mar-1994 (KRG) (WLT) */
232
233 /* -& */
234 /* $ Index_Entries */
235
236 /* find the index of a reference value in a generic segment */
237
238 /* -& */
239
240 /* Spicelib Functions */
241
242
243 /* Local Parameters */
244
245 /* Include the mnemonic values for the generic segment declarations. */
246
247
248 /* $ Abstract */
249
250 /* Parameter declarations for the generic segments subroutines. */
251
252 /* $ Disclaimer */
253
254 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
255 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
256 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
257 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
258 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
259 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
260 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
261 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
262 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
263 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
264
265 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
266 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
267 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
268 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
269 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
270 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
271
272 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
273 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
274 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
275 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
276
277 /* $ Required_Reading */
278
279 /* DAF Required Reading */
280
281 /* $ Keywords */
282
283 /* GENERIC SEGMENTS */
284
285 /* $ Particulars */
286
287 /* This include file contains the parameters used by the generic */
288 /* segments subroutines, SGxxxx. A generic segment is a */
289 /* generalization of a DAF array which places a particular structure */
290 /* on the data contained in the array, as described below. */
291
292 /* This file defines the mnemonics that are used for the index types */
293 /* allowed in generic segments as well as mnemonics for the meta data */
294 /* items which are used to describe a generic segment. */
295
296 /* A DAF generic segment contains several logical data partitions: */
297
298 /* 1) A partition for constant values to be associated with each */
299 /* data packet in the segment. */
300
301 /* 2) A partition for the data packets. */
302
303 /* 3) A partition for reference values. */
304
305 /* 4) A partition for a packet directory, if the segment contains */
306 /* variable sized packets. */
307
308 /* 5) A partition for a reference value directory. */
309
310 /* 6) A reserved partition that is not currently used. This */
311 /* partition is only for the use of the NAIF group at the Jet */
312 /* Propulsion Laboratory (JPL). */
313
314 /* 7) A partition for the meta data which describes the locations */
315 /* and sizes of other partitions as well as providing some */
316 /* additional descriptive information about the generic */
317 /* segment. */
318
319 /* +============================+ */
320 /* | Constants | */
321 /* +============================+ */
322 /* | Packet 1 | */
323 /* |----------------------------| */
324 /* | Packet 2 | */
325 /* |----------------------------| */
326 /* | . | */
327 /* | . | */
328 /* | . | */
329 /* |----------------------------| */
330 /* | Packet N | */
331 /* +============================+ */
332 /* | Reference Values | */
333 /* +============================+ */
334 /* | Packet Directory | */
335 /* +============================+ */
336 /* | Reference Directory | */
337 /* +============================+ */
338 /* | Reserved Area | */
339 /* +============================+ */
340 /* | Segment Meta Data | */
341 /* +----------------------------+ */
342
343 /* Only the placement of the meta data at the end of a generic */
344 /* segment is required. The other data partitions may occur in any */
345 /* order in the generic segment because the meta data will contain */
346 /* pointers to their appropriate locations within the generic */
347 /* segment. */
348
349 /* The meta data for a generic segment should only be obtained */
350 /* through use of the subroutine SGMETA. The meta data should not be */
351 /* written through any mechanism other than the ending of a generic */
352 /* segment begun by SGBWFS or SGBWVS using SGWES. */
353
354 /* $ Restrictions */
355
356 /* 1) If new reference index types are added, the new type(s) should */
357 /* be defined to be the consecutive integer(s) after the last */
358 /* defined reference index type used. In this way a value for */
359 /* the maximum allowed index type may be maintained. This value */
360 /* must also be updated if new reference index types are added. */
361
362 /* 2) If new meta data items are needed, mnemonics for them must be */
363 /* added to the end of the current list of mnemonics and before */
364 /* the NMETA mnemonic. In this way compatibility with files having */
365 /* a different, but smaller, number of meta data items may be */
366 /* maintained. See the description and example below. */
367
368 /* $ Author_and_Institution */
369
370 /* N.J. Bachman (JPL) */
371 /* K.R. Gehringer (JPL) */
372 /* W.L. Taber (JPL) */
373 /* F.S. Turner (JPL) */
374
375 /* $ Literature_References */
376
377 /* Generic Segments Required Reading. */
378 /* DAF Required Reading. */
379
380 /* $ Version */
381
382 /* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */
383
384 /* Header update: equations for comptutations of packet indices */
385 /* for the cases of index types 0 and 1 were corrected. */
386
387 /* - SPICELIB Version 1.1.0, 25-09-98 (FST) */
388
389 /* Added parameter MNMETA, the minimum number of meta data items */
390 /* that must be present in a generic DAF segment. */
391
392 /* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */
393
394 /* -& */
395
396 /* Mnemonics for the type of reference value index. */
397
398 /* Two forms of indexing are provided: */
399
400 /* 1) An implicit form of indexing based on using two values, a */
401 /* starting value, which will have an index of 1, and a step */
402 /* size between reference values, which are used to compute an */
403 /* index and a reference value associated with a specified key */
404 /* value. See the descriptions of the implicit types below for */
405 /* the particular formula used in each case. */
406
407 /* 2) An explicit form of indexing based on a reference value for */
408 /* each data packet. */
409
410
411 /* Reference Index Type 0 */
412 /* ---------------------- */
413
414 /* Implied index. The index and reference value of a data packet */
415 /* associated with a specified key value are computed from the two */
416 /* generic segment reference values using the formula below. The two */
417 /* generic segment reference values, REF(1) and REF(2), represent, */
418 /* respectively, a starting value and a step size between reference */
419 /* values. The index of the data packet associated with a key value */
420 /* of VALUE is given by: */
421
422 /* / VALUE - REF(1) \ */
423 /* INDEX = 1 + INT | -------------------- | */
424 /* \ REF(2) / */
425
426 /* and the reference value associated with VALUE is given by: */
427
428 /* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
429
430
431 /* Reference Index Type 1 */
432 /* ---------------------- */
433
434 /* Implied index. The index and reference value of a data packet */
435 /* associated with a specified key value are computed from the two */
436 /* generic segment reference values using the formula below. The two */
437 /* generic segment reference values, REF(1) and REF(2), represent, */
438 /* respectively, a starting value and a step size between reference */
439 /* values. The index of the data packet associated with a key value */
440 /* of VALUE is given by: */
441
442 /* / VALUE - REF(1) \ */
443 /* INDEX = 1 + INT | 0.5 + -------------------- | */
444 /* \ REF(2) / */
445
446
447 /* and the reference value associated with VALUE is given by: */
448
449 /* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
450
451 /* We get the larger index in the event that VALUE is halfway between */
452 /* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */
453
454
455 /* Reference Index Type 2 */
456 /* ---------------------- */
457
458 /* Explicit index. In this case the number of packets must equal the */
459 /* number of reference values. The index of the packet associated */
460 /* with a key value of VALUE is the index of the last reference item */
461 /* that is strictly less than VALUE. The reference values must be in */
462 /* ascending order, REF(I) < REF(I+1). */
463
464
465 /* Reference Index Type 3 */
466 /* ---------------------- */
467
468 /* Explicit index. In this case the number of packets must equal the */
469 /* number of reference values. The index of the packet associated */
470 /* with a key value of VALUE is the index of the last reference item */
471 /* that is less than or equal to VALUE. The reference values must be */
472 /* in ascending order, REF(I) < REF(I+1). */
473
474
475 /* Reference Index Type 4 */
476 /* ---------------------- */
477
478 /* Explicit index. In this case the number of packets must equal the */
479 /* number of reference values. The index of the packet associated */
480 /* with a key value of VALUE is the index of the reference item */
481 /* that is closest to the value of VALUE. In the event of a "tie" */
482 /* the larger index is selected. The reference values must be in */
483 /* ascending order, REF(I) < REF(I+1). */
484
485
486 /* These parameters define the valid range for the index types. An */
487 /* index type code, MYTYPE, for a generic segment must satisfy the */
488 /* relation MNIDXT <= MYTYPE <= MXIDXT. */
489
490
491 /* The following meta data items will appear in all generic segments. */
492 /* Other meta data items may be added if a need arises. */
493
494 /* 1) CONBAS Base Address of the constants in a generic segment. */
495
496 /* 2) NCON Number of constants in a generic segment. */
497
498 /* 3) RDRBAS Base Address of the reference directory for a */
499 /* generic segment. */
500
501 /* 4) NRDR Number of items in the reference directory of a */
502 /* generic segment. */
503
504 /* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */
505 /* generic segment. */
506
507 /* 6) REFBAS Base Address of the reference items for a generic */
508 /* segment. */
509
510 /* 7) NREF Number of reference items in a generic segment. */
511
512 /* 8) PDRBAS Base Address of the Packet Directory for a generic */
513 /* segment. */
514
515 /* 9) NPDR Number of items in the Packet Directory of a generic */
516 /* segment. */
517
518 /* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */
519 /* segment. */
520
521 /* 11) PKTBAS Base Address of the Packets for a generic segment. */
522
523 /* 12) NPKT Number of Packets in a generic segment. */
524
525 /* 13) RSVBAS Base Address of the Reserved Area in a generic */
526 /* segment. */
527
528 /* 14) NRSV Number of items in the reserved area of a generic */
529 /* segment. */
530
531 /* 15) PKTSZ Size of the packets for a segment with fixed width */
532 /* data packets or the size of the largest packet for a */
533 /* segment with variable width data packets. */
534
535 /* 16) PKTOFF Offset of the packet data from the start of a packet */
536 /* record. Each data packet is placed into a packet */
537 /* record which may have some bookkeeping information */
538 /* prepended to the data for use by the generic */
539 /* segments software. */
540
541 /* 17) NMETA Number of meta data items in a generic segment. */
542
543 /* Meta Data Item 1 */
544 /* ----------------- */
545
546
547 /* Meta Data Item 2 */
548 /* ----------------- */
549
550
551 /* Meta Data Item 3 */
552 /* ----------------- */
553
554
555 /* Meta Data Item 4 */
556 /* ----------------- */
557
558
559 /* Meta Data Item 5 */
560 /* ----------------- */
561
562
563 /* Meta Data Item 6 */
564 /* ----------------- */
565
566
567 /* Meta Data Item 7 */
568 /* ----------------- */
569
570
571 /* Meta Data Item 8 */
572 /* ----------------- */
573
574
575 /* Meta Data Item 9 */
576 /* ----------------- */
577
578
579 /* Meta Data Item 10 */
580 /* ----------------- */
581
582
583 /* Meta Data Item 11 */
584 /* ----------------- */
585
586
587 /* Meta Data Item 12 */
588 /* ----------------- */
589
590
591 /* Meta Data Item 13 */
592 /* ----------------- */
593
594
595 /* Meta Data Item 14 */
596 /* ----------------- */
597
598
599 /* Meta Data Item 15 */
600 /* ----------------- */
601
602
603 /* Meta Data Item 16 */
604 /* ----------------- */
605
606
607 /* If new meta data items are to be added to this list, they should */
608 /* be added above this comment block as described below. */
609
610 /* INTEGER NEW1 */
611 /* PARAMETER ( NEW1 = PKTOFF + 1 ) */
612
613 /* INTEGER NEW2 */
614 /* PARAMETER ( NEW2 = NEW1 + 1 ) */
615
616 /* INTEGER NEWEST */
617 /* PARAMETER ( NEWEST = NEW2 + 1 ) */
618
619 /* and then the value of NMETA must be changed as well to be: */
620
621 /* INTEGER NMETA */
622 /* PARAMETER ( NMETA = NEWEST + 1 ) */
623
624 /* Meta Data Item 17 */
625 /* ----------------- */
626
627
628 /* Maximum number of meta data items. This is always set equal to */
629 /* NMETA. */
630
631
632 /* Minimum number of meta data items that must be present in a DAF */
633 /* generic segment. This number is to remain fixed even if more */
634 /* meta data items are added for compatibility with old DAF files. */
635
636
637 /* Local Variables */
638
639
640 /* Saved Variables */
641
642
643 /* Initial Values */
644
645
646 /* Standard SPICE error handling. */
647
648 if (return_()) {
649 return 0;
650 }
651 chkin_("SGFRVI", (ftnlen)6);
652
653 /* Set the value for the maximum index as a double precision number, */
654 /* but only do it the first time into the subroutine. */
655
656 if (first) {
657 first = FALSE_;
658 dpimax = (doublereal) intmax_();
659 }
660
661 /* Collect the necessary meta data values common to all cases. */
662
663 sgmeta_(handle, descr, &c__12, &mynpkt);
664 sgmeta_(handle, descr, &c__7, &mynref);
665 sgmeta_(handle, descr, &c__5, &myrdrt);
666 sgmeta_(handle, descr, &c__6, &myrefb);
667 if (failed_()) {
668 chkout_("SGFRVI", (ftnlen)6);
669 return 0;
670 }
671
672 /* Check to be sure that we know how to deal with the type of index */
673 /* in the segment. The index type should be between the minimum */
674 /* allowed index type, MNIDXT, and the maximum allowed index type, */
675 /* MXIDXT, as specified in the file 'sgparam.inc'. */
676
677 if (myrdrt < 0 || myrdrt > 4) {
678 setmsg_("The generic DAF segment you attempted to read has an unsupp"
679 "orted reference directory structure. The integer code given "
680 "for this structure is #, and allowed codes are within the ra"
681 "nge # to #. The likely cause of this anamoly is your version"
682 " of SPICELIB needs updating. Contact your system administrat"
683 "or or NAIF for a toolkit update.", (ftnlen)331);
684 errint_("#", &myrdrt, (ftnlen)1);
685 errint_("#", &c__0, (ftnlen)1);
686 errint_("#", &c__4, (ftnlen)1);
687 sigerr_("SPICE(UNKNOWNREFDIR)", (ftnlen)20);
688 chkout_("SGFRVI", (ftnlen)6);
689 return 0;
690 }
691
692 /* We don't have an index yet and we initialize things to zero. */
693
694 myfnd = FALSE_;
695 myindx = 0;
696 myvalu = 0.;
697
698 /* We pass the idiot checks, so lets proceed. We have a IF block for */
699 /* each allowed reference directory type code. */
700
701 /* For implicitly indexed data packets, the interval */
702
703 /* [ BUFFER(1), BUFFER(1) + (N - 1) * BUFFER(2) ) */
704
705 /* is divided into subintervals as follows: */
706
707 /* (-infinity, r1), [r_1,r_2) [r_2, r_3), ..., [r_i, r_(i+1)), */
708 /* ..., [r_N, +infinity), */
709
710 /* where N = the number of packets in the segment, MYNPKT, and */
711 /* r_i = BUFFER(1) + (i-1) * BUFFER(2). */
712
713 /* If X is in [r_i, r_(i+1)), i = 1, N-1, then we found a value */
714 /* and the index returned will be i with the reference value */
715 /* returned will be r_i. */
716
717 /* If X is in [r_N, +infinity), then we found a value and the */
718 /* index returned will be N and the reference value returned will */
719 /* be r_N. */
720
721 /* If X is in (-infinity, r1), we have two possibilities: */
722
723 /* 1) If the index type is implicit closest, we found a value, */
724 /* the index returned will be 1 and the reference value */
725 /* returned will be r_1. */
726
727 /* 2) If the index type is implicit less than or equal, we do */
728 /* not find a value. */
729
730 /* For explicitly indexed packets we simply search the reference */
731 /* directory for an appropriate reference value. */
732
733 if (myrdrt != 0 && myrdrt != 1) {
734
735 /* In addition to the meta data items we already have, we also */
736 /* need these. */
737
738 sgmeta_(handle, descr, &c__4, &mynrdr);
739 sgmeta_(handle, descr, &c__3, &myrdrb);
740 if (failed_()) {
741 chkout_("SGFRVI", (ftnlen)6);
742 return 0;
743 }
744
745 /* We need to scan the reference directory (if there is one) to */
746 /* determine the appropriate block of reference values to read */
747 /* from the generic segment. Then we compute the number of */
748 /* reference values to fetch and examine. Finally, based on the */
749 /* index type we figure out whether we have found a reference */
750 /* value or not. It will take a little while to get there, so */
751 /* let's get going. */
752
753 /* We have not started yet, so we're not done and we cannot have a */
754 /* reference directory value yet. */
755
756 done = FALSE_;
757 isdirv = FALSE_;
758
759 /* We have not read any full buffers of reference directory values */
760 /* yet, all of the reference directory values remain to be read, */
761 /* and we have no index for a reference directory value. */
762
763 fullrd = 0;
764 remain = mynrdr;
765 rdridx = 0;
766
767 /* Search the reference directory values to select the appropriate */
768 /* block of reference values to read. */
769
770 while(! done && remain > 0) {
771
772 /* Read a buffer of reference directory items. */
773
774 nfetch = min(100,remain);
775 begin = myrdrb + fullrd * 100 + 1;
776 end = begin + nfetch - 1;
777 dafgda_(handle, &begin, &end, buffer);
778 if (failed_()) {
779 chkout_("SGFRVI", (ftnlen)6);
780 return 0;
781 }
782
783 /* See if X is in the current buffer. */
784
785 rdridx = lstled_(x, &nfetch, buffer);
786 if (rdridx == 0) {
787
788 /* If not, then X < BUFFER(1) and we're done. This indicates */
789 /* that the desired reference value is before, or in, the */
790 /* previous block of reference values. */
791
792 done = TRUE_;
793 } else if (rdridx == nfetch) {
794
795 /* If we get the last value of the buffer, then either we */
796 /* are done, X = BUFFER(NFETCH), or X > BUFFER(NFETCH). */
797
798 if (*x == buffer[(i__1 = nfetch - 1) < 101 && 0 <= i__1 ?
799 i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)417)]
800 ) {
801
802 /* If X = BUFFER(NFETCH) we are done, we have a directory */
803 /* value, and it might be a value we want to return. */
804
805 done = TRUE_;
806 isdirv = TRUE_;
807 } else {
808
809 /* Otherwise, we might have more stuff to read, so update */
810 /* the remainder and the current number of full buffer */
811 /* reads and try the loop again. */
812
813 remain -= nfetch;
814 if (remain > 0) {
815
816 /* We don't want to increment FULLRD for a partial */
817 /* buffer read. The arithmetic for the index */
818 /* calculations below will use RDRIDX to deal with */
819 /* this. */
820
821 ++fullrd;
822 }
823 }
824 } else {
825
826 /* BUFFER(1) <= X < BUFFER(NFETCH), i.e., we have something */
827 /* in the buffer. Check to see if X = BUFFER(RDRIDX). If so, */
828 /* we are done, we have a directory value, and it might be a */
829 /* value we want to return. Otherwise, we are just done. */
830
831 done = TRUE_;
832 if (*x == buffer[(i__1 = rdridx - 1) < 101 && 0 <= i__1 ?
833 i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)455)]
834 ) {
835 isdirv = TRUE_;
836 }
837 }
838 }
839 rdridx = fullrd * 100 + rdridx;
840
841 /* There are three cases that we need to consider when X is not a */
842 /* reference directory value: */
843
844 /* Case 1: 0 < RDRIDX < MYNRDR (most common first) */
845 /* Case 2: RDRIDX = 0 */
846 /* Case 3: RDRIDX = MYNRDR */
847
848 if (! isdirv) {
849 if (rdridx > 0 && rdridx < mynrdr) {
850
851 /* If we were able to bracket X before reaching the end of */
852 /* the reference directory, then we KNOW that we have a */
853 /* candidate for a reference value in the reference data. */
854 /* All we need to do is read the reference data and find it */
855 /* in the buffer. We also read the reference directory */
856 /* values that bracket the desired reference value into */
857 /* BUFFER, so that they are there if we need them. */
858
859 /* Computing MIN */
860 i__1 = 101, i__2 = mynref - rdridx * 100 + 1;
861 nfetch = min(i__1,i__2);
862 begin = myrefb + rdridx * 100;
863 end = begin + nfetch - 1;
864 dafgda_(handle, &begin, &end, buffer);
865 if (failed_()) {
866 chkout_("SGFRVI", (ftnlen)6);
867 return 0;
868 }
869 bfindx = lstled_(x, &nfetch, buffer);
870 myindx = rdridx * 100 + bfindx - 1;
871 } else if (rdridx == 0) {
872
873 /* The reference value may be one of the reference values */
874 /* less than the first reference directory item. So we */
875 /* compute the beginning and ending addresses for the data, */
876 /* read it in, and try to find a reference value. */
877
878 nfetch = min(101,mynref);
879 begin = myrefb + 1;
880 end = begin + nfetch - 1;
881 dafgda_(handle, &begin, &end, buffer);
882 if (failed_()) {
883 chkout_("SGFRVI", (ftnlen)6);
884 return 0;
885 }
886 bfindx = lstled_(x, &nfetch, buffer);
887 myindx = bfindx;
888 } else if (rdridx == mynrdr) {
889
890 /* If we were not able to bracket X before reaching the end */
891 /* of the reference directory, then we might have a */
892 /* candidate for a reference value in the reference data */
893 /* after the last reference directory value. All we need to */
894 /* do is read the reference data and look. */
895
896 /* NOTE: NFETCH can never be zero or negative, so we can */
897 /* glibly use it. The reason for this is the NFETCH can only */
898 /* be zero if the desired reference value is a reference */
899 /* directory value, and we already know that the reference */
900 /* value we want is not a reference directory value, because */
901 /* we are here. For similar reasons, NFETCH can never be */
902 /* negative. */
903
904 begin = myrefb + rdridx * 100;
905 end = myrefb + mynref;
906 nfetch = end - begin + 1;
907 dafgda_(handle, &begin, &end, buffer);
908 if (failed_()) {
909 chkout_("SGFRVI", (ftnlen)6);
910 return 0;
911 }
912 bfindx = lstled_(x, &nfetch, buffer);
913 myindx = rdridx * 100 + bfindx - 1;
914 }
915 } else {
916
917 /* We have a reference directory value, whose index is easy to */
918 /* compute. */
919
920 myindx = rdridx * 100;
921 }
922
923 /* Now, if we have a candidate for a reference value, lets make */
924 /* sure, based onthe type of index we have. */
925
926 if (myrdrt == 2) {
927
928 /* We have a reference value only if X > some reference */
929 /* value. */
930
931 if (! isdirv) {
932
933 /* If the value is not a reference directory value, then */
934 /* we have two cases: */
935
936 /* Case 1: 0 < MYINDX <= MYNREF */
937 /* Case 2: MYINDX = 0 */
938
939 if (myindx > 0 && myindx <= mynref) {
940
941 /* We found a reference value. The reference value we */
942 /* want is either the value indicated by MYINDX or */
943 /* the reference value immediately preceding MYINDX, */
944 /* if there is such a value. To deal with this we */
945 /* split the test up into two cases. */
946
947 if (myindx > 1) {
948
949 /* If X > BUFFER(BFINDX) then we are done, so set the */
950 /* value. If not, then we want the reference value */
951 /* that is immediately before the current one. */
952
953 if (*x > buffer[(i__1 = bfindx - 1) < 101 && 0 <=
954 i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
955 , (ftnlen)595)]) {
956 myfnd = TRUE_;
957 myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <=
958 i__1 ? i__1 : s_rnge("buffer", i__1,
959 "sgfrvi_", (ftnlen)598)];
960 } else {
961 myfnd = TRUE_;
962 myvalu = buffer[(i__1 = bfindx - 2) < 101 && 0 <=
963 i__1 ? i__1 : s_rnge("buffer", i__1,
964 "sgfrvi_", (ftnlen)603)];
965 --myindx;
966 }
967 } else {
968
969 /* Remember, MYINDX is 1 here. If we are greater */
970 /* than the first reference value in the segment, */
971 /* we are done. Otherwise there is no reference */
972 /* value to be associated with X. */
973
974 if (*x > buffer[(i__1 = myindx - 1) < 101 && 0 <=
975 i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
976 , (ftnlen)615)]) {
977 myfnd = TRUE_;
978 myvalu = buffer[(i__1 = myindx - 1) < 101 && 0 <=
979 i__1 ? i__1 : s_rnge("buffer", i__1,
980 "sgfrvi_", (ftnlen)618)];
981 } else {
982
983 /* We did not find a reference value. X was */
984 /* equal to the first reference value of the */
985 /* generic segment. */
986
987 myfnd = FALSE_;
988 }
989 }
990 } else if (myindx == 0) {
991
992 /* We did not find a reference value. X was < the */
993 /* first reference value for the generic segment. */
994
995 myfnd = FALSE_;
996 }
997 } else {
998
999 /* We have a reference directory value, and we are done. */
1000 /* Either the reference directory value is the one we */
1001 /* want or the reference value immediately preceeding it */
1002 /* is the one we want. */
1003
1004 myfnd = TRUE_;
1005 --myindx;
1006 begin = myrefb + myindx;
1007 end = begin;
1008 dafgda_(handle, &begin, &end, &myvalu);
1009 if (failed_()) {
1010 chkout_("SGFRVI", (ftnlen)6);
1011 return 0;
1012 }
1013 }
1014 } else if (myrdrt == 3) {
1015
1016 /* We have a reference value only if X >= some reference */
1017 /* value. At this point, either we have the value and index */
1018 /* we want or X is before the first reference value of the */
1019 /* generic segment. We consider two cases, the first when X */
1020 /* is not a referecne directory value, and the second when */
1021 /* it is. */
1022
1023 if (! isdirv) {
1024
1025 /* If X is not a directory value, then MYINDX is either */
1026 /* equal to zero, implying that X is before the first */
1027 /* reference value in the generic segment, or MYINDX > 0, */
1028 /* implying that we have found a reference value. */
1029
1030 if (myindx > 0 && myindx <= mynref) {
1031 myfnd = TRUE_;
1032 myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ?
1033 i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
1034 684)];
1035 } else if (myindx == 0) {
1036
1037 /* We did not find a reference value. X was < the */
1038 /* first reference value for the generic segment. */
1039
1040 myfnd = FALSE_;
1041 }
1042 } else {
1043
1044 /* We have a reference directory value, and it is the one */
1045 /* we want. */
1046
1047 myfnd = TRUE_;
1048 myvalu = *x;
1049 }
1050 } else if (myrdrt == 4) {
1051
1052 /* We have a reference value for every value of X. If X < */
1053 /* the first reference value of the generic segment, the */
1054 /* closest value is the first reference value. If X > the */
1055 /* last reference value of the generic segment, the closest */
1056 /* value is the last reference value. For X between the */
1057 /* first and last reference values we simple take the */
1058 /* closest reference value to X, resolving a tie by */
1059 /* accepting the larger reference value. */
1060
1061 if (! isdirv) {
1062
1063 /* If X is not a directory value, then MYINDX is either */
1064 /* equal to zero, implying that X is before the first */
1065 /* reference value in the generic segment, */
1066 /* 0 < MYINDX < MYNPKT, implying X is between the first */
1067 /* and last reference values in the generic segment, or */
1068 /* MYINDX = MYNPKT implying that X is greater than or */
1069 /* equal to the last reference value. */
1070
1071 if (myindx > 0 && myindx < mynref) {
1072 i__ = bfindx;
1073
1074 /* Find the closest value to X, choosing the larger in */
1075 /* the event of a tie. */
1076
1077 if (buffer[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 :
1078 s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)734)] -
1079 *x <= *x - buffer[(i__2 = i__ - 1) < 101 && 0 <=
1080 i__2 ? i__2 : s_rnge("buffer", i__2, "sgfrvi_", (
1081 ftnlen)734)]) {
1082 ++i__;
1083 ++myindx;
1084 }
1085 myfnd = TRUE_;
1086 myvalu = buffer[(i__1 = i__ - 1) < 101 && 0 <= i__1 ?
1087 i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
1088 742)];
1089 } else if (myindx == 0) {
1090
1091 /* X is before the first reference value for the */
1092 /* generic segment, so the closest reference value is */
1093 /* the first one. */
1094
1095 myfnd = TRUE_;
1096 myindx = 1;
1097 myvalu = buffer[0];
1098 } else if (myindx == mynref) {
1099
1100 /* X is at of after the last reference value for the */
1101 /* generic segment, so the closest reference value is */
1102 /* the last reference value, which will be in BUFFER. */
1103
1104 myfnd = TRUE_;
1105 myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ?
1106 i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
1107 762)];
1108 }
1109 } else {
1110
1111 /* We have a reference directory value, and it is the one */
1112 /* we want. */
1113
1114 myfnd = TRUE_;
1115 myvalu = *x;
1116 }
1117 }
1118 } else if (myrdrt == 0) {
1119
1120 /* Get the begin and end addresses from which to read the */
1121 /* reference values and get the reference values. */
1122
1123 begin = myrefb + 1;
1124 end = myrefb + 2;
1125 dafgda_(handle, &begin, &end, buffer);
1126 if (failed_()) {
1127 chkout_("SGFRVI", (ftnlen)6);
1128 return 0;
1129 }
1130 endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];
1131
1132 /* Compute the index if we can. */
1133
1134 if (*x < buffer[0]) {
1135
1136 /* If X is less than BUFFER(1), we do not have a reference */
1137 /* value. */
1138
1139 myfnd = FALSE_;
1140 } else if (*x > endref) {
1141
1142 /* If X is greater than ENDREF, then we have a reference */
1143 /* value, ENDREF. */
1144
1145 myfnd = TRUE_;
1146 myindx = mynpkt;
1147 myvalu = endref;
1148 } else {
1149
1150 /* r_1 < X < r_N, i.e., we found a value. Compute the index */
1151 /* and the reference value. */
1152
1153 if (mynpkt > 1) {
1154 myfnd = TRUE_;
1155
1156 /* Compute the index. */
1157
1158 dptemp = (*x - buffer[0]) / buffer[1] + 1.;
1159
1160 /* Test to see if we can safely convert the index to an */
1161 /* integer. */
1162
1163 if (dptemp > dpimax) {
1164 setmsg_("The computed index is too large to be represent"
1165 "ed as an integer. The most likely problem is tha"
1166 "t an incorrect value was stored for the step siz"
1167 "e. The value found for the step was: #", (ftnlen)
1168 181);
1169 errdp_("#", &buffer[1], (ftnlen)1);
1170 sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
1171 chkout_("SGFRVI", (ftnlen)6);
1172 return 0;
1173 }
1174 myindx = (integer) dptemp;
1175 myindx = min(myindx,mynpkt);
1176 } else {
1177
1178 /* There is only one packet. */
1179
1180 myindx = 1;
1181 }
1182
1183 /* Compute the reference value. */
1184
1185 myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
1186 }
1187 } else if (myrdrt == 1) {
1188
1189 /* Get the begin and end addresses from which to read the */
1190 /* reference values and get the reference values. */
1191
1192 begin = myrefb + 1;
1193 end = myrefb + 2;
1194 dafgda_(handle, &begin, &end, buffer);
1195 if (failed_()) {
1196 chkout_("SGFRVI", (ftnlen)6);
1197 return 0;
1198 }
1199 endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];
1200
1201 /* Compute the index if we can. */
1202
1203 if (*x < buffer[0]) {
1204
1205 /* If X < BUFFER(1), then we found a value, the index */
1206 /* returned will be 1 and the reference value returned will */
1207 /* be BUFFER(1). */
1208
1209 myfnd = TRUE_;
1210 myindx = 1;
1211 myvalu = buffer[0];
1212 } else if (*x > endref) {
1213
1214 /* If X > ENDREF, then we found a value, the index returned */
1215 /* will be MYNPKT and the reference value returned will be */
1216 /* ENDREF. */
1217
1218 myfnd = TRUE_;
1219 myindx = mynpkt;
1220 myvalu = endref;
1221 } else {
1222
1223 /* r_1 < X < r_N, i.e., we found a value. Compute the index */
1224 /* and the reference value. If X is closer to r_I, the index */
1225 /* returned will be I with a reference value of r_I. If X is */
1226 /* closer to r_(I+1), the index returned will be I+1 with a */
1227 /* reference value of r_(I+1). */
1228
1229 if (mynpkt > 1) {
1230 myfnd = TRUE_;
1231
1232 /* Compute the index. */
1233
1234 dptemp = (*x - buffer[0]) / buffer[1] + 1.5;
1235 if (dptemp > dpimax + .5) {
1236 setmsg_("The computed index is too large to be represent"
1237 "ed as an integer. The most likely problem is tha"
1238 "t an incorrect value was stored for the step siz"
1239 "e. The value found for the step was: #", (ftnlen)
1240 181);
1241 errdp_("#", &buffer[1], (ftnlen)1);
1242 sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
1243 chkout_("SGFRVI", (ftnlen)6);
1244 return 0;
1245 }
1246 myindx = (integer) dptemp;
1247 } else {
1248
1249 /* There is only one packet. */
1250
1251 myindx = 1;
1252 }
1253
1254 /* Compute the reference value. */
1255
1256 myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
1257 }
1258 }
1259
1260 /* At this point, we have either found a value or not. If so, then we */
1261 /* need to set the index, value, and found flag for output. */
1262 /* Otherwise, we simply set the found flag. */
1263
1264 if (myfnd) {
1265 *indx = myindx;
1266 *value = myvalu;
1267 }
1268 *found = myfnd;
1269 chkout_("SGFRVI", (ftnlen)6);
1270 return 0;
1271 } /* sgfrvi_ */
1272
1273