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