1 /* spkr01.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 static integer c__100 = 100;
13
14 /* $Procedure SPKR01 ( Read SPK record from segment, type 1 ) */
spkr01_(integer * handle,doublereal * descr,doublereal * et,doublereal * record)15 /* Subroutine */ int spkr01_(integer *handle, doublereal *descr, doublereal *
16 et, doublereal *record)
17 {
18 /* System generated locals */
19 integer i__1, i__2, i__3;
20
21 /* Local variables */
22 doublereal data[100];
23 integer offd, offe, nrec, ndir, offr, i__, begin;
24 extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
25 integer *, integer *, doublereal *, integer *);
26 integer recno;
27 extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
28 doublereal *);
29 doublereal dc[2];
30 integer ic[6];
31 extern /* Subroutine */ int chkout_(char *, ftnlen);
32 extern integer lstltd_(doublereal *, integer *, doublereal *);
33 extern logical return_(void);
34 integer end, off;
35
36 /* $ Abstract */
37
38 /* Read a single SPK data record from a segment of type 1 */
39 /* (Difference Lines). */
40
41 /* $ Disclaimer */
42
43 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
44 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
45 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
46 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
47 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
48 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
49 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
50 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
51 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
52 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
53
54 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
55 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
56 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
57 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
58 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
59 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
60
61 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
62 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
63 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
64 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
65
66 /* $ Required_Reading */
67
68 /* SPK */
69
70 /* $ Keywords */
71
72 /* EPHEMERIS */
73
74 /* $ Declarations */
75 /* $ Brief_I/O */
76
77 /* Variable I/O Description */
78 /* -------- --- -------------------------------------------------- */
79 /* HANDLE I File handle. */
80 /* DESCR I Segment descriptor. */
81 /* ET I Target epoch. */
82 /* RECORD O Data record. */
83
84 /* $ Detailed_Input */
85
86 /* HANDLE, */
87 /* DESCR are the file handle and segment descriptor for */
88 /* a SPK segment of type 1. */
89
90 /* ET is a target epoch, for which a data record from */
91 /* a specific segment is required. */
92
93 /* $ Detailed_Output */
94
95 /* RECORD is the record from the specified segment which, */
96 /* when evaluated at epoch ET, will give the state */
97 /* (position and velocity) of some body, relative */
98 /* to some center, in some inertial reference frame. */
99
100 /* $ Parameters */
101
102 /* None. */
103
104 /* $ Exceptions */
105
106 /* None. */
107
108 /* $ Files */
109
110 /* See argument HANDLE. */
111
112 /* $ Particulars */
113
114 /* See the SPK Required Reading file for a description of the */
115 /* structure of a data type 1 segment. */
116
117 /* $ Examples */
118
119 /* The data returned by the SPKRnn routine is in its rawest form, */
120 /* taken directly from the segment. As such, it will be meaningless */
121 /* to a user unless he/she understands the structure of the data type */
122 /* completely. Given that understanding, however, the SPKRxx */
123 /* routines might be used to "dump" and check segment data for a */
124 /* particular epoch. */
125
126
127 /* C */
128 /* C Get a segment applicable to a specified body and epoch. */
129 /* C */
130 /* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
131
132 /* C */
133 /* C Look at parts of the descriptor. */
134 /* C */
135 /* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
136 /* CENTER = ICD( 2 ) */
137 /* REF = ICD( 3 ) */
138 /* TYPE = ICD( 4 ) */
139
140 /* IF ( TYPE .EQ. 1 ) THEN */
141 /* CALL SPKR01 ( HANDLE, DESCR, ET, RECORD ) */
142 /* . */
143 /* . Look at the RECORD data. */
144 /* . */
145 /* END IF */
146
147 /* $ Restrictions */
148
149 /* None. */
150
151 /* $ Literature_References */
152
153 /* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
154 /* User's Guide" */
155
156 /* $ Author_and_Institution */
157
158 /* I.M. Underwood (JPL) */
159
160 /* $ Version */
161
162 /* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
163
164 /* Replaced DAFRDA call with DAFGDA. */
165
166 /* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */
167
168 /* Comment section for permuted index source lines was added */
169 /* following the header. */
170
171 /* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */
172
173 /* SPK01 was removed from the Required_Reading section of the */
174 /* header. The information in the SPK01 Required Reading file */
175 /* is now part of the SPK Required Reading file. */
176
177 /* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
178
179 /* Literature references added to the header. */
180
181 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
182
183 /* -& */
184 /* $ Index_Entries */
185
186 /* read record from type_1 spk segment */
187
188 /* -& */
189
190 /* SPICELIB functions */
191
192
193 /* Local variables */
194
195
196 /* Standard SPICE error handling. */
197
198 if (return_()) {
199 return 0;
200 } else {
201 chkin_("SPKR01", (ftnlen)6);
202 }
203
204 /* Unpack the segment descriptor. */
205
206 dafus_(descr, &c__2, &c__6, dc, ic);
207 begin = ic[4];
208 end = ic[5];
209
210 /* Get the number of records in the segment. From that, we can */
211 /* compute */
212
213 /* NDIR The number of directory epochs. */
214
215 /* OFFD The offset of the first directory epoch. */
216
217 /* OFFE The offset of the first epoch. */
218
219
220 /* the number of directory epochs. */
221
222 dafgda_(handle, &end, &end, data);
223 nrec = (integer) data[0];
224 ndir = nrec / 100;
225 offd = end - ndir - 1;
226 offe = end - ndir - nrec - 1;
227
228 /* What we want is the record number: once we have that, we can */
229 /* compute the offset of the record from the beginning of the */
230 /* segment, grab it, and go. But how to find it? */
231
232 /* Ultimately, we want the first record whose epoch is greater */
233 /* than or equal to ET. If there are 100 or fewer records, all */
234 /* the record epochs can be examined in a single group. */
235
236 if (nrec <= 100) {
237 i__1 = offe + 1;
238 i__2 = offe + nrec;
239 dafgda_(handle, &i__1, &i__2, data);
240 recno = lstltd_(et, &nrec, data) + 1;
241 offr = begin - 1 + (recno - 1) * 71;
242 i__1 = offr + 1;
243 i__2 = offr + 71;
244 dafgda_(handle, &i__1, &i__2, record);
245 chkout_("SPKR01", (ftnlen)6);
246 return 0;
247 }
248
249 /* Searching directories is a little more difficult. */
250
251 /* The directory contains epochs 100, 200, and so on. Once we */
252 /* find the first directory epoch greater than or equal to ET, */
253 /* we can grab the corresponding set of 100 record epochs, and */
254 /* search them. */
255
256 i__1 = ndir;
257 for (i__ = 1; i__ <= i__1; ++i__) {
258 i__2 = offd + i__;
259 i__3 = offd + i__;
260 dafgda_(handle, &i__2, &i__3, data);
261 if (data[0] >= *et) {
262 off = offe + (i__ - 1) * 100;
263 i__2 = off + 1;
264 i__3 = off + 100;
265 dafgda_(handle, &i__2, &i__3, data);
266 recno = (i__ - 1) * 100 + lstltd_(et, &c__100, data) + 1;
267 offr = begin - 1 + (recno - 1) * 71;
268 i__2 = offr + 1;
269 i__3 = offr + 71;
270 dafgda_(handle, &i__2, &i__3, record);
271 chkout_("SPKR01", (ftnlen)6);
272 return 0;
273 }
274 }
275
276 /* If ET is greater than the final directory epoch, we want one */
277 /* of the final records. */
278
279 i__ = nrec % 100;
280 i__1 = end - ndir - i__;
281 i__2 = end - ndir - 1;
282 dafgda_(handle, &i__1, &i__2, data);
283 recno = ndir * 100 + lstltd_(et, &i__, data) + 1;
284 offr = begin - 1 + (recno - 1) * 71;
285 i__1 = offr + 1;
286 i__2 = offr + 71;
287 dafgda_(handle, &i__1, &i__2, record);
288 chkout_("SPKR01", (ftnlen)6);
289 return 0;
290 } /* spkr01_ */
291
292