1 /* zzfrmgt1.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__1 = 1;
11
12 /* $Procedure ZZFRMGT1 (Frame get transformation) */
zzfrmgt1_(integer * infrm,doublereal * et,doublereal * xform,integer * outfrm,logical * found)13 /* Subroutine */ int zzfrmgt1_(integer *infrm, doublereal *et, doublereal *
14 xform, integer *outfrm, logical *found)
15 {
16 /* System generated locals */
17 integer i__1, i__2;
18
19 /* Builtin functions */
20 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
21 integer s_rnge(char *, integer, char *, integer);
22
23 /* Local variables */
24 integer cent, type__, i__, j;
25 extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
26 ftnlen, ftnlen);
27 doublereal tsipm[36] /* was [6][6] */;
28 char versn[6];
29 extern logical failed_(void);
30 extern /* Subroutine */ int ckfxfm_(integer *, doublereal *, doublereal *,
31 integer *, logical *), namfrm_(char *, integer *, ftnlen),
32 frinfo_(integer *, integer *, integer *, integer *, logical *),
33 tisbod_(char *, integer *, doublereal *, doublereal *, ftnlen),
34 tkfram_(integer *, doublereal *, integer *, logical *), sigerr_(
35 char *, ftnlen);
36 integer typeid;
37 extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
38 ftnlen), errint_(char *, integer *, ftnlen), irfrot_(integer *,
39 integer *, doublereal *);
40 extern logical return_(void);
41 extern /* Subroutine */ int invstm_(doublereal *, doublereal *);
42 doublereal rot[9] /* was [3][3] */;
43
44 /* $ Abstract */
45
46 /* SPICE Private routine intended solely for the support of SPICE */
47 /* routines. Users should not call this routine directly due */
48 /* to the volatile nature of this routine. */
49
50 /* Find the transformation from a user specified frame to */
51 /* another frame at a user specified epoch. */
52
53 /* $ Disclaimer */
54
55 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
56 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
57 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
58 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
59 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
60 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
61 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
62 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
63 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
64 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
65
66 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
67 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
68 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
69 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
70 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
71 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
72
73 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
74 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
75 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
76 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
77
78 /* $ Required_Reading */
79
80 /* None. */
81
82 /* $ Keywords */
83
84 /* FRAMES */
85
86 /* $ Declarations */
87 /* $ Abstract */
88
89 /* The parameters below form an enumerated list of the recognized */
90 /* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
91 /* are outlined below. */
92
93 /* $ Disclaimer */
94
95 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
96 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
97 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
98 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
99 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
100 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
101 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
102 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
103 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
104 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
105
106 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
107 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
108 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
109 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
110 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
111 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
112
113 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
114 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
115 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
116 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
117
118 /* $ Parameters */
119
120 /* INERTL an inertial frame that is listed in the routine */
121 /* CHGIRF and that requires no external file to */
122 /* compute the transformation from or to any other */
123 /* inertial frame. */
124
125 /* PCK is a frame that is specified relative to some */
126 /* INERTL frame and that has an IAU model that */
127 /* may be retrieved from the PCK system via a call */
128 /* to the routine TISBOD. */
129
130 /* CK is a frame defined by a C-kernel. */
131
132 /* TK is a "text kernel" frame. These frames are offset */
133 /* from their associated "relative" frames by a */
134 /* constant rotation. */
135
136 /* DYN is a "dynamic" frame. These currently are */
137 /* parameterized, built-in frames where the full frame */
138 /* definition depends on parameters supplied via a */
139 /* frame kernel. */
140
141 /* ALL indicates any of the above classes. This parameter */
142 /* is used in APIs that fetch information about frames */
143 /* of a specified class. */
144
145
146 /* $ Author_and_Institution */
147
148 /* N.J. Bachman (JPL) */
149 /* W.L. Taber (JPL) */
150
151 /* $ Literature_References */
152
153 /* None. */
154
155 /* $ Version */
156
157 /* - SPICELIB Version 4.0.0, 08-MAY-2012 (NJB) */
158
159 /* The parameter ALL was added to support frame fetch APIs. */
160
161 /* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
162
163 /* The parameter DYN was added to support the dynamic frame class. */
164
165 /* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
166
167 /* Various unused frames types were removed and the */
168 /* frame time TK was added. */
169
170 /* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
171
172 /* -& */
173
174 /* End of INCLUDE file frmtyp.inc */
175
176 /* $ Brief_I/O */
177
178 /* VARIABLE I/O DESCRIPTION */
179 /* -------- --- -------------------------------------------------- */
180 /* INFRM I The integer code for a SPICE reference frame. */
181 /* ET I An epoch in seconds past J2000. */
182 /* XFORM O A state transformation matrix. */
183 /* OUTFRM O The frame that XFORM transforms INFRM to. */
184 /* FOUND O TRUE if a frame transformation can be found. */
185
186 /* $ Detailed_Input */
187
188 /* INFRM is the SPICE id-code for some reference frame. */
189
190 /* ET is an epoch in ephemeris seconds past J2000 at */
191 /* which the user wishes to retrieve a state */
192 /* transformation matrix. */
193
194 /* $ Detailed_Output */
195
196 /* XFORM is a 6x6 matrix that transforms states relative to */
197 /* INFRM to states relative to OUTFRM. (Assuming such */
198 /* a transformation can be found.) */
199
200 /* OUTFRM is a reference frame. The 6x6 matrix XFORM transforms */
201 /* states relative to INFRM to states relative to OUTFRM. */
202 /* The state transformation is achieved by multiplying */
203 /* XFORM on the right by a state relative to INFRM. This */
204 /* is easily accomplished via the subroutine call */
205 /* shown below. */
206
207 /* CALL MXVG ( XFORM, STATE, 6, 6, OSTATE ) */
208
209 /* FOUND is a logical flag indicating whether or not a */
210 /* transformation matrix could be found from INFRM */
211 /* to some other frame. If a transformation matrix */
212 /* cannot be found OUTFRM will be set to zero, FOUND */
213 /* will be set to FALSE and XFORM will be returned */
214 /* as the zero matrix. */
215
216 /* $ Parameters */
217
218 /* None. */
219
220 /* $ Files */
221
222 /* None. */
223
224 /* $ Exceptions */
225
226 /* 1) If a transformation matrix cannot be located, then */
227 /* FOUND will be set to FALSE, OUTFRM will be set to zero */
228 /* and XFORM will be set to the zero 6x6 matrix. */
229
230 /* 2) If the class of the requested frame is not recognized the */
231 /* exception 'SPICE(UNKNOWNFRAMETYPE)' will be signalled. */
232
233 /* of this routine. */
234
235 /* 3) If the reference frame REF is dynamic, the error */
236 /* SPICE(RECURSIONTOODEEP) will be signaled. */
237
238
239 /* $ Particulars */
240
241 /* This is a low level routine used for determining a chain */
242 /* of state transformation matrices from one frame to another. */
243
244 /* $ Examples */
245
246 /* See FRMCHG. */
247
248 /* $ Restrictions */
249
250 /* 1) SPICE Private routine. */
251
252 /* $ Author_and_Institution */
253
254 /* N.J. Bachman (JPL) */
255 /* W.L. Taber (JPL) */
256
257 /* $ Literature_References */
258
259 /* None. */
260
261 /* $ Version */
262
263 /* - SPICELIB Version 1.0.0, 12-DEC-2004 (NJB) */
264
265 /* Based on SPICELIB Version 3.0.0, 21-JUN-2004 (NJB) */
266
267 /* -& */
268 /* $ Index_Entries */
269
270 /* Find a frame transformation matrix from a specified frame */
271
272 /* -& */
273
274 /* Spicelib Functions */
275
276
277 /* Local Variables */
278
279 s_copy(versn, "2.0.0", (ftnlen)6, (ftnlen)5);
280 *found = FALSE_;
281
282 /* Standard SPICE error handling. */
283
284 if (return_()) {
285 return 0;
286 }
287 chkin_("ZZFRMGT1", (ftnlen)8);
288
289 /* Get all the needed information about this frame. */
290
291 frinfo_(infrm, ¢, &type__, &typeid, found);
292 if (! (*found)) {
293 chkout_("ZZFRMGT1", (ftnlen)8);
294 return 0;
295 }
296 if (type__ == 2) {
297 tisbod_("J2000", &typeid, et, tsipm, (ftnlen)5);
298 invstm_(tsipm, xform);
299 namfrm_("J2000", outfrm, (ftnlen)5);
300 } else if (type__ == 1) {
301 irfrot_(infrm, &c__1, rot);
302 for (i__ = 1; i__ <= 3; ++i__) {
303 for (j = 1; j <= 3; ++j) {
304 xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 :
305 s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)218)] =
306 rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 :
307 s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)218)];
308 xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ?
309 i__1 : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)219)
310 ] = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ?
311 i__2 : s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)219)];
312 xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 :
313 s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)220)] = 0.;
314 xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1
315 : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)221)] =
316 0.;
317 }
318 }
319 *outfrm = 1;
320 } else if (type__ == 3) {
321 ckfxfm_(&typeid, et, xform, outfrm, found);
322 } else if (type__ == 4) {
323 tkfram_(&typeid, rot, outfrm, found);
324 for (i__ = 1; i__ <= 3; ++i__) {
325 for (j = 1; j <= 3; ++j) {
326 xform[(i__1 = i__ + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 :
327 s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)238)] =
328 rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 :
329 s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)238)];
330 xform[(i__1 = i__ + 3 + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ?
331 i__1 : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)239)
332 ] = rot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ?
333 i__2 : s_rnge("rot", i__2, "zzfrmgt1_", (ftnlen)239)];
334 xform[(i__1 = i__ + 3 + j * 6 - 7) < 36 && 0 <= i__1 ? i__1 :
335 s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)240)] = 0.;
336 xform[(i__1 = i__ + (j + 3) * 6 - 7) < 36 && 0 <= i__1 ? i__1
337 : s_rnge("xform", i__1, "zzfrmgt1_", (ftnlen)241)] =
338 0.;
339 }
340 }
341 } else if (type__ == 5) {
342 setmsg_("The reference frame # is a dynamic frame. Dynamic frames ma"
343 "y not be used at recursion level 1.", (ftnlen)94);
344 errint_("#", infrm, (ftnlen)1);
345 sigerr_("SPICE(RECURSIONTOODEEP)", (ftnlen)23);
346 chkout_("ZZFRMGT1", (ftnlen)8);
347 return 0;
348 } else {
349 setmsg_("The reference frame # has class id-code #. This form of ref"
350 "erence frame is not supported in version # of ZZFRMGT1. You "
351 "need to update your version of SPICELIB to the latest versio"
352 "n in order to support this frame. ", (ftnlen)213);
353 errint_("#", infrm, (ftnlen)1);
354 errint_("#", &type__, (ftnlen)1);
355 errch_("#", versn, (ftnlen)1, (ftnlen)6);
356 sigerr_("SPICE(UNKNOWNFRAMETYPE)", (ftnlen)23);
357 chkout_("ZZFRMGT1", (ftnlen)8);
358 return 0;
359 }
360 if (failed_()) {
361 *found = FALSE_;
362 }
363 chkout_("ZZFRMGT1", (ftnlen)8);
364 return 0;
365 } /* zzfrmgt1_ */
366
367