1 /* spkr05.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__12 = 12;
13
14 /* $Procedure SPKR05 ( Read SPK record from segment, type 5 ) */
spkr05_(integer * handle,doublereal * descr,doublereal * et,doublereal * record)15 /* Subroutine */ int spkr05_(integer *handle, doublereal *descr, doublereal *
16 et, doublereal *record)
17 {
18 /* System generated locals */
19 integer i__1, i__2;
20
21 /* Builtin functions */
22 integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
23
24 /* Local variables */
25 doublereal data[100];
26 integer nrec, ndir, skip, type__, i__, n, begin;
27 extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
28 integer *, integer *, doublereal *, integer *), moved_(doublereal
29 *, integer *, doublereal *);
30 integer group;
31 extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
32 doublereal *);
33 doublereal dc[2];
34 integer ic[6], grpadd, remain, dirloc, addrss;
35 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
36 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
37 ftnlen);
38 extern integer lstltd_(doublereal *, integer *, doublereal *);
39 extern logical return_(void);
40 integer end;
41 logical fnd;
42
43 /* $ Abstract */
44
45 /* Read a single SPK data record from a segment of type 5 */
46 /* ( two body propagation between discrete state vectors ). */
47
48 /* $ Disclaimer */
49
50 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
51 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
52 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
53 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
54 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
55 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
56 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
57 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
58 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
59 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
60
61 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
62 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
63 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
64 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
65 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
66 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
67
68 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
69 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
70 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
71 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
72
73 /* $ Required_Reading */
74
75 /* SPK */
76
77 /* $ Keywords */
78
79 /* EPHEMERIS */
80
81 /* $ Declarations */
82 /* $ Brief_I/O */
83
84 /* Variable I/O Description */
85 /* -------- --- -------------------------------------------------- */
86 /* HANDLE I File handle. */
87 /* DESCR I Segment descriptor. */
88 /* ET I Target epoch. */
89 /* RECORD O Data record. */
90
91 /* $ Detailed_Input */
92
93 /* HANDLE, */
94 /* DESCR are the file handle and segment descriptor for */
95 /* the type 05 SPK segment to be read. */
96
97 /* ET is a target epoch, specified as ephemeris seconds past */
98 /* J2000, for which a data record from the segment is */
99 /* required. */
100
101 /* $ Detailed_Output */
102
103 /* RECORD is a logical record from the specified segment which, */
104 /* when evaluated at epoch ET, will give the state */
105 /* (position and velocity) of some body, relative */
106 /* to some center, in some inertial reference frame. */
107
108 /* The structure of RECORD is: */
109
110 /* RECORD(1) */
111 /* . state of the body at epoch 1. */
112 /* . */
113 /* . */
114 /* RECORD(6) */
115
116 /* RECORD(7) */
117 /* . */
118 /* . state of the body at epoch 2. */
119 /* . */
120 /* RECORD(12) */
121 /* RECORD(13) epoch 1 in seconds past 2000. */
122 /* RECORD(14) epoch 2 in seconds past 2000. */
123 /* RECORD(15) GM for the center of motion. */
124
125
126 /* Epoch 1 and epoch 2 are the times in the segment that */
127 /* bracket ET. If ET is less than the first time in the */
128 /* segment then both epochs 1 and 2 are equal to the */
129 /* first time. And if ET is greater than the last time */
130 /* then, epochs 1 and 2 are set equal to this last time. */
131
132 /* $ Parameters */
133
134 /* None. */
135
136 /* $ Exceptions */
137
138 /* 1) If the segment specified by DESCR is not of data type 05, */
139 /* the error 'SPICE(WRONGSPKTYPE)' is signalled. */
140
141 /* 2) No error is signalled if ET is outside the time bounds of */
142 /* the segment. The output RECORD will contain epochs and the */
143 /* associated states which satisfy the rules stated above. */
144
145 /* $ Files */
146
147 /* See argument HANDLE. */
148
149 /* $ Particulars */
150
151 /* This routine reads the segment specified by DESCR from the SPK */
152 /* file attached to HANDLE to locate the two epochs in the segment */
153 /* that bracket the input ET. It then returns a logical record which */
154 /* contains these times and their associated states, and also the */
155 /* mass of the center of motion. The routine makes explicit use of */
156 /* the structure of the type 05 data segment to locate this data. */
157
158 /* See the section of the SPK Required Reading on data type 05 for */
159 /* a description of the structure of a type 05 segment. */
160
161 /* $ Examples */
162
163 /* The data returned by the SPKRnn routine is in its rawest form, */
164 /* taken directly from the segment. As such, it will be meaningless */
165 /* to a user unless he/she understands the structure of the data type */
166 /* completely. Given that understanding, however, the SPKRnn */
167 /* routines might be used to "dump" and check segment data for a */
168 /* particular epoch. */
169
170
171 /* C */
172 /* C Get a segment applicable to a specified body and epoch. */
173 /* C */
174 /* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
175
176 /* IF ( FOUND ) THEN */
177
178 /* C */
179 /* C Look at parts of the descriptor. */
180 /* C */
181 /* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
182 /* CENTER = ICD( 2 ) */
183 /* REF = ICD( 3 ) */
184 /* TYPE = ICD( 4 ) */
185
186 /* IF ( TYPE .EQ. 05 ) THEN */
187
188 /* CALL SPKR05 ( HANDLE, DESCR, ET, RECORD ) */
189 /* . */
190 /* . Look at the RECORD data. */
191 /* . */
192 /* END IF */
193
194 /* END IF */
195
196 /* $ Restrictions */
197
198 /* None. */
199
200 /* $ Literature_References */
201
202 /* None. */
203
204 /* $ Author_and_Institution */
205
206 /* J.M. Lynch (JPL) */
207 /* W.L. Taber (JPL) */
208 /* I.M. Underwood (JPL) */
209
210 /* $ Version */
211
212 /* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
213
214 /* Replaced DAFRDA call with DAFGDA. */
215 /* Added IMPLICIT NONE. */
216
217 /* - SPICELIB Version 1.0.0, 01-APR-1992 (JML) (WLT) (IMU) */
218
219 /* -& */
220 /* $ Index_Entries */
221
222 /* read record from type_5 spk segment */
223
224 /* -& */
225
226 /* Local parameters */
227
228
229 /* SPICELIB functions */
230
231
232 /* Local variables */
233
234
235 /* Standard SPICE error handling. */
236
237 if (return_()) {
238 return 0;
239 } else {
240 chkin_("SPKR05", (ftnlen)6);
241 }
242
243 /* Unpack the segment descriptor. */
244
245 dafus_(descr, &c__2, &c__6, dc, ic);
246 type__ = ic[3];
247 begin = ic[4];
248 end = ic[5];
249
250 /* Make sure that this really is a type 5 data segment. */
251
252 if (type__ != 5) {
253 setmsg_("You are attempting to locate type 5 data in a type # data s"
254 "egment.", (ftnlen)66);
255 errint_("#", &type__, (ftnlen)1);
256 sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19);
257 chkout_("SPKR05", (ftnlen)6);
258 return 0;
259 }
260
261 /* Get the number of records in the segment. While we're at it, */
262 /* get the GM of the central body (it's adjacent to NREC) */
263 /* since we'll need it anyway. Put it where it belongs, at the */
264 /* end of the output record. */
265
266 i__1 = end - 1;
267 dafgda_(handle, &i__1, &end, data);
268 nrec = i_dnnt(&data[1]);
269 record[14] = data[0];
270
271 /* From the number of records, we can compute the number of */
272 /* directory epochs. */
273
274 ndir = nrec / 100;
275
276 /* The directory epochs narrow down the search to a group of DIRSIZ */
277 /* or fewer records. Because the Ith directory epoch is the I*100th */
278 /* epoch, the Ith group will contain epochs ((I-1)*100 + 1) through */
279 /* (I*100). For example: */
280 /* group first epoch # last epoch # */
281 /* ----- ------------- ------------ */
282 /* 1 1 100 */
283 /* 2 101 200 */
284 /* . . . */
285 /* . . . */
286 /* 10 901 1000 */
287 /* . . . */
288 /* . . . */
289 /* N (N-1)*100+1 N*100 */
290 if (ndir == 0) {
291
292 /* There is only one group if there are no directory epochs. */
293
294 group = 1;
295 } else {
296
297 /* Compute the location of the first directory epoch. From the */
298 /* beginning of the segment, we need to go through all of the */
299 /* NREC states and epochs. */
300
301 dirloc = begin + nrec * 7;
302
303 /* Determine which group of DIRSIZ times to search, by finding */
304 /* the last directory epoch that is less than ET. */
305
306 fnd = FALSE_;
307 remain = ndir;
308 group = 0;
309 while(! fnd) {
310
311 /* Read in as many as BUFSIZ directory epochs at a time */
312 /* for comparison. */
313
314 n = min(remain,100);
315 i__1 = dirloc + n - 1;
316 dafgda_(handle, &dirloc, &i__1, data);
317 remain -= n;
318
319 /* Determine the last directory element in DATA that's less */
320 /* than ET. */
321
322 /* If we reach the end of the directories, and still haven't */
323 /* found one bigger than the epoch, the group is the last group */
324 /* in the segment. */
325
326 /* Otherwise keep looking. */
327
328
329 i__ = lstltd_(et, &n, data);
330 if (i__ < n) {
331 group = group + i__ + 1;
332 fnd = TRUE_;
333 } else if (remain == 0) {
334 group = ndir + 1;
335 fnd = TRUE_;
336 } else {
337 dirloc += n;
338 group += n;
339 }
340 }
341 }
342
343 /* Now we know which group of DIRSIZ (or less) epochs to look at. */
344 /* Out of the NREC epochs, the number that we should skip over */
345 /* to get to the proper group is DIRSIZ * ( GROUP - 1 ). */
346
347 skip = (group - 1) * 100;
348
349 /* From this we can compute the index into the segment of the group */
350 /* of times we want. From the beginning, we need to pass through */
351 /* STASIZ * NREC state numbers to get to the first epoch. Then we */
352 /* skip over the number just computed above. */
353
354 grpadd = begin + nrec * 6 + skip;
355
356 /* The number of epochs that we have to look at may be less than */
357 /* DIRSIZ. However many there are, go ahead and read them into the */
358 /* buffer. */
359
360 /* If there are no times in the last group then the time that we */
361 /* are looking for is the same as the last directory epoch. */
362 /* We should not try to read in this instance. */
363
364 /* Computing MIN */
365 i__1 = 100, i__2 = nrec - skip;
366 n = min(i__1,i__2);
367 if (n != 0) {
368 i__1 = grpadd + n - 1;
369 dafgda_(handle, &grpadd, &i__1, data);
370
371 /* Find the index of the largest time in the group that is less */
372 /* than the input time. */
373
374 i__ = lstltd_(et, &n, data);
375 } else {
376
377 /* If we are here it means that ET is greater then the last */
378 /* time in the segment and there are no elements in the last */
379 /* group. This can occur when the number of epochs is a multiple */
380 /* DIRSIZ. */
381
382 /* By setting N equal to I we can handle this case in the */
383 /* same branch as when there are elements in the last group. */
384 /* This is because the DATA array still contains the directory */
385 /* epochs and I is pointing at the last element which is also the */
386 /* last time in the segment. */
387
388 n = i__;
389 }
390
391 /* At this point N is the number of epochs in this GROUP which is */
392 /* also the size of the array DATA which contains the epochs. I is */
393 /* the index of the largest time in DATA which is less than ET. */
394
395 /* We need to take different actions depending on whether ET is less */
396 /* than the first time or greater than the last one in the GROUP. */
397
398 if (i__ == 0) {
399 if (group == 1) {
400
401 /* ET is less than or equal to the first time in the segment. */
402 /* Return the state at the first time twice. */
403
404 record[12] = data[0];
405 record[13] = data[0];
406 i__1 = begin + 5;
407 dafgda_(handle, &begin, &i__1, data);
408 moved_(data, &c__6, record);
409 moved_(data, &c__6, &record[6]);
410 chkout_("SPKR05", (ftnlen)6);
411 return 0;
412 } else {
413
414 /* ET is less than or equal to the first time in this group */
415 /* but not the first time in the segment. Get the last time */
416 /* from the preceding group. The states for this case will */
417 /* be read outside of the IF block. */
418
419 i__1 = grpadd - 1;
420 dafgda_(handle, &i__1, &grpadd, data);
421 record[12] = data[0];
422 record[13] = data[1];
423 }
424 } else if (i__ == n) {
425 if (group == ndir + 1) {
426
427 /* ET is greater than all of the times in the segment. Return */
428 /* the state for the last time twice. */
429
430 record[12] = data[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
431 s_rnge("data", i__1, "spkr05_", (ftnlen)481)];
432 record[13] = data[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
433 s_rnge("data", i__1, "spkr05_", (ftnlen)482)];
434 addrss = begin + (nrec - 1) * 6;
435 i__1 = addrss + 5;
436 dafgda_(handle, &addrss, &i__1, data);
437 moved_(data, &c__6, record);
438 moved_(data, &c__6, &record[6]);
439 chkout_("SPKR05", (ftnlen)6);
440 return 0;
441 } else {
442
443 /* ET is greater than the last time in this group but this is */
444 /* not the last time in the segment. Need the first time from */
445 /* the following group. The states for this case will be read */
446 /* outside of the IF block. */
447
448 i__1 = grpadd + n - 1;
449 i__2 = grpadd + n;
450 dafgda_(handle, &i__1, &i__2, data);
451 record[12] = data[0];
452 record[13] = data[1];
453 }
454 } else {
455
456 /* There are two times in the group that bracket ET. The states */
457 /* for this case will be read outside of the IF block. */
458
459 record[12] = data[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge(
460 "data", i__1, "spkr05_", (ftnlen)513)];
461 record[13] = data[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge(
462 "data", i__1, "spkr05_", (ftnlen)514)];
463 }
464
465 /* Read the consecutive states for the two epochs found above. */
466 /* ET is greater than the (SKIP + I)th time but less than or */
467 /* equal to the time (SKIP + I + 1). */
468
469 addrss = begin + (skip + i__ - 1) * 6;
470 i__1 = addrss + 11;
471 dafgda_(handle, &addrss, &i__1, data);
472 moved_(data, &c__12, record);
473 chkout_("SPKR05", (ftnlen)6);
474 return 0;
475 } /* spkr05_ */
476
477