1 /* zzdynrt0.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__9 = 9;
12 static integer c__36 = 36;
13 static integer c__1 = 1;
14 static integer c__0 = 0;
15 static integer c__3 = 3;
16 static doublereal c_b190 = 0.;
17 static integer c__6 = 6;
18 static doublereal c_b356 = 1.;
19 static integer c__20 = 20;
20
21 /* $Procedure ZZDYNRT0 ( Dynamic position transformation evaluation ) */
zzdynrt0_(integer * infram,integer * center,doublereal * et,doublereal * rotate,integer * basfrm)22 /* Subroutine */ int zzdynrt0_(integer *infram, integer *center, doublereal *
23 et, doublereal *rotate, integer *basfrm)
24 {
25 /* Initialized data */
26
27 static char axes[1*3] = "X" "Y" "Z";
28 static logical first = TRUE_;
29 static char itmcof[32*3] = "ANGLE_1_COEFFS " "ANGLE_2_C"
30 "OEFFS " "ANGLE_3_COEFFS ";
31 static char itmsep[32] = "ANGLE_SEP_TOL ";
32 static char vname[4*2] = "PRI_" "SEC_";
33
34 /* System generated locals */
35 address a__1[2];
36 integer i__1, i__2, i__3[2];
37
38 /* Builtin functions */
39 integer s_rnge(char *, integer, char *, integer);
40 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
41 integer s_cmp(char *, char *, ftnlen, ftnlen);
42 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
43 double sin(doublereal);
44
45 /* Local variables */
46 extern /* Subroutine */ int zzrefch1_(integer *, integer *, doublereal *,
47 doublereal *);
48 doublereal dmob;
49 integer degs[3], frid;
50 char spec[80];
51 integer targ;
52 doublereal oblr[9] /* was [3][3] */;
53 extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
54 doublereal pobs[3];
55 integer axis[2];
56 extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *,
57 doublereal *, ftnlen);
58 doublereal tipm[9] /* was [3][3] */, vflt;
59 extern doublereal vsep_(doublereal *, doublereal *);
60 doublereal rinv[9] /* was [3][3] */;
61 extern /* Subroutine */ int zzspkez1_(integer *, doublereal *, char *,
62 char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen),
63 vsub_(doublereal *, doublereal *, doublereal *), vequ_(doublereal
64 *, doublereal *);
65 doublereal poly[2], rnut[9] /* was [3][3] */;
66 extern /* Subroutine */ int zzspkzp1_(integer *, doublereal *, char *,
67 char *, integer *, doublereal *, doublereal *, ftnlen, ftnlen),
68 zzdynbid_(char *, integer *, char *, integer *, ftnlen, ftnlen),
69 zzdynfid_(char *, integer *, char *, integer *, ftnlen, ftnlen),
70 zzdynoad_(char *, integer *, char *, integer *, integer *,
71 doublereal *, logical *, ftnlen, ftnlen), zzdynoac_(char *,
72 integer *, char *, integer *, integer *, char *, logical *,
73 ftnlen, ftnlen, ftnlen), eul2m_(doublereal *, doublereal *,
74 doublereal *, integer *, integer *, integer *, doublereal *),
75 zzcorepc_(char *, doublereal *, doublereal *, doublereal *,
76 ftnlen), zzmobliq_(doublereal *, doublereal *, doublereal *),
77 zzdynvac_(char *, integer *, char *, integer *, integer *, char *,
78 ftnlen, ftnlen, ftnlen), zzdynvad_(char *, integer *, char *,
79 integer *, integer *, doublereal *, ftnlen, ftnlen), zzdynvai_(
80 char *, integer *, char *, integer *, integer *, integer *,
81 ftnlen, ftnlen);
82 integer i__;
83 extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen);
84 integer n, frcid;
85 doublereal radii[3], delta;
86 extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
87 char *, ftnlen);
88 doublereal epoch;
89 extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
90 static integer earth;
91 extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
92 doublereal pnear[3];
93 integer frcls, iaxes[3];
94 doublereal rprec[9] /* was [3][3] */;
95 static char itmra[32*2];
96 integer cvobs, frctr;
97 extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
98 errdp_(char *, doublereal *, ftnlen);
99 doublereal ptemp[3], rtemp[9] /* was [3][3] */, stemp[6], stobs[6];
100 extern logical eqstr_(char *, char *, ftnlen, ftnlen);
101 extern /* Subroutine */ int xpose_(doublereal *, doublereal *);
102 char units[80];
103 doublereal nutxf[36] /* was [6][6] */, t0;
104 extern /* Subroutine */ int bodn2c_(char *, integer *, logical *, ftnlen);
105 doublereal v2[6] /* was [3][2] */;
106 extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
107 doublereal ra;
108 extern logical failed_(void);
109 logical meanec;
110 extern /* Subroutine */ int cleard_(integer *, doublereal *);
111 char vecdef[80*2];
112 static char itmabc[32*2];
113 char basnam[32];
114 doublereal lt;
115 logical negate;
116 static char itmdec[32*2];
117 doublereal coeffs[60] /* was [20][3] */;
118 char inname__[32], abcorr[5], axname[80];
119 extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
120 extern logical return_(void);
121 char cfrmnm[32], ctrnam[36], cvcorr[5], dynstl[80], dynfam[80];
122 static char itmaxe[32*2], itmfrm[32*2], itmlat[32*2], itmlon[32*2],
123 itmobs[32*2], itmspc[32*2], itmtrg[32*2], itmunt[32*2], itmvdf[32*
124 2], itmvec[32*2];
125 char nutmod[80], oblmod[80], prcmod[80], rotsta[80], timstr[50], tmpfam[
126 80], velfrm[32];
127 doublereal angles[2], ctrpos[3], dec, dirvec[3], eulang[3], alt, fet, lat,
128 minsep, mob, precxf[36] /* was [6][6] */, r2000[9] /*
129 was [3][3] */, sep, lon;
130 integer cfrmid;
131 static integer j2000;
132 integer obs;
133 logical corblk[15];
134 doublereal vet;
135 logical fnd, frozen, meaneq, ofdate, trueeq;
136 extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), frmnam_(
137 integer *, char *, ftnlen), chkout_(char *, ftnlen), cmprss_(char
138 *, integer *, char *, char *, ftnlen, ftnlen, ftnlen), setmsg_(
139 char *, ftnlen), sigerr_(char *, ftnlen), intstr_(integer *, char
140 *, ftnlen), mxm_(doublereal *, doublereal *, doublereal *),
141 errint_(char *, integer *, ftnlen), frinfo_(integer *, integer *,
142 integer *, integer *, logical *), mxv_(doublereal *, doublereal *,
143 doublereal *), cidfrm_(integer *, integer *, char *, logical *,
144 ftnlen), bodvcd_(integer *, char *, integer *, integer *,
145 doublereal *, ftnlen), vminus_(doublereal *, doublereal *),
146 nearpt_(doublereal *, doublereal *, doublereal *, doublereal *,
147 doublereal *, doublereal *), convrt_(doublereal *, char *, char *,
148 doublereal *, ftnlen, ftnlen), latrec_(doublereal *, doublereal *
149 , doublereal *, doublereal *), stlabx_(doublereal *, doublereal *,
150 doublereal *), stelab_(doublereal *, doublereal *, doublereal *),
151 twovec_(doublereal *, integer *, doublereal *, integer *,
152 doublereal *), polyds_(doublereal *, integer *, integer *,
153 doublereal *, doublereal *), zzeprc76_(doublereal *, doublereal *)
154 , zzenut80_(doublereal *, doublereal *);
155
156 /* $ Abstract */
157
158 /* SPICE Private routine intended solely for the support of SPICE */
159 /* routines. Users should not call this routine directly due */
160 /* to the volatile nature of this routine. */
161
162 /* For a specified dynamic frame, find the rotation that maps */
163 /* positions from the dynamic frame to its base frame. */
164
165 /* $ Disclaimer */
166
167 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
168 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
169 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
170 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
171 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
172 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
173 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
174 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
175 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
176 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
177
178 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
179 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
180 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
181 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
182 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
183 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
184
185 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
186 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
187 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
188 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
189
190 /* $ Required_Reading */
191
192 /* CK */
193 /* FRAMES */
194 /* PCK */
195 /* SPK */
196
197 /* $ Keywords */
198
199 /* FRAMES */
200 /* PRIVATE */
201
202 /* $ Declarations */
203 /* $ Abstract */
204
205 /* The parameters below form an enumerated list of the recognized */
206 /* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
207 /* are outlined below. */
208
209 /* $ Disclaimer */
210
211 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
212 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
213 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
214 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
215 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
216 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
217 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
218 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
219 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
220 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
221
222 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
223 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
224 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
225 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
226 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
227 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
228
229 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
230 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
231 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
232 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
233
234 /* $ Parameters */
235
236 /* INERTL an inertial frame that is listed in the routine */
237 /* CHGIRF and that requires no external file to */
238 /* compute the transformation from or to any other */
239 /* inertial frame. */
240
241 /* PCK is a frame that is specified relative to some */
242 /* INERTL frame and that has an IAU model that */
243 /* may be retrieved from the PCK system via a call */
244 /* to the routine TISBOD. */
245
246 /* CK is a frame defined by a C-kernel. */
247
248 /* TK is a "text kernel" frame. These frames are offset */
249 /* from their associated "relative" frames by a */
250 /* constant rotation. */
251
252 /* DYN is a "dynamic" frame. These currently are */
253 /* parameterized, built-in frames where the full frame */
254 /* definition depends on parameters supplied via a */
255 /* frame kernel. */
256
257 /* ALL indicates any of the above classes. This parameter */
258 /* is used in APIs that fetch information about frames */
259 /* of a specified class. */
260
261
262 /* $ Author_and_Institution */
263
264 /* N.J. Bachman (JPL) */
265 /* W.L. Taber (JPL) */
266
267 /* $ Literature_References */
268
269 /* None. */
270
271 /* $ Version */
272
273 /* - SPICELIB Version 4.0.0, 08-MAY-2012 (NJB) */
274
275 /* The parameter ALL was added to support frame fetch APIs. */
276
277 /* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
278
279 /* The parameter DYN was added to support the dynamic frame class. */
280
281 /* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
282
283 /* Various unused frames types were removed and the */
284 /* frame time TK was added. */
285
286 /* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
287
288 /* -& */
289
290 /* End of INCLUDE file frmtyp.inc */
291
292 /* $ Abstract */
293
294 /* Include file zzabcorr.inc */
295
296 /* SPICE private file intended solely for the support of SPICE */
297 /* routines. Users should not include this file directly due */
298 /* to the volatile nature of this file */
299
300 /* The parameters below define the structure of an aberration */
301 /* correction attribute block. */
302
303 /* $ Disclaimer */
304
305 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
306 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
307 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
308 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
309 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
310 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
311 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
312 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
313 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
314 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
315
316 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
317 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
318 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
319 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
320 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
321 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
322
323 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
324 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
325 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
326 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
327
328 /* $ Parameters */
329
330 /* An aberration correction attribute block is an array of logical */
331 /* flags indicating the attributes of the aberration correction */
332 /* specified by an aberration correction string. The attributes */
333 /* are: */
334
335 /* - Is the correction "geometric"? */
336
337 /* - Is light time correction indicated? */
338
339 /* - Is stellar aberration correction indicated? */
340
341 /* - Is the light time correction of the "converged */
342 /* Newtonian" variety? */
343
344 /* - Is the correction for the transmission case? */
345
346 /* - Is the correction relativistic? */
347
348 /* The parameters defining the structure of the block are as */
349 /* follows: */
350
351 /* NABCOR Number of aberration correction choices. */
352
353 /* ABATSZ Number of elements in the aberration correction */
354 /* block. */
355
356 /* GEOIDX Index in block of geometric correction flag. */
357
358 /* LTIDX Index of light time flag. */
359
360 /* STLIDX Index of stellar aberration flag. */
361
362 /* CNVIDX Index of converged Newtonian flag. */
363
364 /* XMTIDX Index of transmission flag. */
365
366 /* RELIDX Index of relativistic flag. */
367
368 /* The following parameter is not required to define the block */
369 /* structure, but it is convenient to include it here: */
370
371 /* CORLEN The maximum string length required by any aberration */
372 /* correction string */
373
374 /* $ Author_and_Institution */
375
376 /* N.J. Bachman (JPL) */
377
378 /* $ Literature_References */
379
380 /* None. */
381
382 /* $ Version */
383
384 /* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
385
386 /* -& */
387 /* Number of aberration correction choices: */
388
389
390 /* Aberration correction attribute block size */
391 /* (number of aberration correction attributes): */
392
393
394 /* Indices of attributes within an aberration correction */
395 /* attribute block: */
396
397
398 /* Maximum length of an aberration correction string: */
399
400
401 /* End of include file zzabcorr.inc */
402
403 /* $ Abstract */
404
405 /* Include file zzdyn.inc */
406
407 /* SPICE private file intended solely for the support of SPICE */
408 /* routines. Users should not include this file directly due */
409 /* to the volatile nature of this file */
410
411 /* The parameters defined below are used by the SPICELIB dynamic */
412 /* frame subsystem. */
413
414 /* $ Disclaimer */
415
416 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
417 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
418 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
419 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
420 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
421 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
422 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
423 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
424 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
425 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
426
427 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
428 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
429 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
430 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
431 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
432 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
433
434 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
435 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
436 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
437 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
438
439 /* $ Parameters */
440
441 /* This file declares parameters required by the dynamic */
442 /* frame routines of the SPICELIB frame subsystem. */
443
444 /* $ Restrictions */
445
446 /* The parameter BDNMLN is this routine must be kept */
447 /* consistent with the parameter MAXL defined in */
448
449 /* zzbodtrn.inc */
450
451
452 /* $ Author_and_Institution */
453
454 /* N.J. Bachman (JPL) */
455
456 /* $ Literature_References */
457
458 /* None. */
459
460 /* $ Version */
461
462 /* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */
463
464 /* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */
465
466 /* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */
467
468 /* -& */
469
470 /* String length parameters */
471 /* ======================== */
472
473
474 /* Kernel variable name length. This parameter must be */
475 /* kept consistent with the parameter MAXLEN used in the */
476 /* POOL umbrella routine. */
477
478
479 /* Length of a character kernel pool datum. This parameter must be */
480 /* kept consistent with the parameter MAXCHR used in the POOL */
481 /* umbrella routine. */
482
483
484 /* Reference frame name length. This parameter must be */
485 /* kept consistent with the parameter WDSIZE used in the */
486 /* FRAMEX umbrella routine. */
487
488
489 /* Body name length. This parameter is used to provide a level */
490 /* of indirection so the dynamic frame source code doesn't */
491 /* have to change if the name of this SPICELIB-scope parameter */
492 /* is changed. The value MAXL used here is defined in the */
493 /* INCLUDE file */
494
495 /* zzbodtrn.inc */
496
497 /* Current value of MAXL = 36 */
498
499
500 /* Numeric parameters */
501 /* =================================== */
502
503 /* The parameter MAXCOF is the maximum number of polynomial */
504 /* coefficients that may be used to define an Euler angle */
505 /* in an "Euler frame" definition */
506
507
508 /* The parameter LBSEP is the default angular separation limit for */
509 /* the vectors defining a two-vector frame. The angular separation */
510 /* of the vectors must differ from Pi and 0 by at least this amount. */
511
512
513 /* The parameter QEXP is used to determine the width of */
514 /* the interval DELTA used for the discrete differentiation */
515 /* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */
516 /* recursive analogs. This parameter is appropriate for */
517 /* 64-bit IEEE double precision numbers; when SPICELIB */
518 /* is hosted on platforms where longer mantissas are supported, */
519 /* this parameter (and hence this INCLUDE file) will become */
520 /* platform-dependent. */
521
522 /* The choice of QEXP is based on heuristics. It's believed to */
523 /* be a reasonable choice obtainable without expensive computation. */
524
525 /* QEXP is the largest power of 2 such that */
526
527 /* 1.D0 + 2**QEXP = 1.D0 */
528
529 /* Given an epoch T0 at which a discrete derivative is to be */
530 /* computed, this choice provides a value of DELTA that usually */
531 /* contributes no round-off error in the computation of the function */
532 /* evaluation epochs */
533
534 /* T0 +/- DELTA */
535
536 /* while providing the largest value of DELTA having this form that */
537 /* causes the order of the error term O(DELTA**2) in the quadratric */
538 /* function approximation to round to zero. Note that the error */
539 /* itself will normally be small but doesn't necessarily round to */
540 /* zero. Note also that the small function approximation error */
541 /* is not a measurement of the error in the discrete derivative */
542 /* itself. */
543
544 /* For ET values T0 > 2**27 seconds past J2000, the value of */
545 /* DELTA will be set to */
546
547 /* T0 * 2**QEXP */
548
549 /* For smaller values of T0, DELTA should be set to 1.D0. */
550
551
552 /* Frame kernel parameters */
553 /* ======================= */
554
555 /* Parameters relating to kernel variable names (keywords) start */
556 /* with the letters */
557
558 /* KW */
559
560 /* Parameters relating to kernel variable values start with the */
561 /* letters */
562
563 /* KV */
564
565
566 /* Generic parameters */
567 /* --------------------------------- */
568
569 /* Token used to build the base frame keyword: */
570
571
572 /* Frame definition style parameters */
573 /* --------------------------------- */
574
575 /* Token used to build the frame definition style keyword: */
576
577
578 /* Token indicating parameterized dynamic frame. */
579
580
581 /* Freeze epoch parameters */
582 /* --------------------------------- */
583
584 /* Token used to build the freeze epoch keyword: */
585
586
587 /* Rotation state parameters */
588 /* --------------------------------- */
589
590 /* Token used to build the rotation state keyword: */
591
592
593 /* Token indicating rotating rotation state: */
594
595
596 /* Token indicating inertial rotation state: */
597
598
599 /* Frame family parameters */
600 /* --------------------------------- */
601
602 /* Token used to build the frame family keyword: */
603
604
605 /* Token indicating mean equator and equinox of date frame. */
606
607
608 /* Token indicating mean ecliptic and equinox of date frame. */
609
610
611 /* Token indicating true equator and equinox of date frame. */
612
613
614 /* Token indicating two-vector frame. */
615
616
617 /* Token indicating Euler frame. */
618
619
620 /* "Of date" frame family parameters */
621 /* --------------------------------- */
622
623 /* Token used to build the precession model keyword: */
624
625
626 /* Token used to build the nutation model keyword: */
627
628
629 /* Token used to build the obliquity model keyword: */
630
631
632 /* Mathematical models used to define "of date" frames will */
633 /* likely accrue over time. We will simply assign them */
634 /* numbers. */
635
636
637 /* Token indicating the Lieske earth precession model: */
638
639
640 /* Token indicating the IAU 1980 earth nutation model: */
641
642
643 /* Token indicating the IAU 1980 earth mean obliqity of */
644 /* date model. Note the name matches that of the preceding */
645 /* nutation model---this is intentional. The keyword */
646 /* used in the kernel variable definition indicates what */
647 /* kind of model is being defined. */
648
649
650 /* Two-vector frame family parameters */
651 /* --------------------------------- */
652
653 /* Token used to build the vector axis keyword: */
654
655
656 /* Tokens indicating axis values: */
657
658
659 /* Prefixes used for primary and secondary vector definition */
660 /* keywords: */
661
662
663 /* Token used to build the vector definition keyword: */
664
665
666 /* Token indicating observer-target position vector: */
667
668
669 /* Token indicating observer-target velocity vector: */
670
671
672 /* Token indicating observer-target near point vector: */
673
674
675 /* Token indicating constant vector: */
676
677
678 /* Token used to build the vector observer keyword: */
679
680
681 /* Token used to build the vector target keyword: */
682
683
684 /* Token used to build the vector frame keyword: */
685
686
687 /* Token used to build the vector aberration correction keyword: */
688
689
690 /* Token used to build the constant vector specification keyword: */
691
692
693 /* Token indicating rectangular coordinates used to */
694 /* specify constant vector: */
695
696
697 /* Token indicating latitudinal coordinates used to */
698 /* specify constant vector: */
699
700
701 /* Token indicating RA/DEC coordinates used to */
702 /* specify constant vector: */
703
704
705 /* Token used to build the cartesian vector literal keyword: */
706
707
708 /* Token used to build the constant vector latitude keyword: */
709
710
711 /* Token used to build the constant vector longitude keyword: */
712
713
714 /* Token used to build the constant vector right ascension keyword: */
715
716
717 /* Token used to build the constant vector declination keyword: */
718
719
720 /* Token used to build the angular separation tolerance keyword: */
721
722
723 /* See the section "Physical unit parameters" below for additional */
724 /* parameters applicable to two-vector frames. */
725
726
727 /* Euler frame family parameters */
728 /* --------------------------------- */
729
730 /* Token used to build the epoch keyword: */
731
732
733 /* Token used to build the Euler axis sequence keyword: */
734
735
736 /* Tokens used to build the Euler angle coefficients keywords: */
737
738
739 /* See the section "Physical unit parameters" below for additional */
740 /* parameters applicable to Euler frames. */
741
742
743 /* Physical unit parameters */
744 /* --------------------------------- */
745
746 /* Token used to build the units keyword: */
747
748
749 /* Token indicating radians: */
750
751
752 /* Token indicating degrees: */
753
754
755 /* End of include file zzdyn.inc */
756
757 /* $ Brief_I/O */
758
759 /* VARIABLE I/O DESCRIPTION */
760 /* -------- --- -------------------------------------------------- */
761 /* INFRAM I Class ID code for a SPICE dynamic reference frame. */
762 /* CENTER I ID code for the center of the input frame. */
763 /* ET I An epoch in seconds past J2000 TDB. */
764 /* ROTATE O The requested rotation matrix. */
765 /* BASFRM O Frame ID of base frame associated with INFRAM. */
766
767 /* $ Detailed_Input */
768
769 /* INFRAM is the frame ID code for a dynamic reference frame. */
770 /* Note that this interface differs from that of TKFRAM, */
771 /* which uses a class ID to identify the frame. */
772
773 /* In this routine, we refer this frame both as the */
774 /* "input frame" and the "defined frame." */
775
776 /* CENTER is NAIF ID code for the center of the frame */
777 /* designated by INFRAM. This code, although derivable */
778 /* from INFRAM, is passed in for convenience. */
779
780 /* ET is an epoch in ephemeris seconds past J2000 for which */
781 /* the caller requests a rotation matrix. */
782
783 /* $ Detailed_Output */
784
785 /* ROTATE is a 3x3 rotation matrix that transforms positions */
786 /* relative to INFRAM to positions relative to BASFRM. */
787
788 /* BASFRM is the frame ID code of the base frame associated */
789 /* with INFRAM. The 3x3 matrix ROTATE transforms */
790 /* positions relative to INFRAM to positions relative to */
791 /* BASFRM. The position transformation is performed by */
792 /* left-multiplying by ROTATE a position expressed */
793 /* relative to INFRAM. This is easily accomplished via */
794 /* the subroutine call shown below. */
795
796 /* CALL MXV ( ROTATE, INPOS, OUTPOS ) */
797
798 /* $ Parameters */
799
800 /* See include file zzdyn.inc. */
801
802 /* $ Files */
803
804 /* 1) SPK files containing data for each observer and target */
805 /* are required to support two-vector frames. Note that */
806 /* observer-target pairs can be implicit, as in the case */
807 /* of a constant vector whose frame is evaluated at a */
808 /* light-time corrected epoch: the light time the frame */
809 /* center to an observer must be computable in this case, */
810 /* which implies the state of the frame center as seen by */
811 /* the observer must be computable. */
812
813 /* 2) Any of SPK, CK, PCK, and frame kernels will also be required */
814 /* if any frames referenced in the definition of INFRAM (as a */
815 /* base frame, velocity vector frame, or constant vector frame) */
816 /* require them, or if any vectors used to define INFRAM require */
817 /* these data in order to be computable. */
818
819 /* 3) When CK data are required, one or more associated SCLK kernels */
820 /* ---normally, one kernel per spacecraft clock---are */
821 /* required as well. A leapseconds kernel may be required */
822 /* whenever an SCLK kernel is required. */
823
824 /* 4) When a two-vector frame is defined using a target near point, */
825 /* a PCK file giving orientation and providing a triaxial shape */
826 /* model for the target body is required. */
827
828
829 /* $ Exceptions */
830
831 /* 1) If a dynamic frame evaluation requires unavailable kernel */
832 /* data, the error will be diagnosed by routines in the */
833 /* call tree of this routine. */
834
835 /* 2) If a precession model is used to implement a frame centered */
836 /* at a body for which the model is not applicable, the error */
837 /* SPICE(INVALIDSELECTION) will be signaled. */
838
839 /* 3) If a nutation model is used to implement a frame centered */
840 /* at a body for which the model is not applicable, the error */
841 /* SPICE(INVALIDSELECTION) will be signaled. */
842
843 /* 4) If an obliquity model is used to implement a frame centered */
844 /* at a body for which the model is not applicable, the error */
845 /* SPICE(INVALIDSELECTION) will be signaled. */
846
847 /* 5) If an unrecognized precession model is specified, the */
848 /* error SPICE(NOTSUPPORTED) is signaled. */
849
850 /* 6) If an unrecognized nutation model is specified, the */
851 /* error SPICE(NOTSUPPORTED) is signaled. */
852
853 /* 7) If an unrecognized obliquity model is specified, the */
854 /* error SPICE(NOTSUPPORTED) is signaled. */
855
856 /* 8) If an attempt to look up the center of a frame does */
857 /* not yield data, the error SPICE(FRAMEDATANOTFOUND) is */
858 /* signaled. */
859
860 /* 9) In a two-vector frame definition, if a constant vector */
861 /* specification method is not recognized, the error */
862 /* SPICE(NOTSUPPORTED) is signaled. */
863
864 /* 10) In a two-vector frame definition, if a vector definition */
865 /* method is not recognized, the error SPICE(NOTSUPPORTED) */
866 /* is signaled. */
867
868 /* 11) If an unrecognized dynamic frame family is specified, the */
869 /* error SPICE(NOTSUPPORTED) is signaled. */
870
871 /* 12) If an unrecognized dynamic frame definition style is */
872 /* specified, the error SPICE(NOTSUPPORTED) is signaled. */
873
874 /* 13) If an unrecognized dynamic frame rotation state is */
875 /* specified, the error SPICE(NOTSUPPORTED) is signaled. */
876
877 /* 14) If both a freeze epoch and a rotation state are specified, */
878 /* the error SPICE(FRAMEDEFERROR) is signaled. */
879
880 /* 15) If neither a freeze epoch nor a rotation state are specified */
881 /* for an "of date" frame, the error SPICE(FRAMEDEFERROR) is */
882 /* signaled. */
883
884 /* 16) In a two-vector frame definition, if an invalid axis */
885 /* specification is encountered, the error SPICE(INVALIDAXIS) is */
886 /* signaled. */
887
888 /* 17) In a two-vector frame definition using a target near point */
889 /* vector, if the body-fixed frame associated with the target */
890 /* is not found, the error SPICE(FRAMEDATANOTFOUND) is signaled. */
891
892 /* 18) If a dynamic frame evaluation requires excessive recursion */
893 /* depth, the error will be diagnosed by routines in the call */
894 /* tree of this routine. */
895
896 /* 19) When a two-vector dynamic frame is evaluated, if the */
897 /* primary and secondary vectors have angular separation less */
898 /* than the minimum allowed value, or if the angular separation */
899 /* differs from Pi by less than the minimum allowed value, the */
900 /* error SPICE(DEGENERATECASE) is signaled. The default minimum */
901 /* separation is given by the parameter LBSEP; this value may be */
902 /* overridden by supplying a different value in the frame */
903 /* definition. */
904
905 /* 20) If invalid units occur in a frame definition, the error */
906 /* will be diagnosed by a routine in the call tree of this */
907 /* routine. */
908
909 /* 21) If an invalid Euler axis sequence occurs in a frame */
910 /* definition, the error will be diagnosed by a routine in the */
911 /* call tree of this routine. */
912
913 /* $ Particulars */
914
915 /* Currently only parameterized dynamic frames are supported by */
916 /* this routine. */
917
918 /* Currently supported parameterized dynamic families are: */
919
920 /* Two-vector */
921 /* ========== */
922
923 /* Vector definitions */
924 /* ------------------ */
925 /* Observer-target position */
926 /* Observer-target velocity */
927 /* Near point on target */
928 /* Constant vector in specified frame */
929
930
931 /* Mean Equator and Equinox of Date */
932 /* ================================ */
933
934 /* Bodies and models */
935 /* ----------------- */
936 /* Earth: 1976 IAU precession model */
937
938
939 /* Mean Ecliptic and Equinox of Date */
940 /* ================================ */
941
942 /* Bodies and models */
943 /* ----------------- */
944 /* Earth: 1976 IAU precession model */
945 /* 1980 IAU mean obliquity model */
946
947
948 /* True Equator and Equinox of Date */
949 /* ================================ */
950
951 /* Bodies and models */
952 /* ----------------- */
953 /* Earth: 1976 IAU precession model */
954 /* 1980 IAU nutation model */
955
956
957 /* Euler frames */
958 /* ============ */
959
960 /* Euler angle definitions */
961 /* ----------------------- */
962 /* Polynomial */
963
964
965 /* $ Examples */
966
967 /* See ROTGET. */
968
969 /* $ Restrictions */
970
971 /* 1) This is a SPICE private routine; the routine is subject */
972 /* to change without notice. User applications should not */
973 /* call this routine. */
974
975 /* 2) Many numerical problems can occur when dynamic frames */
976 /* are evaluated. Users must determine whether dynamic frame */
977 /* definitions are suitable for their applications. See the */
978 /* Exceptions section for a list of possible problems. */
979
980 /* 3) Two-vector frame definitions can suffer extreme loss of */
981 /* precision due to near-singular geometry. */
982
983 /* $ Author_and_Institution */
984
985 /* N.J. Bachman (JPL) */
986
987 /* $ Literature_References */
988
989 /* None. */
990
991 /* $ Version */
992
993 /* - SPICELIB Version 1.1.0, 24-OCT-2005 (NJB) */
994
995 /* Parameters KWX, KWY, KWZ were renamed to KVX, KVY, KVZ. */
996
997 /* Call to ZZBODVCD was replaced with call to BODVCD. */
998
999 /* - SPICELIB Version 1.0.0, 10-JAN-2005 (NJB) */
1000
1001 /* -& */
1002
1003 /* SPICELIB functions */
1004
1005
1006 /* Local parameters */
1007
1008
1009 /* Local variables */
1010
1011
1012 /* Saved variables */
1013
1014
1015 /* Initial values */
1016
1017 if (return_()) {
1018 return 0;
1019 }
1020 chkin_("ZZDYNRT0", (ftnlen)8);
1021 if (first) {
1022
1023 /* Get the ID code for the J2000 frame. */
1024
1025 irfnum_("J2000", &j2000, (ftnlen)5);
1026
1027 /* Get the ID code for the earth (we needn't check the found */
1028 /* flag). */
1029
1030 bodn2c_("EARTH", &earth, &fnd, (ftnlen)5);
1031
1032 /* Initialize "item" strings used to create kernel variable */
1033 /* names. */
1034
1035 for (i__ = 1; i__ <= 2; ++i__) {
1036
1037 /* Vector axis: */
1038
1039 /* Writing concatenation */
1040 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1041 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1042 502)) << 2);
1043 i__3[1] = 4, a__1[1] = "AXIS";
1044 s_cat(itmaxe + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1045 s_rnge("itmaxe", i__1, "zzdynrt0_", (ftnlen)502)) << 5),
1046 a__1, i__3, &c__2, (ftnlen)32);
1047
1048 /* Vector definition: */
1049
1050 /* Writing concatenation */
1051 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1052 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1053 506)) << 2);
1054 i__3[1] = 10, a__1[1] = "VECTOR_DEF";
1055 s_cat(itmvdf + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1056 s_rnge("itmvdf", i__1, "zzdynrt0_", (ftnlen)506)) << 5),
1057 a__1, i__3, &c__2, (ftnlen)32);
1058
1059 /* Vector aberration correction: */
1060
1061 /* Writing concatenation */
1062 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1063 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1064 510)) << 2);
1065 i__3[1] = 6, a__1[1] = "ABCORR";
1066 s_cat(itmabc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1067 s_rnge("itmabc", i__1, "zzdynrt0_", (ftnlen)510)) << 5),
1068 a__1, i__3, &c__2, (ftnlen)32);
1069
1070 /* Vector frame: */
1071
1072 /* Writing concatenation */
1073 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1074 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1075 514)) << 2);
1076 i__3[1] = 5, a__1[1] = "FRAME";
1077 s_cat(itmfrm + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1078 s_rnge("itmfrm", i__1, "zzdynrt0_", (ftnlen)514)) << 5),
1079 a__1, i__3, &c__2, (ftnlen)32);
1080
1081 /* Vector observer: */
1082
1083 /* Writing concatenation */
1084 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1085 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1086 518)) << 2);
1087 i__3[1] = 8, a__1[1] = "OBSERVER";
1088 s_cat(itmobs + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1089 s_rnge("itmobs", i__1, "zzdynrt0_", (ftnlen)518)) << 5),
1090 a__1, i__3, &c__2, (ftnlen)32);
1091
1092 /* Vector target: */
1093
1094 /* Writing concatenation */
1095 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1096 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1097 522)) << 2);
1098 i__3[1] = 6, a__1[1] = "TARGET";
1099 s_cat(itmtrg + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1100 s_rnge("itmtrg", i__1, "zzdynrt0_", (ftnlen)522)) << 5),
1101 a__1, i__3, &c__2, (ftnlen)32);
1102
1103 /* Vector longitude: */
1104
1105 /* Writing concatenation */
1106 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1107 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1108 526)) << 2);
1109 i__3[1] = 9, a__1[1] = "LONGITUDE";
1110 s_cat(itmlon + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1111 s_rnge("itmlon", i__1, "zzdynrt0_", (ftnlen)526)) << 5),
1112 a__1, i__3, &c__2, (ftnlen)32);
1113
1114 /* Vector latitude: */
1115
1116 /* Writing concatenation */
1117 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1118 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1119 530)) << 2);
1120 i__3[1] = 8, a__1[1] = "LATITUDE";
1121 s_cat(itmlat + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1122 s_rnge("itmlat", i__1, "zzdynrt0_", (ftnlen)530)) << 5),
1123 a__1, i__3, &c__2, (ftnlen)32);
1124
1125 /* Vector right ascension: */
1126
1127 /* Writing concatenation */
1128 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1129 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1130 534)) << 2);
1131 i__3[1] = 2, a__1[1] = "RA";
1132 s_cat(itmra + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
1133 "itmra", i__1, "zzdynrt0_", (ftnlen)534)) << 5), a__1,
1134 i__3, &c__2, (ftnlen)32);
1135
1136 /* Vector declination: */
1137
1138 /* Writing concatenation */
1139 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1140 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1141 538)) << 2);
1142 i__3[1] = 3, a__1[1] = "DEC";
1143 s_cat(itmdec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1144 s_rnge("itmdec", i__1, "zzdynrt0_", (ftnlen)538)) << 5),
1145 a__1, i__3, &c__2, (ftnlen)32);
1146
1147 /* Vector units: */
1148
1149 /* Writing concatenation */
1150 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1151 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1152 542)) << 2);
1153 i__3[1] = 5, a__1[1] = "UNITS";
1154 s_cat(itmunt + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1155 s_rnge("itmunt", i__1, "zzdynrt0_", (ftnlen)542)) << 5),
1156 a__1, i__3, &c__2, (ftnlen)32);
1157
1158 /* Constant vector coordinate specification: */
1159
1160 /* Writing concatenation */
1161 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1162 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1163 546)) << 2);
1164 i__3[1] = 4, a__1[1] = "SPEC";
1165 s_cat(itmspc + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1166 s_rnge("itmspc", i__1, "zzdynrt0_", (ftnlen)546)) << 5),
1167 a__1, i__3, &c__2, (ftnlen)32);
1168
1169 /* Constant vector in cartesian coordinates, literal value: */
1170
1171 /* Writing concatenation */
1172 i__3[0] = 4, a__1[0] = vname + (((i__2 = i__ - 1) < 2 && 0 <=
1173 i__2 ? i__2 : s_rnge("vname", i__2, "zzdynrt0_", (ftnlen)
1174 550)) << 2);
1175 i__3[1] = 6, a__1[1] = "VECTOR";
1176 s_cat(itmvec + (((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1177 s_rnge("itmvec", i__1, "zzdynrt0_", (ftnlen)550)) << 5),
1178 a__1, i__3, &c__2, (ftnlen)32);
1179 }
1180 first = FALSE_;
1181 }
1182
1183 /* Initialize the output arguments. */
1184
1185 cleard_(&c__9, rotate);
1186 *basfrm = 0;
1187
1188 /* Initialize certain variables to ensure that we don't do */
1189 /* arithmetic operations using bogus, possibly large, */
1190 /* undefined values. */
1191
1192 cleard_(&c__36, nutxf);
1193 cleard_(&c__9, oblr);
1194 cleard_(&c__36, precxf);
1195 cleard_(&c__9, r2000);
1196 cleard_(&c__9, rtemp);
1197 cleard_(&c__9, rinv);
1198 cleard_(&c__9, tipm);
1199 mob = 0.;
1200 dmob = 0.;
1201 t0 = 0.;
1202 frozen = FALSE_;
1203
1204 /* Get the input frame name. */
1205
1206 frmnam_(infram, inname__, (ftnlen)32);
1207
1208 /* We need the name of the base frame. */
1209
1210 zzdynfid_(inname__, infram, "RELATIVE", basfrm, (ftnlen)32, (ftnlen)8);
1211 frmnam_(basfrm, basnam, (ftnlen)32);
1212
1213 /* The output frame code and name are set. */
1214
1215 /* Look up the dynamic frame definition style from the kernel pool. */
1216 /* The kernel variable's name might be specified by name or ID. */
1217
1218 zzdynvac_(inname__, infram, "DEF_STYLE", &c__1, &n, dynstl, (ftnlen)32, (
1219 ftnlen)9, (ftnlen)80);
1220 if (failed_()) {
1221 chkout_("ZZDYNRT0", (ftnlen)8);
1222 return 0;
1223 }
1224
1225 /* At this time, the only supported dynamic frame definition style is */
1226 /* PARAMETERIZED. */
1227
1228 if (eqstr_(dynstl, "PARAMETERIZED", (ftnlen)80, (ftnlen)13)) {
1229
1230 /* Parameterized dynamic frames belong to families. Look up */
1231 /* the family for this frame. */
1232
1233 zzdynvac_(inname__, infram, "FAMILY", &c__1, &n, dynfam, (ftnlen)32, (
1234 ftnlen)6, (ftnlen)80);
1235 cmprss_(" ", &c__0, dynfam, tmpfam, (ftnlen)1, (ftnlen)80, (ftnlen)80)
1236 ;
1237 ucase_(tmpfam, dynfam, (ftnlen)80, (ftnlen)80);
1238
1239 /* Determine whether we have an "of-date" frame family. */
1240 /* The logical flags used here and respective meanings are: */
1241
1242 /* MEANEQ Mean equator and equinox of date */
1243 /* TRUEEQ True equator and equinox of date */
1244 /* MEANEC Mean ecliptic and equinox of date */
1245
1246 meaneq = s_cmp(dynfam, "MEAN_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80,
1247 (ftnlen)32) == 0;
1248 trueeq = s_cmp(dynfam, "TRUE_EQUATOR_AND_EQUINOX_OF_DATE", (ftnlen)80,
1249 (ftnlen)32) == 0;
1250 meanec = s_cmp(dynfam, "MEAN_ECLIPTIC_AND_EQUINOX_OF_DATE", (ftnlen)
1251 80, (ftnlen)33) == 0;
1252 ofdate = meaneq || meanec || trueeq;
1253
1254 /* Set the evaluation epoch T0. Normally this epoch is ET, */
1255 /* but if the frame is frozen, the freeze epoch from the */
1256 /* frame definition is used. */
1257
1258 /* Read the freeze epoch into T0 if a freeze epoch was */
1259 /* specified; let FROZEN receive the FOUND flag value */
1260 /* returned by ZZDYNOAD. */
1261
1262 zzdynoad_(inname__, infram, "FREEZE_EPOCH", &c__1, &n, &t0, &frozen, (
1263 ftnlen)32, (ftnlen)12);
1264 if (! frozen) {
1265
1266 /* Normal case: just use the input epoch. */
1267
1268 t0 = *et;
1269 }
1270
1271 /* Look up the rotation state keyword. In this routine, */
1272 /* the rotation state keyword is examined only to support */
1273 /* semantic checking: there's no use made of the fact that */
1274 /* the rotation state is 'ROTATING' or 'INERTIAL'. */
1275
1276 zzdynoac_(inname__, infram, "ROTATION_STATE", &c__1, &n, rotsta, &fnd,
1277 (ftnlen)32, (ftnlen)14, (ftnlen)80);
1278 if (fnd) {
1279
1280 /* Catch invalid rotation states here. */
1281
1282 if (! eqstr_(rotsta, "ROTATING", (ftnlen)80, (ftnlen)8) && !
1283 eqstr_(rotsta, "INERTIAL", (ftnlen)80, (ftnlen)8)) {
1284 setmsg_("Definition of frame # contains # specification #. T"
1285 "he only valid rotation states are # or #. This situa"
1286 "tion is usually caused by an error in a frame kernel"
1287 " in which the frame is defined.", (ftnlen)186);
1288 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1289 errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14);
1290 errch_("#", rotsta, (ftnlen)1, (ftnlen)80);
1291 errch_("#", "ROTATING", (ftnlen)1, (ftnlen)8);
1292 errch_("#", "INERTIAL", (ftnlen)1, (ftnlen)8);
1293 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
1294 chkout_("ZZDYNRT0", (ftnlen)8);
1295 return 0;
1296 }
1297 }
1298
1299
1300 /* If the frame is frozen, the rotation state keyword *must be */
1301 /* absent*. */
1302
1303 if (frozen && fnd) {
1304 setmsg_("Definition of frame # contains both # and # keywords; a"
1305 "t most one of these must be present in the frame definit"
1306 "ion. This situation is usually caused by an error in a f"
1307 "rame kernel in which the frame is defined.", (ftnlen)209);
1308 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1309 errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12);
1310 errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14);
1311 sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20);
1312 chkout_("ZZDYNRT0", (ftnlen)8);
1313 return 0;
1314 }
1315
1316 /* If the frame belongs to an "of date" family, either the */
1317 /* rotation state must be specified or the frame must be */
1318 /* frozen. */
1319
1320 if (ofdate && ! frozen && ! fnd) {
1321 setmsg_("Definition of frame #, which belongs to parameterized d"
1322 "ynamic frame family #, contains neither # nor # keywords"
1323 "; frames in this family require exactly one of these in "
1324 "their frame definitions. This situation is usually cause"
1325 "d by an error in a frame kernel in which the frame is de"
1326 "fined.", (ftnlen)285);
1327 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1328 errch_("#", dynfam, (ftnlen)1, (ftnlen)80);
1329 errch_("#", "FREEZE_EPOCH", (ftnlen)1, (ftnlen)12);
1330 errch_("#", "ROTATION_STATE", (ftnlen)1, (ftnlen)14);
1331 sigerr_("SPICE(FRAMEDEFERROR)", (ftnlen)20);
1332 chkout_("ZZDYNRT0", (ftnlen)8);
1333 return 0;
1334 }
1335 if (failed_()) {
1336 chkout_("ZZDYNRT0", (ftnlen)8);
1337 return 0;
1338 }
1339
1340 /* The evaluation epoch T0 is set. */
1341
1342 /* In this routine, unlike its companion ZZDYNFRM, there is no */
1343 /* need to make further reference to the rotation state. Hence */
1344 /* the flag INERT used in ZZDYNFRM doesn't appear here. */
1345
1346
1347 /* The following code block performs actions specific to */
1348 /* the various dynamic frame families. */
1349
1350 if (ofdate) {
1351
1352 /* Fetch the name of the true equator and equinox of date */
1353 /* precession model. */
1354
1355 zzdynvac_(inname__, infram, "PREC_MODEL", &c__1, &n, prcmod, (
1356 ftnlen)32, (ftnlen)10, (ftnlen)80);
1357 if (failed_()) {
1358 chkout_("ZZDYNRT0", (ftnlen)8);
1359 return 0;
1360 }
1361
1362 /* Get the precession transformation. */
1363
1364 if (eqstr_(prcmod, "EARTH_IAU_1976", (ftnlen)80, (ftnlen)14)) {
1365
1366 /* This is the 1976 IAU earth precession model. */
1367
1368 /* Make sure the center of the input frame is the earth. */
1369
1370 if (*center != earth) {
1371 bodc2n_(center, ctrnam, &fnd, (ftnlen)36);
1372 if (! fnd) {
1373 intstr_(center, ctrnam, (ftnlen)36);
1374 }
1375 setmsg_("Definition of frame # specifies frame center # "
1376 "and precession model #. This precession model is"
1377 " not applicable to body #. This situation is usu"
1378 "ally caused by an error in a frame kernel in whi"
1379 "ch the frame is defined.", (ftnlen)215);
1380 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1381 errch_("#", ctrnam, (ftnlen)1, (ftnlen)36);
1382 errch_("#", "EARTH_IAU_1976", (ftnlen)1, (ftnlen)14);
1383 errch_("#", ctrnam, (ftnlen)1, (ftnlen)36);
1384 sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23);
1385 chkout_("ZZDYNRT0", (ftnlen)8);
1386 return 0;
1387 }
1388
1389 /* Look up the precession transformation. Extract */
1390 /* the precession rotation matrix. */
1391
1392 zzeprc76_(&t0, precxf);
1393 moved_(precxf, &c__3, rprec);
1394 moved_(&precxf[6], &c__3, &rprec[3]);
1395 moved_(&precxf[12], &c__3, &rprec[6]);
1396
1397 /* If we're in the mean-of-date case, invert this */
1398 /* transformation to obtain the mapping from the */
1399 /* mean-of-date frame to J2000. */
1400
1401 if (meaneq) {
1402 xpose_(rprec, rtemp);
1403 }
1404 } else {
1405 setmsg_("Definition of frame # specifies precession model #,"
1406 " which is not recognized. This situation is usually "
1407 "caused by an error in a frame kernel in which the fr"
1408 "ame is defined.", (ftnlen)170);
1409 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1410 errch_("#", prcmod, (ftnlen)1, (ftnlen)80);
1411 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
1412 chkout_("ZZDYNRT0", (ftnlen)8);
1413 return 0;
1414 }
1415
1416 /* At this point the precession transformation REPREC is set. */
1417 /* If INFRAM is a mean equator and equinox of date frame, the */
1418 /* inverse of REPREC is currently stored in RTEMP. */
1419 if (trueeq) {
1420
1421 /* We need a nutation transformation as well. Get the name */
1422 /* of the nutation model. */
1423
1424 zzdynvac_(inname__, infram, "NUT_MODEL", &c__1, &n, nutmod, (
1425 ftnlen)32, (ftnlen)9, (ftnlen)80);
1426 if (failed_()) {
1427 chkout_("ZZDYNRT0", (ftnlen)8);
1428 return 0;
1429 }
1430
1431 /* Get the nutation transformation. */
1432
1433 if (eqstr_(nutmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14))
1434 {
1435
1436 /* This is the 1980 IAU earth nutation model. */
1437
1438 /* Make sure the center is the earth. */
1439
1440 if (*center != earth) {
1441 bodc2n_(center, ctrnam, &fnd, (ftnlen)36);
1442 if (! fnd) {
1443 intstr_(center, ctrnam, (ftnlen)36);
1444 }
1445 setmsg_("Definition of frame # specifies frame cente"
1446 "r # and nutation model #. This nutation mode"
1447 "l is not applicable to body #. This situati"
1448 "on is usually caused by an error in a frame "
1449 "kernel in which the frame is defined.", (
1450 ftnlen)212);
1451 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1452 errch_("#", ctrnam, (ftnlen)1, (ftnlen)36);
1453 errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14);
1454 errch_("#", ctrnam, (ftnlen)1, (ftnlen)36);
1455 sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23);
1456 chkout_("ZZDYNRT0", (ftnlen)8);
1457 return 0;
1458 }
1459
1460 /* Look up the nutation transformation. Extract */
1461 /* the nutation rotation matrix. */
1462
1463 zzenut80_(&t0, nutxf);
1464 moved_(nutxf, &c__3, rnut);
1465 moved_(&nutxf[6], &c__3, &rnut[3]);
1466 moved_(&nutxf[12], &c__3, &rnut[6]);
1467
1468 /* Find the rotation from the J2000 frame to the earth */
1469 /* true of date frame. Invert. */
1470
1471 mxm_(rnut, rprec, rinv);
1472 xpose_(rinv, rtemp);
1473 } else {
1474 setmsg_("Definition of frame # specifies nutation model "
1475 "#, which is not recognized. This situation is us"
1476 "ually caused by an error in a frame kernel in wh"
1477 "ich the frame is defined.", (ftnlen)168);
1478 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1479 errch_("#", nutmod, (ftnlen)1, (ftnlen)80);
1480 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
1481 chkout_("ZZDYNRT0", (ftnlen)8);
1482 return 0;
1483 }
1484 } else if (meanec) {
1485
1486 /* We need a mean obliquity transformation as well. */
1487 /* Get the name of the obliquity model. */
1488
1489 zzdynvac_(inname__, infram, "OBLIQ_MODEL", &c__1, &n, oblmod,
1490 (ftnlen)32, (ftnlen)11, (ftnlen)80);
1491 if (failed_()) {
1492 chkout_("ZZDYNRT0", (ftnlen)8);
1493 return 0;
1494 }
1495
1496 /* Get the obliquity transformation. */
1497
1498 if (eqstr_(oblmod, "EARTH_IAU_1980", (ftnlen)80, (ftnlen)14))
1499 {
1500
1501 /* This is the 1980 IAU earth mean obliquity of */
1502 /* date model. */
1503
1504 /* Make sure the center is the earth. */
1505
1506 if (*center != earth) {
1507 bodc2n_(center, ctrnam, &fnd, (ftnlen)36);
1508 if (! fnd) {
1509 intstr_(center, ctrnam, (ftnlen)36);
1510 }
1511 setmsg_("Definition of frame # specifies frame cente"
1512 "r # and obliquity model #. This obliquity m"
1513 "odel is not applicable to body #. This situa"
1514 "tion is usually caused by an error in a fram"
1515 "e kernel in which the frame is defined.", (
1516 ftnlen)214);
1517 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1518 errch_("#", ctrnam, (ftnlen)1, (ftnlen)36);
1519 errch_("#", "EARTH_IAU_1980", (ftnlen)1, (ftnlen)14);
1520 errch_("#", ctrnam, (ftnlen)1, (ftnlen)36);
1521 sigerr_("SPICE(INVALIDSELECTION)", (ftnlen)23);
1522 chkout_("ZZDYNRT0", (ftnlen)8);
1523 return 0;
1524 }
1525
1526 /* Create the obliquity transformation. */
1527 /* First look up the obliquity state. */
1528
1529 zzmobliq_(&t0, &mob, &dmob);
1530
1531 /* The obliquity rotation is about the mean-of-date */
1532 /* x-axis. The other Euler angles are identically */
1533 /* zero; the axes are arbitrary, as long as the */
1534 /* middle axis is distinct from the other two. */
1535
1536 eul2m_(&c_b190, &c_b190, &mob, &c__1, &c__3, &c__1, oblr);
1537
1538 /* Find the rotation from the J2000 to the */
1539 /* earth mean ecliptic of date frame. Invert. */
1540
1541 mxm_(oblr, rprec, rinv);
1542 xpose_(rinv, rtemp);
1543 } else {
1544 setmsg_("Definition of frame # specifies obliquity model"
1545 " #, which is not recognized. This situation is u"
1546 "sually caused by an error in a frame kernel in w"
1547 "hich the frame is defined.", (ftnlen)169);
1548 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1549 errch_("#", oblmod, (ftnlen)1, (ftnlen)80);
1550 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
1551 chkout_("ZZDYNRT0", (ftnlen)8);
1552 return 0;
1553 }
1554 }
1555
1556 /* At this point, RTEMP contains the rotation from the */
1557 /* specified mean of date or true of date frame to J2000. */
1558
1559 /* If the base frame is not J2000, we must find the */
1560 /* transformation from J2000 to the base frame. */
1561 if (*basfrm != j2000) {
1562 zzrefch1_(&j2000, basfrm, &t0, r2000);
1563 mxm_(r2000, rtemp, rotate);
1564 } else {
1565
1566 /* Otherwise, RTEMP is the matrix we want. */
1567
1568 moved_(rtemp, &c__9, rotate);
1569 }
1570
1571 /* Now ROTATE is the state transformation mapping from */
1572 /* the input frame INFRAM to the base frame BASFRM. */
1573
1574 /* This is the end of the work specific to "of-date" frames. */
1575 /* From here we drop out of the IF block. */
1576
1577 if (failed_()) {
1578 chkout_("ZZDYNRT0", (ftnlen)8);
1579 return 0;
1580 }
1581 } else if (s_cmp(dynfam, "TWO-VECTOR", (ftnlen)80, (ftnlen)10) == 0) {
1582
1583 /* The frame belongs to the TWO-VECTOR family. */
1584
1585 /* Fetch the specifications of the primary and secondary */
1586 /* axes. */
1587
1588 cleard_(&c__6, v2);
1589 for (i__ = 1; i__ <= 2; ++i__) {
1590
1591 /* Get the name of the axis associated with the Ith */
1592 /* defining vector. */
1593
1594 zzdynvac_(inname__, infram, itmaxe + (((i__1 = i__ - 1) < 2 &&
1595 0 <= i__1 ? i__1 : s_rnge("itmaxe", i__1, "zzdynrt0_"
1596 , (ftnlen)1054)) << 5), &c__1, &n, axname, (ftnlen)32,
1597 (ftnlen)32, (ftnlen)80);
1598 cmprss_(" ", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, (
1599 ftnlen)80);
1600 ucase_(axname, axname, (ftnlen)80, (ftnlen)80);
1601
1602 /* Set the sign flag associated with the axis. */
1603
1604 negate = *(unsigned char *)axname == '-';
1605 cmprss_("-", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, (
1606 ftnlen)80);
1607 cmprss_("+", &c__0, axname, axname, (ftnlen)1, (ftnlen)80, (
1608 ftnlen)80);
1609 axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("axis",
1610 i__1, "zzdynrt0_", (ftnlen)1067)] = isrchc_(axname, &
1611 c__3, axes, (ftnlen)80, (ftnlen)1);
1612 if (axis[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
1613 "axis", i__1, "zzdynrt0_", (ftnlen)1070)] == 0) {
1614 setmsg_("Definition of frame # associates vector # with "
1615 "axis #. The only valid axis values are { X, -X,"
1616 " Y, -Y, Z, -Z }. This situation is usually cause"
1617 "d by an error in a frame kernel in which the fra"
1618 "me is defined.", (ftnlen)205);
1619 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1620 errint_("#", &i__, (ftnlen)1);
1621 errch_("#", axname, (ftnlen)1, (ftnlen)80);
1622 sigerr_("SPICE(INVALIDAXIS)", (ftnlen)18);
1623 chkout_("ZZDYNRT0", (ftnlen)8);
1624 return 0;
1625 }
1626
1627 /* Find out how the vector is defined: */
1628
1629 /* - Observer-target position vector */
1630 /* - Observer-target velocity vector */
1631 /* - Observer-target near point vector */
1632 /* - Constant vector */
1633
1634 /* VECDEF(I) indicates the vector definition method */
1635 /* for the Ith vector. */
1636
1637 zzdynvac_(inname__, infram, itmvdf + (((i__1 = i__ - 1) < 2 &&
1638 0 <= i__1 ? i__1 : s_rnge("itmvdf", i__1, "zzdynrt0_"
1639 , (ftnlen)1099)) << 5), &c__1, &n, vecdef + ((i__2 =
1640 i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("vecdef",
1641 i__2, "zzdynrt0_", (ftnlen)1099)) * 80, (ftnlen)32, (
1642 ftnlen)32, (ftnlen)80);
1643 cmprss_(" ", &c__0, vecdef + ((i__1 = i__ - 1) < 2 && 0 <=
1644 i__1 ? i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (
1645 ftnlen)1102)) * 80, vecdef + ((i__2 = i__ - 1) < 2 &&
1646 0 <= i__2 ? i__2 : s_rnge("vecdef", i__2, "zzdynrt0_",
1647 (ftnlen)1102)) * 80, (ftnlen)1, (ftnlen)80, (ftnlen)
1648 80);
1649 ucase_(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1650 s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen)1103)) *
1651 80, vecdef + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ?
1652 i__2 : s_rnge("vecdef", i__2, "zzdynrt0_", (ftnlen)
1653 1103)) * 80, (ftnlen)80, (ftnlen)80);
1654 if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
1655 s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen)1106)) *
1656 80, "OBSERVER_TARGET_POSITION", (ftnlen)80, (ftnlen)
1657 24) == 0) {
1658
1659 /* The vector is the position of a target relative */
1660 /* to an observer. */
1661
1662 /* We need a target, observer, and aberration correction. */
1663
1664 zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) <
1665 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1,
1666 "zzdynrt0_", (ftnlen)1113)) << 5), &targ, (ftnlen)
1667 32, (ftnlen)32);
1668 zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) <
1669 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1,
1670 "zzdynrt0_", (ftnlen)1115)) << 5), &obs, (ftnlen)
1671 32, (ftnlen)32);
1672 zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) <
1673 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1,
1674 "zzdynrt0_", (ftnlen)1117)) << 5), &c__1, &n,
1675 abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5);
1676
1677 /* Look up the Ith position vector in the J2000 frame. */
1678
1679 zzspkzp1_(&targ, &t0, "J2000", abcorr, &obs, &v2[(i__1 =
1680 i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge(
1681 "v2", i__1, "zzdynrt0_", (ftnlen)1123)], <, (
1682 ftnlen)5, (ftnlen)5);
1683
1684 /* At this point, V2(*,I) contains position relative to */
1685 /* frame J2000. */
1686
1687 } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ?
1688 i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen)
1689 1131)) * 80, "OBSERVER_TARGET_VELOCITY", (ftnlen)80, (
1690 ftnlen)24) == 0) {
1691
1692 /* The vector is the velocity of a target relative */
1693 /* to an observer. */
1694
1695 /* We need a target, observer, and aberration correction. */
1696
1697 zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) <
1698 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1,
1699 "zzdynrt0_", (ftnlen)1138)) << 5), &targ, (ftnlen)
1700 32, (ftnlen)32);
1701 zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) <
1702 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1,
1703 "zzdynrt0_", (ftnlen)1140)) << 5), &obs, (ftnlen)
1704 32, (ftnlen)32);
1705 zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) <
1706 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1,
1707 "zzdynrt0_", (ftnlen)1142)) << 5), &c__1, &n,
1708 abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5);
1709
1710 /* We need to know the frame in which the velocity is */
1711 /* defined. */
1712
1713 zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) <
1714 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1,
1715 "zzdynrt0_", (ftnlen)1149)) << 5), &frid, (ftnlen)
1716 32, (ftnlen)32);
1717 frmnam_(&frid, velfrm, (ftnlen)32);
1718
1719 /* Look up the Ith velocity vector in the velocity frame. */
1720
1721 zzspkez1_(&targ, &t0, velfrm, abcorr, &obs, stemp, <, (
1722 ftnlen)32, (ftnlen)5);
1723
1724 /* We'll work with the unit velocity vector. */
1725
1726 vhat_(&stemp[3], &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <=
1727 i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", (
1728 ftnlen)1161)]);
1729
1730 /* We need the epoch VET at which VELFRM is evaluated. */
1731 /* This epoch will be used to transform the velocity */
1732 /* vector from VELFRM to J2000. */
1733
1734 /* Parse the aberration correction. Capture the */
1735 /* epoch used to evaluate the velocity vector's frame. */
1736
1737 zzprscor_(abcorr, corblk, (ftnlen)5);
1738 if (corblk[1]) {
1739
1740 /* Light time correction is used. The epoch used */
1741 /* to evaluate the velocity vector's frame depends */
1742 /* on the frame's observer and center. */
1743
1744 /* Look up the velocity frame's center. */
1745
1746 frinfo_(&frid, &frctr, &frcls, &frcid, &fnd);
1747 if (! fnd) {
1748 setmsg_("In definition of frame #, the frame ass"
1749 "ociated with a velocity vector has frame"
1750 " ID code #, but no frame center, frame c"
1751 "lass, or frame class ID was found by FRI"
1752 "NFO. This situation MAY be caused by an"
1753 " error in a frame kernel in which the fr"
1754 "ame is defined. The problem also could b"
1755 "e indicative of a SPICELIB bug.", (ftnlen)
1756 310);
1757 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1758 errint_("#", &frid, (ftnlen)1);
1759 sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24);
1760 chkout_("ZZDYNRT0", (ftnlen)8);
1761 return 0;
1762 }
1763
1764 /* Obtain light time from the observer to the frame's */
1765 /* center. */
1766
1767 zzspkzp1_(&frctr, &t0, "J2000", abcorr, &obs, ctrpos,
1768 &vflt, (ftnlen)5, (ftnlen)5);
1769 zzcorepc_(abcorr, &t0, &vflt, &vet, (ftnlen)5);
1770 } else {
1771
1772 /* No aberration correction was specified. Evaluate */
1773 /* the frame at T0. */
1774
1775 vet = t0;
1776 }
1777
1778 /* The velocity frame evaluation epoch VET is now set. */
1779
1780 /* We must rotate the velocity vector from the velocity */
1781 /* frame (evaluated at VET) to the output frame at T0. */
1782 /* We'll do this in two stages, first mapping velocity */
1783 /* into the J2000 frame. */
1784
1785 zzrefch1_(&frid, &j2000, &vet, r2000);
1786 mxv_(r2000, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ?
1787 i__1 : s_rnge("v2", i__1, "zzdynrt0_", (ftnlen)
1788 1234)], ptemp);
1789 moved_(ptemp, &c__3, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <=
1790 i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", (
1791 ftnlen)1235)]);
1792
1793 /* At this point, V2(*,I) contains velocity */
1794 /* relative to frame J2000. */
1795 } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ?
1796 i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen)
1797 1242)) * 80, "TARGET_NEAR_POINT", (ftnlen)80, (ftnlen)
1798 17) == 0) {
1799
1800 /* The vector points from an observer to the near */
1801 /* point to the observer on the target body. */
1802
1803 /* We need a target, observer, and aberration correction. */
1804
1805 zzdynbid_(inname__, infram, itmtrg + (((i__1 = i__ - 1) <
1806 2 && 0 <= i__1 ? i__1 : s_rnge("itmtrg", i__1,
1807 "zzdynrt0_", (ftnlen)1249)) << 5), &targ, (ftnlen)
1808 32, (ftnlen)32);
1809 zzdynbid_(inname__, infram, itmobs + (((i__1 = i__ - 1) <
1810 2 && 0 <= i__1 ? i__1 : s_rnge("itmobs", i__1,
1811 "zzdynrt0_", (ftnlen)1251)) << 5), &obs, (ftnlen)
1812 32, (ftnlen)32);
1813 zzdynvac_(inname__, infram, itmabc + (((i__1 = i__ - 1) <
1814 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1,
1815 "zzdynrt0_", (ftnlen)1253)) << 5), &c__1, &n,
1816 abcorr, (ftnlen)32, (ftnlen)32, (ftnlen)5);
1817
1818 /* The vector points from an observer to the */
1819 /* sub-observer point (nearest point to the observer) on */
1820 /* the target body. We need the position of the near */
1821 /* point relative to the observer. */
1822
1823 /* We'll look up the position of the target center */
1824 /* relative to the observer, as well as the position of */
1825 /* the near point relative to the target center, both in */
1826 /* the body-fixed frame associated with the target. */
1827
1828 /* Look up the body-fixed frame associated with the */
1829 /* target body. */
1830
1831 cidfrm_(&targ, &cfrmid, cfrmnm, &fnd, (ftnlen)32);
1832 if (! fnd) {
1833 setmsg_("Definition of frame # requires definition o"
1834 "f body-fixed frame associated with target bo"
1835 "dy #. A call to CIDFRM indicated no body-fix"
1836 "ed frame is associated with the target body."
1837 " This situation can arise when a frame kern"
1838 "el defining the target's body-fixed frame l"
1839 "acks the OBJECT_<ID>_FRAME or OBJECT_<name>_"
1840 "FRAME keywords. The problem also could be c"
1841 "aused by an error in a frame kernel in which"
1842 " the parameterized two-vector dynamic frame "
1843 "# is defined.", (ftnlen)452);
1844 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1845 errint_("#", &targ, (ftnlen)1);
1846 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1847 sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24);
1848 chkout_("ZZDYNRT0", (ftnlen)8);
1849 return 0;
1850 }
1851
1852 /* Get the radii of the target body. */
1853
1854 bodvcd_(&targ, "RADII", &c__3, &n, radii, (ftnlen)5);
1855
1856 /* Look up the Ith position vector in the target-fixed */
1857 /* frame. Negate the vector to obtain the target-to- */
1858 /* observer vector. */
1859
1860 zzspkzp1_(&targ, &t0, cfrmnm, abcorr, &obs, ptemp, <, (
1861 ftnlen)32, (ftnlen)5);
1862 vminus_(ptemp, pobs);
1863 nearpt_(pobs, radii, &radii[1], &radii[2], pnear, &alt);
1864 if (failed_()) {
1865 chkout_("ZZDYNRT0", (ftnlen)8);
1866 return 0;
1867 }
1868
1869 /* Find the observer-near point vector in the current */
1870 /* frame CFRMNM. */
1871
1872 vsub_(pnear, pobs, ptemp);
1873
1874 /* Rotate the vector to frame J2000. To get the required */
1875 /* rotation matrix, we'll need to obtain the epoch */
1876 /* associated with CNMFRM. Parse the aberration */
1877 /* correction and adjust the frame evaluation epoch as */
1878 /* needed. */
1879
1880 zzcorepc_(abcorr, &t0, <, &fet, (ftnlen)5);
1881
1882 /* Obtain the matrix for transforming position vectors */
1883 /* from the target center frame to the J2000 frame and */
1884 /* apply it to the observer-to-near point position */
1885 /* vector. */
1886
1887 zzrefch1_(&cfrmid, &j2000, &fet, tipm);
1888 mxv_(tipm, ptemp, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <=
1889 i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", (
1890 ftnlen)1345)]);
1891
1892 /* At this point, V2(*,I) contains position of the near */
1893 /* point on the target as seen by the observer, relative */
1894 /* to frame J2000. */
1895
1896 } else if (s_cmp(vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ?
1897 i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (ftnlen)
1898 1353)) * 80, "CONSTANT", (ftnlen)80, (ftnlen)8) == 0)
1899 {
1900
1901 /* The vector is constant in a specified frame. */
1902
1903 /* We need a 3-vector and an associated reference */
1904 /* frame relative to which the vector is specified. */
1905
1906 /* Look up the ID of the frame first. */
1907
1908 zzdynfid_(inname__, infram, itmfrm + (((i__1 = i__ - 1) <
1909 2 && 0 <= i__1 ? i__1 : s_rnge("itmfrm", i__1,
1910 "zzdynrt0_", (ftnlen)1362)) << 5), &frid, (ftnlen)
1911 32, (ftnlen)32);
1912
1913 /* Let FET ("frame ET") be the evaluation epoch for */
1914 /* the constant vector's frame. By default, this */
1915 /* frame is just T0, but if we're using light time */
1916 /* corrections, FET must be adjusted for one-way */
1917 /* light time between the frame's center and the */
1918 /* observer. */
1919
1920 /* Set the default value of FET here. */
1921
1922 fet = t0;
1923
1924 /* Optionally, there is an aberration correction */
1925 /* associated with the constant vector's frame. */
1926 /* If so, an observer must be associated with the */
1927 /* frame. Look up the correction first. */
1928
1929 zzdynoac_(inname__, infram, itmabc + (((i__1 = i__ - 1) <
1930 2 && 0 <= i__1 ? i__1 : s_rnge("itmabc", i__1,
1931 "zzdynrt0_", (ftnlen)1382)) << 5), &c__1, &n,
1932 cvcorr, &fnd, (ftnlen)32, (ftnlen)32, (ftnlen)5);
1933 if (! fnd) {
1934 s_copy(cvcorr, "NONE", (ftnlen)5, (ftnlen)4);
1935 }
1936 zzprscor_(cvcorr, corblk, (ftnlen)5);
1937 if (! corblk[0]) {
1938
1939 /* We need to apply an aberration correction to */
1940 /* the constant vector. */
1941 zzprscor_(cvcorr, corblk, (ftnlen)5);
1942
1943 /* Check for errors in the aberration correction */
1944 /* specification. */
1945
1946 /* - Light time and stellar aberration corrections */
1947 /* are mutually exclusive. */
1948
1949 if (corblk[1] && corblk[2]) {
1950 setmsg_("Definition of frame # specifies aberrat"
1951 "ion correction # for constant vector. L"
1952 "ight time and stellar aberration correct"
1953 "ions are mutually exclusive for constant"
1954 " vectors used in two-vector parameterize"
1955 "d dynamic frame definitions. This situa"
1956 "tion is usually caused by an error in a "
1957 "frame kernel in which the frame is defin"
1958 "ed.", (ftnlen)322);
1959 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1960 errch_("#", cvcorr, (ftnlen)1, (ftnlen)5);
1961 sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
1962 chkout_("ZZDYNRT0", (ftnlen)8);
1963 return 0;
1964 }
1965 if (corblk[1]) {
1966
1967 /* Light time correction is used. The epoch used */
1968 /* to evaluate the constant vector's frame depends */
1969 /* on the frame's observer and center. */
1970
1971 /* Look up the constant vector frame's center. */
1972
1973 frinfo_(&frid, &frctr, &frcls, &frcid, &fnd);
1974 if (! fnd) {
1975 setmsg_("In definition of frame #, the frame"
1976 " associated with a constant vector h"
1977 "as frame ID code #, but no frame cen"
1978 "ter, frame class, or frame class ID "
1979 "was found by FRINFO. This situation"
1980 " MAY be caused by an error in a fram"
1981 "e kernel in which the frame is defin"
1982 "ed. The problem also could be indica"
1983 "tive of a SPICELIB bug.", (ftnlen)310)
1984 ;
1985 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
1986 errint_("#", &frid, (ftnlen)1);
1987 sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)
1988 24);
1989 chkout_("ZZDYNRT0", (ftnlen)8);
1990 return 0;
1991 }
1992 /* Look up the observer associated with the */
1993 /* constant vector's frame. This observer, */
1994 /* together with the frame's center, determines */
1995 /* the evaluation epoch for the frame. */
1996
1997 zzdynbid_(inname__, infram, itmobs + (((i__1 =
1998 i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
1999 "itmobs", i__1, "zzdynrt0_", (ftnlen)1468)
2000 ) << 5), &cvobs, (ftnlen)32, (ftnlen)32);
2001
2002 /* Obtain light time from the observer to the */
2003 /* frame's center. */
2004
2005 zzspkzp1_(&frctr, &t0, "J2000", cvcorr, &cvobs,
2006 ctrpos, <, (ftnlen)5, (ftnlen)5);
2007
2008 /* Find the evaluation epoch for the frame. */
2009
2010 zzcorepc_(cvcorr, &t0, <, &fet, (ftnlen)5);
2011 } else if (corblk[2]) {
2012
2013 /* Stellar aberration case. */
2014
2015 /* The constant vector must be corrected for */
2016 /* stellar aberration induced by the observer's */
2017 /* velocity relative to the solar system */
2018 /* barycenter. First, find this velocity in */
2019 /* the J2000 frame. We'll apply the correction */
2020 /* later, when the constant vector has been */
2021 /* transformed to the J2000 frame. */
2022
2023 zzdynbid_(inname__, infram, itmobs + (((i__1 =
2024 i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
2025 "itmobs", i__1, "zzdynrt0_", (ftnlen)1496)
2026 ) << 5), &cvobs, (ftnlen)32, (ftnlen)32);
2027 zzspksb1_(&cvobs, &t0, "J2000", stobs, (ftnlen)5);
2028 }
2029 }
2030
2031 /* Get the constant vector specification. */
2032
2033 zzdynvac_(inname__, infram, itmspc + (((i__1 = i__ - 1) <
2034 2 && 0 <= i__1 ? i__1 : s_rnge("itmspc", i__1,
2035 "zzdynrt0_", (ftnlen)1508)) << 5), &c__1, &n,
2036 spec, (ftnlen)32, (ftnlen)32, (ftnlen)80);
2037 if (failed_()) {
2038 chkout_("ZZDYNRT0", (ftnlen)8);
2039 return 0;
2040 }
2041 cmprss_(" ", &c__0, spec, spec, (ftnlen)1, (ftnlen)80, (
2042 ftnlen)80);
2043 ucase_(spec, spec, (ftnlen)80, (ftnlen)80);
2044 if (s_cmp(spec, "RECTANGULAR", (ftnlen)80, (ftnlen)11) ==
2045 0) {
2046
2047 /* The coordinate system is rectangular. */
2048
2049 /* Look up the constant vector. */
2050
2051 zzdynvad_(inname__, infram, itmvec + (((i__1 = i__ -
2052 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmvec",
2053 i__1, "zzdynrt0_", (ftnlen)1525)) << 5), &
2054 c__3, &n, dirvec, (ftnlen)32, (ftnlen)32);
2055 } else if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen)
2056 11) == 0 || s_cmp(spec, "RA/DEC", (ftnlen)80, (
2057 ftnlen)6) == 0) {
2058
2059 /* The coordinate system is latitudinal or RA/DEC. */
2060
2061 /* Look up the units associated with the angles. */
2062
2063 zzdynvac_(inname__, infram, itmunt + (((i__1 = i__ -
2064 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("itmunt",
2065 i__1, "zzdynrt0_", (ftnlen)1536)) << 5), &
2066 c__1, &n, units, (ftnlen)32, (ftnlen)32, (
2067 ftnlen)80);
2068 if (s_cmp(spec, "LATITUDINAL", (ftnlen)80, (ftnlen)11)
2069 == 0) {
2070
2071 /* Look up longitude and latitude. */
2072
2073 zzdynvad_(inname__, infram, itmlon + (((i__1 =
2074 i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
2075 "itmlon", i__1, "zzdynrt0_", (ftnlen)1544)
2076 ) << 5), &c__1, &n, &lon, (ftnlen)32, (
2077 ftnlen)32);
2078 zzdynvad_(inname__, infram, itmlat + (((i__1 =
2079 i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
2080 "itmlat", i__1, "zzdynrt0_", (ftnlen)1547)
2081 ) << 5), &c__1, &n, &lat, (ftnlen)32, (
2082 ftnlen)32);
2083
2084 /* Convert angles from input units to radians. */
2085
2086 convrt_(&lon, units, "RADIANS", angles, (ftnlen)
2087 80, (ftnlen)7);
2088 convrt_(&lat, units, "RADIANS", &angles[1], (
2089 ftnlen)80, (ftnlen)7);
2090 } else {
2091
2092 /* Look up RA and DEC. */
2093
2094 zzdynvad_(inname__, infram, itmra + (((i__1 = i__
2095 - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
2096 "itmra", i__1, "zzdynrt0_", (ftnlen)1560))
2097 << 5), &c__1, &n, &ra, (ftnlen)32, (
2098 ftnlen)32);
2099 zzdynvad_(inname__, infram, itmdec + (((i__1 =
2100 i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge(
2101 "itmdec", i__1, "zzdynrt0_", (ftnlen)1563)
2102 ) << 5), &c__1, &n, &dec, (ftnlen)32, (
2103 ftnlen)32);
2104
2105 /* Convert angles from input units to radians. */
2106
2107 convrt_(&ra, units, "RADIANS", angles, (ftnlen)80,
2108 (ftnlen)7);
2109 convrt_(&dec, units, "RADIANS", &angles[1], (
2110 ftnlen)80, (ftnlen)7);
2111 }
2112
2113 /* Now produce a direction vector. */
2114
2115 latrec_(&c_b356, angles, &angles[1], dirvec);
2116 } else {
2117 setmsg_("Definition of two-vector parameterized dyna"
2118 "mic frame # includes constant vector specifi"
2119 "cation #, which is not supported. This situ"
2120 "ation is usually caused by an error in a fra"
2121 "me kernel in which the frame is defined.", (
2122 ftnlen)215);
2123 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
2124 errch_("#", spec, (ftnlen)1, (ftnlen)80);
2125 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
2126 chkout_("ZZDYNRT0", (ftnlen)8);
2127 return 0;
2128 }
2129
2130 /* Convert the direction vector to the J2000 frame. */
2131
2132 zzrefch1_(&frid, &j2000, &fet, r2000);
2133 mxv_(r2000, dirvec, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <=
2134 i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", (
2135 ftnlen)1602)]);
2136
2137 /* The constant vector is now represented */
2138 /* in the J2000 frame, but we may still need to */
2139 /* apply a stellar aberration correction. */
2140
2141 if (corblk[2]) {
2142
2143 /* Perform the correction appropriate to the */
2144 /* radiation travel sense. */
2145
2146 if (corblk[4]) {
2147
2148 /* The correction is for transmission. */
2149
2150 stlabx_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1
2151 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", (
2152 ftnlen)1618)], &stobs[3], ptemp);
2153 } else {
2154
2155 /* The correction is for reception. */
2156
2157 stelab_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1
2158 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", (
2159 ftnlen)1624)], &stobs[3], ptemp);
2160 }
2161 vequ_(ptemp, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <=
2162 i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_",
2163 (ftnlen)1628)]);
2164 }
2165
2166 /* At this point, V2(*,I) contains the constant */
2167 /* (constant relative to its associated frame, that is) */
2168 /* vector as seen by the observer, relative to frame */
2169 /* J2000. */
2170
2171 } else {
2172 setmsg_("Definition of two-vector parameterized dynamic "
2173 "frame # includes vector definition #, which is n"
2174 "ot supported. This situation is usually caused "
2175 "by an error in a frame kernel in which the frame"
2176 " is defined.", (ftnlen)203);
2177 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
2178 errch_("#", vecdef + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ?
2179 i__1 : s_rnge("vecdef", i__1, "zzdynrt0_", (
2180 ftnlen)1649)) * 80, (ftnlen)1, (ftnlen)80);
2181 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
2182 chkout_("ZZDYNRT0", (ftnlen)8);
2183 return 0;
2184 }
2185
2186 /* Negate the vector if the axis has negative sign. */
2187
2188 if (negate) {
2189 vminus_(&v2[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 :
2190 s_rnge("v2", i__1, "zzdynrt0_", (ftnlen)1660)],
2191 ptemp);
2192 moved_(ptemp, &c__3, &v2[(i__1 = i__ * 3 - 3) < 6 && 0 <=
2193 i__1 ? i__1 : s_rnge("v2", i__1, "zzdynrt0_", (
2194 ftnlen)1661)]);
2195 }
2196 }
2197
2198 /* Look up the lower bound for the angular separation of */
2199 /* the defining vectors. Use the default value if none */
2200 /* was supplied. */
2201
2202 zzdynoad_(inname__, infram, itmsep, &c__1, &n, &minsep, &fnd, (
2203 ftnlen)32, (ftnlen)32);
2204 if (! fnd) {
2205 minsep = .001;
2206 }
2207
2208 /* Now use our vectors to compute our position transformation */
2209 /* matrix. */
2210
2211 /* Check the angular separation of the defining vectors. We */
2212 /* want to ensure that the vectors are not too close to being */
2213 /* linearly dependent. We can handle both cases---separation */
2214 /* close to 0 or separation close to Pi---by comparing the */
2215 /* sine of the separation to the sine of the separation limit. */
2216
2217 sep = vsep_(v2, &v2[3]);
2218 if (sin(sep) < sin(minsep)) {
2219 etcal_(&t0, timstr, (ftnlen)50);
2220 setmsg_("Angular separation of vectors defining two-vector p"
2221 "arameterized dynamic frame # is # (radians); minimum"
2222 " allowed difference of separation from 0 or Pi is # "
2223 "radians. Evaluation epoch is #. Extreme loss of pr"
2224 "ecision can occur when defining vectors are nearly l"
2225 "inearly dependent. This type of error can be due to"
2226 " using a dynamic frame outside of the time range for"
2227 " which it is meant. It also can be due to a conceptu"
2228 "al error pertaining to the frame's definition, or to"
2229 " an implementation error in the frame kernel contain"
2230 "ing the frame definition. However, if you wish to pr"
2231 "oceed with this computation, the # keyword can be us"
2232 "ed in the frame definition to adjust the separation "
2233 "limit.", (ftnlen)681);
2234 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
2235 errdp_("#", &sep, (ftnlen)1);
2236 errdp_("#", &minsep, (ftnlen)1);
2237 errch_("#", timstr, (ftnlen)1, (ftnlen)50);
2238 errch_("#", "ANGLE_SEP_TOL", (ftnlen)1, (ftnlen)13);
2239 sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
2240 chkout_("ZZDYNRT0", (ftnlen)8);
2241 return 0;
2242 }
2243
2244 /* We have both positions expressed relative to frame J2000 */
2245 /* at this point. Find the transformation from INNAME to */
2246 /* the frame J2000, then from J2000 to frame BASNAM. */
2247
2248 twovec_(v2, axis, &v2[3], &axis[1], rinv);
2249 xpose_(rinv, rtemp);
2250 zzrefch1_(&j2000, basfrm, &t0, r2000);
2251 mxm_(r2000, rtemp, rotate);
2252
2253 /* This is the end of the work specific to two-vector frames. */
2254 /* From here we drop out of the IF block. */
2255
2256 if (failed_()) {
2257 chkout_("ZZDYNRT0", (ftnlen)8);
2258 return 0;
2259 }
2260 } else if (s_cmp(dynfam, "EULER", (ftnlen)80, (ftnlen)5) == 0) {
2261
2262 /* The frame belongs to the Euler family. */
2263
2264 /* We expect to specifications of an axis sequence, units, */
2265 /* and angles via polynomial coefficients. We also expect */
2266 /* to see an ET epoch. */
2267
2268 /* Look up the epoch first. Let DELTA represent the offset */
2269 /* of T0 relative to the epoch. */
2270
2271 /* Initialize EPOCH so subtraction doesn't overflow if EPOCH */
2272 /* is invalid due to a lookup error. */
2273
2274 epoch = 0.;
2275 zzdynvad_(inname__, infram, "EPOCH", &c__1, &n, &epoch, (ftnlen)
2276 32, (ftnlen)5);
2277 delta = t0 - epoch;
2278
2279 /* Now the axis sequence. */
2280
2281 zzdynvai_(inname__, infram, "AXES", &c__3, &n, iaxes, (ftnlen)32,
2282 (ftnlen)4);
2283
2284 /* Now the coefficients for the angles. */
2285
2286 for (i__ = 1; i__ <= 3; ++i__) {
2287
2288 /* Initialize N so subtraction doesn't overflow if N */
2289 /* is invalid due to a lookup error. */
2290
2291 n = 0;
2292 zzdynvad_(inname__, infram, itmcof + (((i__1 = i__ - 1) < 3 &&
2293 0 <= i__1 ? i__1 : s_rnge("itmcof", i__1, "zzdynrt0_"
2294 , (ftnlen)1778)) << 5), &c__20, &n, &coeffs[(i__2 =
2295 i__ * 20 - 20) < 60 && 0 <= i__2 ? i__2 : s_rnge(
2296 "coeffs", i__2, "zzdynrt0_", (ftnlen)1778)], (ftnlen)
2297 32, (ftnlen)32);
2298
2299 /* Set the polynomial degree for the Ith angle. */
2300
2301 degs[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("degs",
2302 i__1, "zzdynrt0_", (ftnlen)1784)] = n - 1;
2303 }
2304
2305 /* Look up the units associated with the angles. */
2306
2307 zzdynvac_(inname__, infram, "UNITS", &c__1, &n, units, (ftnlen)32,
2308 (ftnlen)5, (ftnlen)80);
2309
2310 /* Evaluate the angles at DELTA. Convert angles from input */
2311 /* units to radians. */
2312
2313 for (i__ = 1; i__ <= 3; ++i__) {
2314 polyds_(&coeffs[(i__1 = i__ * 20 - 20) < 60 && 0 <= i__1 ?
2315 i__1 : s_rnge("coeffs", i__1, "zzdynrt0_", (ftnlen)
2316 1799)], °s[(i__2 = i__ - 1) < 3 && 0 <= i__2 ?
2317 i__2 : s_rnge("degs", i__2, "zzdynrt0_", (ftnlen)1799)
2318 ], &c__0, &delta, poly);
2319
2320 /* Convert units. Fill in the Euler angle vector. */
2321
2322 convrt_(poly, units, "RADIANS", &eulang[(i__1 = i__ - 1) < 3
2323 && 0 <= i__1 ? i__1 : s_rnge("eulang", i__1, "zzdynr"
2324 "t0_", (ftnlen)1803)], (ftnlen)80, (ftnlen)7);
2325 }
2326
2327 /* Produce a position transformation matrix that maps from */
2328 /* the defined frame to the base frame. */
2329
2330 eul2m_(eulang, &eulang[1], &eulang[2], iaxes, &iaxes[1], &iaxes[2]
2331 , rotate);
2332
2333 /* This is the end of the work specific to Euler frames. */
2334 /* From here we drop out of the IF block. */
2335
2336 if (failed_()) {
2337 chkout_("ZZDYNRT0", (ftnlen)8);
2338 return 0;
2339 }
2340 } else {
2341 setmsg_("Dynamic frame family # (in definition of frame #) is no"
2342 "t supported. This situation is usually caused by an erro"
2343 "r in a frame kernel in which the frame is defined.", (
2344 ftnlen)161);
2345 errch_("#", dynfam, (ftnlen)1, (ftnlen)80);
2346 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
2347 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
2348 chkout_("ZZDYNRT0", (ftnlen)8);
2349 return 0;
2350 }
2351
2352 /* This is the end of the IF block that processes the */
2353 /* parameterized dynamic frame families. */
2354
2355 } else {
2356 setmsg_("Dynamic frame style # (in definition of frame #) is not sup"
2357 "ported. This situation is usually caused by an error in a fr"
2358 "ame kernel in which the frame is defined.", (ftnlen)160);
2359 errch_("#", dynstl, (ftnlen)1, (ftnlen)80);
2360 errch_("#", inname__, (ftnlen)1, (ftnlen)32);
2361 sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
2362 chkout_("ZZDYNRT0", (ftnlen)8);
2363 return 0;
2364 }
2365
2366 /* At this point ROTATE is the position transformation matrix */
2367 /* mapping from the input frame INFRAM to the base frame BASFRM. */
2368
2369 /* ROTATE and BASFRM is set. */
2370
2371 chkout_("ZZDYNRT0", (ftnlen)8);
2372 return 0;
2373 } /* zzdynrt0_ */
2374
2375