1 /* spks09.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__6 = 6;
11 static integer c__1 = 1;
12
13 /* $Procedure SPKS09 ( S/P Kernel, subset, type 9 ) */
spks09_(integer * handle,integer * baddr,integer * eaddr,doublereal * begin,doublereal * end)14 /* Subroutine */ int spks09_(integer *handle, integer *baddr, integer *eaddr,
15 doublereal *begin, doublereal *end)
16 {
17 /* System generated locals */
18 integer i__1, i__2, i__3;
19 doublereal d__1;
20
21 /* Builtin functions */
22 integer i_dnnt(doublereal *);
23
24 /* Local variables */
25 doublereal data[6];
26 integer offe, nrec, ndir, i__;
27 extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *,
28 integer *), dafgda_(integer *, integer *, integer *, doublereal *)
29 ;
30 integer degree, offset;
31 extern /* Subroutine */ int chkout_(char *, ftnlen);
32 extern logical return_(void);
33 integer rec[2];
34
35 /* $ Abstract */
36
37 /* Extract a subset of the data in an SPK segment of type 9 */
38 /* into a new segment. */
39
40 /* $ Disclaimer */
41
42 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
43 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
44 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
45 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
46 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
47 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
48 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
49 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
50 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
51 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
52
53 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
54 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
55 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
56 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
57 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
58 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
59
60 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
61 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
62 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
63 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
64
65 /* $ Required_Reading */
66
67 /* SPK */
68 /* DAF */
69
70 /* $ Keywords */
71
72 /* EPHEMERIS */
73
74 /* $ Declarations */
75 /* $ Brief_I/O */
76
77 /* Variable I/O Description */
78 /* -------- --- -------------------------------------------------- */
79 /* HANDLE I Handle of file containing source segment. */
80 /* BADDR I Beginning address in file of source segment. */
81 /* EADDR I Ending address in file of source segment. */
82 /* BEGIN I Beginning (initial epoch) of subset. */
83 /* END I End (final epoch) of subset. */
84
85 /* $ Detailed_Input */
86
87 /* HANDLE, */
88 /* BADDR, */
89 /* EADDR are the file handle assigned to an SPK file, and the */
90 /* beginning and ending addresses of a segment within */
91 /* that file. Together they determine a complete set of */
92 /* ephemeris data, from which a subset is to be */
93 /* extracted. */
94
95 /* BEGIN, */
96 /* END are the initial and final epochs (ephemeris time) */
97 /* of the subset. */
98
99 /* The first epoch for which there will be ephemeris */
100 /* data in the new segment will be the greatest time */
101 /* in the source segment that is less than or equal */
102 /* to BEGIN. */
103
104 /* The last epoch for which there will be ephemeris */
105 /* data in the new segment will be the smallest time */
106 /* in the source segment that is greater than or equal */
107 /* to END. */
108
109 /* $ Detailed_Output */
110
111 /* See $Files section. */
112
113 /* $ Parameters */
114
115 /* None. */
116
117 /* $ Exceptions */
118
119 /* 1) This routine relies on the caller to ensure that the */
120 /* interval [BEGIN, END] is contained in the coverage */
121 /* interval of the segment. */
122
123 /* 2) If BEGIN > END, no data is written to the target file. */
124
125 /* $ Files */
126
127 /* Data is extracted from the file connected to the input */
128 /* handle, and written to the current DAF open for writing. */
129
130 /* The segment descriptor and summary must already have been written */
131 /* prior to calling this routine. The segment must be ended */
132 /* external to this routine. */
133
134 /* $ Particulars */
135
136 /* This routine is intended solely for use as a utility by the */
137 /* routine SPKSUB. */
138
139 /* It transfers a subset of a type 09 SPK data segment to */
140 /* a properly initialized segment of a second SPK file. */
141
142 /* The exact structure of a segment of data type 09 is described */
143 /* in the section on type 09 in the SPK Required Reading. */
144
145 /* $ Examples */
146
147 /* This routine is intended only for use as a utility by SPKSUB. */
148 /* To use this routine successfully, you must: */
149
150 /* Open the SPK file from which to extract data. */
151 /* Locate the segment from which data should be extracted. */
152
153 /* Open the SPK file to which this data should be written. */
154 /* Begin a new segment (array). */
155 /* Write the summary information for the array. */
156
157 /* Call this routine to extract the appropriate data from the */
158 /* SPK open for read. */
159
160 /* End the array to which this routine writes data. */
161
162 /* Much of this procedure is carried out by the routine SPKSUB. The */
163 /* examples of that routine illustrate more fully the process */
164 /* described above. */
165
166 /* $ Restrictions */
167
168 /* None. */
169
170 /* $ Literature_References */
171
172 /* None. */
173
174 /* $ Author_and_Institution */
175
176 /* N.J. Bachman (JPL) */
177 /* J.M. Lynch (JPL) */
178 /* W.L. Taber (JPL) */
179 /* I.M. Underwood (JPL) */
180
181 /* $ Version */
182
183 /* - SPICELIB Version 2.1.0, 07-SEP-2001 (EDW) */
184
185 /* Replaced DAFRDA call with DAFGDA. */
186 /* Added IMPLICIT NONE. */
187
188 /* - SPICELIB Version 2.0.0, 27-AUG-1994 (NJB) */
189
190 /* Bug fix: Sufficient bracketing states are now included in the */
191 /* output segment to ensure duplication of states given by source */
192 /* segment. */
193
194 /* Test for null subset simplified. */
195
196 /* - SPICELIB Version 1.0.0, 08-AUG-1993 (NJB) (JML) (WLT) (IMU) */
197
198 /* -& */
199 /* $ Index_Entries */
200
201 /* subset type_9 spk segment */
202
203 /* -& */
204 /* $ Revisions */
205
206
207 /* -& */
208
209 /* SPICELIB functions */
210
211
212 /* Local variables */
213
214
215 /* Standard SPICE error handling. */
216
217 if (return_()) {
218 return 0;
219 } else {
220 chkin_("SPKS09", (ftnlen)6);
221 }
222
223 /* See whether there's any work to do; return immediately if not. */
224
225 if (*begin > *end) {
226 chkout_("SPKS09", (ftnlen)6);
227 return 0;
228 }
229
230 /* Get the number of records in the segment. Get the polynomial */
231 /* degree as well. */
232
233 i__1 = *eaddr - 1;
234 dafgda_(handle, &i__1, eaddr, data);
235 degree = i_dnnt(data);
236 nrec = i_dnnt(&data[1]);
237
238 /* From the number of records, we can compute */
239
240 /* NDIR The number of directory epochs. */
241
242 /* OFFE The offset of the first epoch. */
243
244 ndir = (nrec - 1) / 100;
245 offe = *eaddr - ndir - nrec - 2;
246
247 /* Examine the epochs in forward order, looking for the first */
248 /* epoch greater than or equal to END (or the final epoch, */
249 /* whichever comes first). This epoch corresponds to the last */
250 /* state to be transferred. */
251
252 rec[1] = 1;
253 i__1 = offe + rec[1];
254 i__2 = offe + rec[1];
255 dafgda_(handle, &i__1, &i__2, data);
256 while(rec[1] < nrec && data[0] < *end) {
257 ++rec[1];
258 i__1 = offe + rec[1];
259 i__2 = offe + rec[1];
260 dafgda_(handle, &i__1, &i__2, data);
261 }
262
263 /* Make sure that there are DEGREE/2 additional states to the right */
264 /* of the one having index REC(2), if possible. If not, take as */
265 /* many states as we can. */
266
267 /* Computing MIN */
268 i__1 = nrec, i__2 = rec[1] + degree / 2;
269 rec[1] = min(i__1,i__2);
270
271 /* Make sure that REC(2) is large enough so that there are are at */
272 /* least DEGREE+1 states in the segment. */
273
274 /* Computing MAX */
275 i__1 = rec[1], i__2 = degree + 1;
276 rec[1] = max(i__1,i__2);
277
278 /* Now examine the epochs in reverse order, looking for the first */
279 /* epoch less than or equal to BEGIN (or the initial epoch, */
280 /* whichever comes first). This epoch corresponds to the first */
281 /* state to be transferred. */
282
283 rec[0] = nrec;
284 i__1 = offe + rec[0];
285 i__2 = offe + rec[0];
286 dafgda_(handle, &i__1, &i__2, data);
287 while(rec[0] > 1 && data[0] > *begin) {
288 --rec[0];
289 i__1 = offe + rec[0];
290 i__2 = offe + rec[0];
291 dafgda_(handle, &i__1, &i__2, data);
292 }
293
294 /* Make sure that there are DEGREE/2 additional states to the left */
295 /* of the one having index REC(1), if possible. If not, take as */
296 /* many states as we can. */
297
298 /* Computing MAX */
299 i__1 = 1, i__2 = rec[0] - degree / 2;
300 rec[0] = max(i__1,i__2);
301
302 /* Make sure that REC(1) is small enough so that there are are at */
303 /* least DEGREE+1 states in the segment. */
304
305 /* Computing MIN */
306 i__1 = rec[0], i__2 = nrec - degree;
307 rec[0] = min(i__1,i__2);
308
309 /* Copy states REC(1) through REC(2) to the output file. */
310
311 i__1 = rec[1];
312 for (i__ = rec[0]; i__ <= i__1; ++i__) {
313 offset = *baddr - 1 + (i__ - 1) * 6;
314 i__2 = offset + 1;
315 i__3 = offset + 6;
316 dafgda_(handle, &i__2, &i__3, data);
317 dafada_(data, &c__6);
318 }
319
320 /* Copy epochs REC(1) through REC(2) to the output file. */
321
322 i__1 = rec[1];
323 for (i__ = rec[0]; i__ <= i__1; ++i__) {
324 i__2 = offe + i__;
325 i__3 = offe + i__;
326 dafgda_(handle, &i__2, &i__3, data);
327 dafada_(data, &c__1);
328 }
329
330 /* Put every 100'th epoch into the directory, except the last */
331 /* epoch, if that epoch's index would be a multiple of 100. */
332
333 i__1 = rec[1] - 1;
334 for (i__ = rec[0] + 99; i__ <= i__1; i__ += 100) {
335 i__2 = offe + i__;
336 i__3 = offe + i__;
337 dafgda_(handle, &i__2, &i__3, data);
338 dafada_(data, &c__1);
339 }
340
341 /* Store the polynomial degree and the number of records */
342 /* to end the segment. */
343
344 d__1 = (doublereal) degree;
345 dafada_(&d__1, &c__1);
346 d__1 = (doublereal) (rec[1] - rec[0] + 1);
347 dafada_(&d__1, &c__1);
348 chkout_("SPKS09", (ftnlen)6);
349 return 0;
350 } /* spks09_ */
351
352