1 /* spks14.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__1 = 1;
13 static integer c__128 = 128;
14
15 /* $Procedure SPKS14 ( S/P Kernel, subset, type 14 ) */
spks14_(integer * srchan,doublereal * srcdsc,integer * dsthan,doublereal * dstdsc,char * dstsid,ftnlen dstsid_len)16 /* Subroutine */ int spks14_(integer *srchan, doublereal *srcdsc, integer *
17 dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len)
18 {
19 /* System generated locals */
20 integer i__1;
21
22 /* Local variables */
23 integer body, i__;
24 extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
25 integer *, integer *, doublereal *, integer *), spk14a_(integer *,
26 integer *, doublereal *, doublereal *), spk14b_(integer *, char *
27 , integer *, integer *, char *, doublereal *, doublereal *,
28 integer *, ftnlen, ftnlen), spk14e_(integer *);
29 doublereal dtemp[2];
30 logical found;
31 integer itemp[6];
32 doublereal myref;
33 integer dummy, chbdeg;
34 extern logical failed_(void);
35 integer begidx, iframe;
36 doublereal begtim;
37 integer endidx;
38 extern /* Subroutine */ int irfnam_(integer *, char *, ftnlen), sgfref_(
39 integer *, doublereal *, integer *, integer *, doublereal *);
40 doublereal endtim, record[128];
41 integer center;
42 extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *,
43 integer *, doublereal *);
44 char myfram[16];
45 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
46 ftnlen);
47 integer recsiz;
48 extern /* Subroutine */ int sgfrvi_(integer *, doublereal *, doublereal *,
49 doublereal *, integer *, logical *), sgfpkt_(integer *,
50 doublereal *, integer *, integer *, doublereal *, integer *),
51 setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen);
52 extern logical return_(void);
53
54 /* $ Abstract */
55
56 /* Extract a subset of the data in a type 14 SPK segment into a new */
57 /* type 14 segment. */
58
59 /* $ Disclaimer */
60
61 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
62 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
63 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
64 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
65 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
66 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
67 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
68 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
69 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
70 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
71
72 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
73 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
74 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
75 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
76 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
77 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
78
79 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
80 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
81 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
82 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
83
84 /* $ Required_Reading */
85
86 /* SPK */
87
88 /* $ Keywords */
89
90 /* EPHEMERIS */
91
92 /* $ Declarations */
93 /* $ Brief_I/O */
94
95 /* Variable I/O Description */
96 /* -------- --- -------------------------------------------------- */
97 /* SRCHAN I Handle of the SPK file with the source segment. */
98 /* SRCDSC I Descriptor for the source segment. */
99 /* DSTHAN I Handle of the SPK file for the destination segment. */
100 /* DSTDSC I Descriptor for the destination segment. */
101 /* DSTSID I Segment identifier for the new segment. */
102
103 /* $ Detailed_Input */
104
105 /* SRCHAN The handle of the SPK file containing the source segment. */
106
107 /* SRCDSC The SPK descriptor for the source segment. */
108
109 /* DSTHAN The handle of the SPK file containing the new segment. */
110
111 /* DSTDSC The SPK descriptor for the destination segment. It */
112 /* contains the desired start and stop times for the */
113 /* requested subset. */
114
115 /* DSTSID The segment identifier for the destination segment. */
116
117 /* $ Detailed_Output */
118
119 /* None. */
120
121 /* $ Parameters */
122
123 /* None. */
124
125 /* $ Exceptions */
126
127 /* 1) If the length of the SPK record that is to be moved is larger */
128 /* than MAXREC, the error 'SPICE(SPKRECTOOLARGE)' will be */
129 /* signalled. */
130
131 /* $ Files */
132
133 /* See arguments SRCHAN, DSTHAN. */
134
135 /* $ Particulars */
136
137 /* This subroutine copies a subset of the data form one SPK segment */
138 /* to another. */
139
140 /* The exact structure of a segment of SPK type 14 is detailed in */
141 /* the SPK Required Reading. Please see this document for details. */
142
143 /* $ Examples */
144
145 /* None. */
146
147 /* $ Restrictions */
148
149 /* 1) We assume that the source descriptor actually describes a */
150 /* segment in the source SPK file containing the time coverage */
151 /* that is desired for the subsetting operation. */
152
153 /* $ Literature_References */
154
155 /* None. */
156
157 /* $ Author_and_Institution */
158
159 /* K.R. Gehringer (JPL) */
160
161 /* $ Version */
162
163 /* - SPICELIB Version 1.0.0, 08-MAR-1995 (KRG) */
164
165 /* -& */
166 /* $ Index_Entries */
167
168 /* subset type_14 spk segment */
169
170 /* -& */
171
172 /* SPICELIB functions */
173
174
175 /* Local Parameters */
176
177 /* This is the maximum size type 14 record that we can move. This */
178 /* allows a 20th degree Chebyshev Polynomial, which should be more */
179 /* than sufficient. This should be the same as the value in SPKPV. */
180
181
182 /* Reference frame name size. See CHGIRF. */
183
184
185 /* DAF ND and NI values for SPK files. */
186
187
188 /* Length of a state. */
189
190
191 /* Local Variables */
192
193
194 /* Standard SPICE error handling. */
195
196 if (return_()) {
197 return 0;
198 } else {
199 chkin_("SPKS14", (ftnlen)6);
200 }
201
202 /* First, unpack the destination segment descriptor and set some */
203 /* local variables. */
204
205 dafus_(dstdsc, &c__2, &c__6, dtemp, itemp);
206 begtim = dtemp[0];
207 endtim = dtemp[1];
208 body = itemp[0];
209 center = itemp[1];
210 iframe = itemp[2];
211 irfnam_(&iframe, myfram, (ftnlen)16);
212
213 /* If we can't find the code, it can't be an SPK file. */
214
215 if (failed_()) {
216 chkout_("SPKS14", (ftnlen)6);
217 return 0;
218 }
219
220 /* Get the constants for this segment. There is only one. */
221
222 sgfcon_(srchan, srcdsc, &c__1, &c__1, dtemp);
223 if (failed_()) {
224 chkout_("SPKS14", (ftnlen)6);
225 return 0;
226 }
227
228 /* The first element of DTEMP now contains the number of coefficients */
229 /* used for the Chebyshev polynomials. We need the degree of the */
230 /* polynomial which is one less than the number of coefficients. */
231
232 chbdeg = (integer) dtemp[0] - 1;
233
234 /* Compute the size of the SPK record and signal an error if there is */
235 /* not enough room in the variable RECORD to hold it. */
236
237 recsiz = (chbdeg + 1) * 6 + 2;
238 if (recsiz > 128) {
239 setmsg_("Storage for # double precision numbers is needed for an SPK"
240 " data record and only # locations were available. Update the"
241 " parameter MAXREC in the subroutine SPKS14 and notify the NA"
242 "IF group of this problem.", (ftnlen)204);
243 errint_("#", &recsiz, (ftnlen)1);
244 errint_("#", &c__128, (ftnlen)1);
245 sigerr_("SPICE(SPKRECTOOLARGE)", (ftnlen)21);
246 chkout_("SPKS14", (ftnlen)6);
247 return 0;
248 }
249
250 /* Get the beginning and ending indices for the packets we need for */
251 /* the destination segment. */
252
253 sgfrvi_(srchan, srcdsc, &begtim, &myref, &begidx, &found);
254 sgfrvi_(srchan, srcdsc, &endtim, &myref, &endidx, &found);
255
256 /* Begin the destination segment. */
257
258 spk14b_(dsthan, dstsid, &body, ¢er, myfram, &begtim, &endtim, &chbdeg,
259 dstsid_len, (ftnlen)16);
260 if (failed_()) {
261 chkout_("SPKS14", (ftnlen)6);
262 return 0;
263 }
264
265 /* Now we get the data one record at a time from the source segment */
266 /* and write it out to the destination segment. */
267
268 i__1 = endidx;
269 for (i__ = begidx; i__ <= i__1; ++i__) {
270 sgfpkt_(srchan, srcdsc, &i__, &i__, record, &dummy);
271 sgfref_(srchan, srcdsc, &i__, &i__, &myref);
272 spk14a_(dsthan, &c__1, record, &myref);
273 if (failed_()) {
274 chkout_("SPKS14", (ftnlen)6);
275 return 0;
276 }
277 }
278
279 /* Now all we need to do is end the segment. */
280
281 spk14e_(dsthan);
282 chkout_("SPKS14", (ftnlen)6);
283 return 0;
284 } /* spks14_ */
285
286