1 /* drdpgr.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 static integer c__0 = 0;
12
13 /* $Procedure DRDPGR ( Derivative of rectangular w.r.t. planetographic ) */
drdpgr_(char * body,doublereal * lon,doublereal * lat,doublereal * alt,doublereal * re,doublereal * f,doublereal * jacobi,ftnlen body_len)14 /* Subroutine */ int drdpgr_(char *body, doublereal *lon, doublereal *lat,
15 doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi,
16 ftnlen body_len)
17 {
18 /* Initialized data */
19
20 static logical first = TRUE_;
21
22 /* System generated locals */
23 integer i__1, i__2;
24
25 /* Builtin functions */
26 integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
27 char *, integer);
28
29 /* Local variables */
30 extern /* Subroutine */ int zzbods2c_(integer *, char *, integer *,
31 logical *, char *, integer *, logical *, ftnlen, ftnlen),
32 zzctruin_(integer *);
33 integer i__, n;
34 extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
35 ftnlen, ftnlen);
36 logical found;
37 extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
38 integer sense;
39 extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
40 ftnlen, ftnlen, ftnlen);
41 static logical svfnd1;
42 static integer svctr1[2];
43 extern /* Subroutine */ int drdgeo_(doublereal *, doublereal *,
44 doublereal *, doublereal *, doublereal *, doublereal *);
45 integer bodyid;
46 static integer svbdid;
47 doublereal geolon;
48 extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
49 *, char *, logical *, ftnlen, ftnlen);
50 char kvalue[80];
51 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
52 ftnlen);
53 char pmkvar[32], pgrlon[4];
54 extern /* Subroutine */ int setmsg_(char *, ftnlen);
55 static char svbody[36];
56 extern /* Subroutine */ int ljucrs_(integer *, char *, char *, ftnlen,
57 ftnlen);
58 extern integer plnsns_(integer *);
59 extern logical return_(void);
60
61 /* $ Abstract */
62
63 /* This routine computes the Jacobian matrix of the transformation */
64 /* from planetographic to rectangular coordinates. */
65
66 /* $ Disclaimer */
67
68 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
69 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
70 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
71 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
72 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
73 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
74 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
75 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
76 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
77 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
78
79 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
80 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
81 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
82 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
83 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
84 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
85
86 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
87 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
88 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
89 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
90
91 /* $ Required_Reading */
92
93 /* None. */
94
95 /* $ Keywords */
96
97 /* COORDINATES */
98 /* DERIVATIVES */
99 /* MATRIX */
100
101 /* $ Declarations */
102 /* $ Abstract */
103
104 /* This include file defines the dimension of the counter */
105 /* array used by various SPICE subsystems to uniquely identify */
106 /* changes in their states. */
107
108 /* $ Disclaimer */
109
110 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
111 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
112 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
113 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
114 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
115 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
116 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
117 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
118 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
119 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
120
121 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
122 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
123 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
124 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
125 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
126 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
127
128 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
129 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
130 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
131 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
132
133 /* $ Parameters */
134
135 /* CTRSIZ is the dimension of the counter array used by */
136 /* various SPICE subsystems to uniquely identify */
137 /* changes in their states. */
138
139 /* $ Author_and_Institution */
140
141 /* B.V. Semenov (JPL) */
142
143 /* $ Literature_References */
144
145 /* None. */
146
147 /* $ Version */
148
149 /* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
150
151 /* -& */
152
153 /* End of include file. */
154
155 /* $ Brief_I/O */
156
157 /* Variable I/O Description */
158 /* -------- --- -------------------------------------------------- */
159 /* BODY I Name of body with which coordinates are associated. */
160 /* LON I Planetographic longitude of a point (radians). */
161 /* LAT I Planetographic latitude of a point (radians). */
162 /* ALT I Altitude of a point above reference spheroid. */
163 /* RE I Equatorial radius of the reference spheroid. */
164 /* F I Flattening coefficient. */
165 /* JACOBI O Matrix of partial derivatives. */
166
167 /* $ Detailed_Input */
168
169 /* BODY Name of the body with which the planetographic */
170 /* coordinate system is associated. */
171
172 /* BODY is used by this routine to look up from the */
173 /* kernel pool the prime meridian rate coefficient giving */
174 /* the body's spin sense. See the Files and Particulars */
175 /* header sections below for details. */
176
177 /* LON Planetographic longitude of the input point. This is */
178 /* the angle between the prime meridian and the meridian */
179 /* containing the input point. For bodies having */
180 /* prograde (aka direct) rotation, the direction of */
181 /* increasing longitude is positive west: from the +X */
182 /* axis of the rectangular coordinate system toward the */
183 /* -Y axis. For bodies having retrograde rotation, the */
184 /* direction of increasing longitude is positive east: */
185 /* from the +X axis toward the +Y axis. */
186
187 /* The earth, moon, and sun are exceptions: */
188 /* planetographic longitude is measured positive east for */
189 /* these bodies. */
190
191 /* The default interpretation of longitude by this */
192 /* and the other planetographic coordinate conversion */
193 /* routines can be overridden; see the discussion in */
194 /* Particulars below for details. */
195
196 /* Longitude is measured in radians. On input, the range */
197 /* of longitude is unrestricted. */
198
199 /* LAT Planetographic latitude of the input point. For a */
200 /* point P on the reference spheroid, this is the angle */
201 /* between the XY plane and the outward normal vector at */
202 /* P. For a point P not on the reference spheroid, the */
203 /* planetographic latitude is that of the closest point */
204 /* to P on the spheroid. */
205
206 /* Latitude is measured in radians. On input, the */
207 /* range of latitude is unrestricted. */
208
209 /* ALT Altitude of point above the reference spheroid. */
210 /* Units of ALT must match those of RE. */
211
212 /* RE Equatorial radius of a reference spheroid. This */
213 /* spheroid is a volume of revolution: its horizontal */
214 /* cross sections are circular. The shape of the */
215 /* spheroid is defined by an equatorial radius RE and */
216 /* a polar radius RP. Units of RE must match those of */
217 /* ALT. */
218
219 /* F Flattening coefficient = */
220
221 /* (RE-RP) / RE */
222
223 /* where RP is the polar radius of the spheroid, and the */
224 /* units of RP match those of RE. */
225
226 /* $ Detailed_Output */
227
228 /* JACOBI is the matrix of partial derivatives of the conversion */
229 /* from planetographic to rectangular coordinates. It */
230 /* has the form */
231
232 /* .- -. */
233 /* | DX/DLON DX/DLAT DX/DALT | */
234 /* | DY/DLON DY/DLAT DY/DALT | */
235 /* | DZ/DLON DZ/DLAT DZ/DALT | */
236 /* `- -' */
237
238 /* evaluated at the input values of LON, LAT and ALT. */
239
240 /* $ Parameters */
241
242 /* None. */
243
244 /* $ Exceptions */
245
246 /* 1) If the body name BODY cannot be mapped to a NAIF ID code, */
247 /* and if BODY is not a string representation of an integer, */
248 /* the error SPICE(IDCODENOTFOUND) will be signaled. */
249
250 /* 2) If the kernel variable */
251
252 /* BODY<ID code>_PGR_POSITIVE_LON */
253
254 /* is present in the kernel pool but has a value other */
255 /* than one of */
256
257 /* 'EAST' */
258 /* 'WEST' */
259
260 /* the error SPICE(INVALIDOPTION) will be signaled. Case */
261 /* and blanks are ignored when these values are interpreted. */
262
263 /* 3) If polynomial coefficients for the prime meridian of BODY */
264 /* are not available in the kernel pool, and if the kernel */
265 /* variable BODY<ID code>_PGR_POSITIVE_LON is not present in */
266 /* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */
267
268 /* 4) If the equatorial radius is non-positive, the error */
269 /* SPICE(VALUEOUTOFRANGE) is signaled. */
270
271 /* 5) If the flattening coefficient is greater than or equal to one, */
272 /* the error SPICE(VALUEOUTOFRANGE) is signaled. */
273
274 /* $ Files */
275
276 /* This routine expects a kernel variable giving BODY's prime */
277 /* meridian angle as a function of time to be available in the */
278 /* kernel pool. Normally this item is provided by loading a PCK */
279 /* file. The required kernel variable is named */
280
281 /* BODY<body ID>_PM */
282
283 /* where <body ID> represents a string containing the NAIF integer */
284 /* ID code for BODY. For example, if BODY is 'JUPITER', then */
285 /* the name of the kernel variable containing the prime meridian */
286 /* angle coefficients is */
287
288 /* BODY599_PM */
289
290 /* See the PCK Required Reading for details concerning the prime */
291 /* meridian kernel variable. */
292
293 /* The optional kernel variable */
294
295 /* BODY<body ID>_PGR_POSITIVE_LON */
296
297 /* also is normally defined via loading a text kernel. When this */
298 /* variable is present in the kernel pool, the prime meridian */
299 /* coefficients for BODY are not required by this routine. See the */
300 /* Particulars section below for details. */
301
302 /* $ Particulars */
303
304 /* It is often convenient to describe the motion of an object in the */
305 /* planetographic coordinate system. However, when performing */
306 /* vector computations it's hard to beat rectangular coordinates. */
307
308 /* To transform states given with respect to planetographic */
309 /* coordinates to states with respect to rectangular coordinates, */
310 /* one makes use of the Jacobian of the transformation between the */
311 /* two systems. */
312
313 /* Given a state in planetographic coordinates */
314
315 /* ( lon, lat, alt, dlon, dlat, dalt ) */
316
317 /* the velocity in rectangular coordinates is given by the matrix */
318 /* equation: */
319
320 /* t | t */
321 /* (dx, dy, dz) = JACOBI| * (dlon, dlat, dalt) */
322 /* |(lon,lat,alt) */
323
324
325 /* This routine computes the matrix */
326
327 /* | */
328 /* JACOBI| */
329 /* |(lon,lat,alt) */
330
331
332 /* In the planetographic coordinate system, longitude is defined */
333 /* using the spin sense of the body. Longitude is positive to the */
334 /* west if the spin is prograde and positive to the east if the spin */
335 /* is retrograde. The spin sense is given by the sign of the first */
336 /* degree term of the time-dependent polynomial for the body's prime */
337 /* meridian Euler angle "W": the spin is retrograde if this term is */
338 /* negative and prograde otherwise. For the sun, planets, most */
339 /* natural satellites, and selected asteroids, the polynomial */
340 /* expression for W may be found in a SPICE PCK kernel. */
341
342 /* The earth, moon, and sun are exceptions: planetographic longitude */
343 /* is measured positive east for these bodies. */
344
345 /* If you wish to override the default sense of positive longitude */
346 /* for a particular body, you can do so by defining the kernel */
347 /* variable */
348
349 /* BODY<body ID>_PGR_POSITIVE_LON */
350
351 /* where <body ID> represents the NAIF ID code of the body. This */
352 /* variable may be assigned either of the values */
353
354 /* 'WEST' */
355 /* 'EAST' */
356
357 /* For example, you can have this routine treat the longitude */
358 /* of the earth as increasing to the west using the kernel */
359 /* variable assignment */
360
361 /* BODY399_PGR_POSITIVE_LON = 'WEST' */
362
363 /* Normally such assignments are made by placing them in a text */
364 /* kernel and loading that kernel via FURNSH. */
365
366 /* The definition of this kernel variable controls the behavior of */
367 /* the SPICELIB planetographic routines */
368
369 /* PGRREC */
370 /* RECPGR */
371 /* DPGRDR */
372 /* DRDPGR */
373
374 /* It does not affect the other SPICELIB coordinate conversion */
375 /* routines. */
376
377 /* $ Examples */
378
379 /* Numerical results shown for this example may differ between */
380 /* platforms as the results depend on the SPICE kernels used as */
381 /* input and the machine specific arithmetic implementation. */
382
383
384 /* Find the planetographic state of the earth as seen from */
385 /* Mars in the J2000 reference frame at January 1, 2005 TDB. */
386 /* Map this state back to rectangular coordinates as a check. */
387
388
389 /* PROGRAM EX1 */
390 /* IMPLICIT NONE */
391 /* C */
392 /* C SPICELIB functions */
393 /* C */
394 /* DOUBLE PRECISION RPD */
395 /* C */
396 /* C Local variables */
397 /* C */
398 /* DOUBLE PRECISION ALT */
399 /* DOUBLE PRECISION DRECTN ( 3 ) */
400 /* DOUBLE PRECISION ET */
401 /* DOUBLE PRECISION F */
402 /* DOUBLE PRECISION JACOBI ( 3, 3 ) */
403 /* DOUBLE PRECISION LAT */
404 /* DOUBLE PRECISION LON */
405 /* DOUBLE PRECISION LT */
406 /* DOUBLE PRECISION PGRVEL ( 3 ) */
407 /* DOUBLE PRECISION RADII ( 3 ) */
408 /* DOUBLE PRECISION RE */
409 /* DOUBLE PRECISION RECTAN ( 3 ) */
410 /* DOUBLE PRECISION RP */
411 /* DOUBLE PRECISION STATE ( 6 ) */
412
413 /* INTEGER N */
414 /* C */
415 /* C Load a PCK file containing a triaxial */
416 /* C ellipsoidal shape model and orientation */
417 /* C data for Mars. */
418 /* C */
419 /* CALL FURNSH ( 'pck00008.tpc' ) */
420
421 /* C */
422 /* C Load an SPK file giving ephemerides of earth and Mars. */
423 /* C */
424 /* CALL FURNSH ( 'de405.bsp' ) */
425
426 /* C */
427 /* C Load a leapseconds kernel to support time conversion. */
428 /* C */
429 /* CALL FURNSH ( 'naif0007.tls' ) */
430
431 /* C */
432 /* C Look up the radii for Mars. Although we */
433 /* C omit it here, we could first call BADKPV */
434 /* C to make sure the variable BODY499_RADII */
435 /* C has three elements and numeric data type. */
436 /* C If the variable is not present in the kernel */
437 /* C pool, BODVRD will signal an error. */
438 /* C */
439 /* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */
440
441 /* C */
442 /* C Compute flattening coefficient. */
443 /* C */
444 /* RE = RADII(1) */
445 /* RP = RADII(3) */
446 /* F = ( RE - RP ) / RE */
447
448 /* C */
449 /* C Look up the geometric state of earth as seen from Mars at */
450 /* C January 1, 2005 TDB, relative to the J2000 reference */
451 /* C frame. */
452 /* C */
453 /* CALL STR2ET ( 'January 1, 2005 TDB', ET ) */
454
455 /* CALL SPKEZR ( 'Earth', ET, 'J2000', 'LT+S', */
456 /* . 'Mars', STATE, LT ) */
457
458 /* C */
459 /* C Convert position to planetographic coordinates. */
460 /* C */
461 /* CALL RECPGR ( 'MARS', STATE, RE, F, LON, LAT, ALT ) */
462
463 /* C */
464 /* C Convert velocity to planetographic coordinates. */
465 /* C */
466
467 /* CALL DPGRDR ( 'MARS', STATE(1), STATE(2), STATE(3), */
468 /* . RE, F, JACOBI ) */
469
470 /* CALL MXV ( JACOBI, STATE(4), PGRVEL ) */
471
472 /* C */
473 /* C As a check, convert the planetographic state back to */
474 /* C rectangular coordinates. */
475 /* C */
476 /* CALL PGRREC ( 'MARS', LON, LAT, ALT, RE, F, RECTAN ) */
477
478 /* CALL DRDPGR ( 'MARS', LON, LAT, ALT, RE, F, JACOBI ) */
479
480 /* CALL MXV ( JACOBI, PGRVEL, DRECTN ) */
481
482
483 /* WRITE(*,*) ' ' */
484 /* WRITE(*,*) 'Rectangular coordinates:' */
485 /* WRITE(*,*) ' ' */
486 /* WRITE(*,*) ' X (km) = ', STATE(1) */
487 /* WRITE(*,*) ' Y (km) = ', STATE(2) */
488 /* WRITE(*,*) ' Z (km) = ', STATE(3) */
489 /* WRITE(*,*) ' ' */
490 /* WRITE(*,*) 'Rectangular velocity:' */
491 /* WRITE(*,*) ' ' */
492 /* WRITE(*,*) ' dX/dt (km/s) = ', STATE(4) */
493 /* WRITE(*,*) ' dY/dt (km/s) = ', STATE(5) */
494 /* WRITE(*,*) ' dZ/dt (km/s) = ', STATE(6) */
495 /* WRITE(*,*) ' ' */
496 /* WRITE(*,*) 'Ellipsoid shape parameters: ' */
497 /* WRITE(*,*) ' ' */
498 /* WRITE(*,*) ' Equatorial radius (km) = ', RE */
499 /* WRITE(*,*) ' Polar radius (km) = ', RP */
500 /* WRITE(*,*) ' Flattening coefficient = ', F */
501 /* WRITE(*,*) ' ' */
502 /* WRITE(*,*) 'Planetographic coordinates:' */
503 /* WRITE(*,*) ' ' */
504 /* WRITE(*,*) ' Longitude (deg) = ', LON / RPD() */
505 /* WRITE(*,*) ' Latitude (deg) = ', LAT / RPD() */
506 /* WRITE(*,*) ' Altitude (km) = ', ALT */
507 /* WRITE(*,*) ' ' */
508 /* WRITE(*,*) 'Planetographic velocity:' */
509 /* WRITE(*,*) ' ' */
510 /* WRITE(*,*) ' d Longitude/dt (deg/s) = ', PGRVEL(1)/RPD() */
511 /* WRITE(*,*) ' d Latitude/dt (deg/s) = ', PGRVEL(2)/RPD() */
512 /* WRITE(*,*) ' d Altitude/dt (km/s) = ', PGRVEL(3) */
513 /* WRITE(*,*) ' ' */
514 /* WRITE(*,*) 'Rectangular coordinates from inverse ' // */
515 /* . 'mapping:' */
516 /* WRITE(*,*) ' ' */
517 /* WRITE(*,*) ' X (km) = ', RECTAN(1) */
518 /* WRITE(*,*) ' Y (km) = ', RECTAN(2) */
519 /* WRITE(*,*) ' Z (km) = ', RECTAN(3) */
520 /* WRITE(*,*) ' ' */
521 /* WRITE(*,*) 'Rectangular velocity from inverse mapping:' */
522 /* WRITE(*,*) ' ' */
523 /* WRITE(*,*) ' dX/dt (km/s) = ', DRECTN(1) */
524 /* WRITE(*,*) ' dY/dt (km/s) = ', DRECTN(2) */
525 /* WRITE(*,*) ' dZ/dt (km/s) = ', DRECTN(3) */
526 /* WRITE(*,*) ' ' */
527 /* END */
528
529
530 /* Output from this program should be similar to the following */
531 /* (rounding and formatting differ across platforms): */
532
533
534 /* Rectangular coordinates: */
535
536 /* X (km) = 146039732. */
537 /* Y (km) = 278546607. */
538 /* Z (km) = 119750315. */
539
540 /* Rectangular velocity: */
541
542 /* dX/dt (km/s) = -47.0428824 */
543 /* dY/dt (km/s) = 9.07021778 */
544 /* dZ/dt (km/s) = 4.75656274 */
545
546 /* Ellipsoid shape parameters: */
547
548 /* Equatorial radius (km) = 3396.19 */
549 /* Polar radius (km) = 3376.2 */
550 /* Flattening coefficient = 0.00588600756 */
551
552 /* Planetographic coordinates: */
553
554 /* Longitude (deg) = 297.667659 */
555 /* Latitude (deg) = 20.844504 */
556 /* Altitude (km) = 336531825. */
557
558 /* Planetographic velocity: */
559
560 /* d Longitude/dt (deg/s) = -8.35738632E-06 */
561 /* d Latitude/dt (deg/s) = 1.59349355E-06 */
562 /* d Altitude/dt (km/s) = -11.2144327 */
563
564 /* Rectangular coordinates from inverse mapping: */
565
566 /* X (km) = 146039732. */
567 /* Y (km) = 278546607. */
568 /* Z (km) = 119750315. */
569
570 /* Rectangular velocity from inverse mapping: */
571
572 /* dX/dt (km/s) = -47.0428824 */
573 /* dY/dt (km/s) = 9.07021778 */
574 /* dZ/dt (km/s) = 4.75656274 */
575
576
577 /* $ Restrictions */
578
579 /* None. */
580
581 /* $ Literature_References */
582
583 /* None. */
584
585 /* $ Author_and_Institution */
586
587 /* N.J. Bachman (JPL) */
588 /* B.V. Semenov (JPL) */
589 /* W.L. Taber (JPL) */
590
591 /* $ Version */
592
593 /* - SPICELIB Version 1.1.0, 21-SEP-2013 (BVS) */
594
595 /* Updated to save the input body name and ZZBODTRN state counter */
596 /* and to do name-ID conversion only if the counter has changed. */
597
598 /* Updated to call LJUCRS instead of CMPRSS/UCASE. */
599
600 /* - SPICELIB Version 1.0.0, 26-DEC-2004 (NJB) (WLT) */
601
602 /* -& */
603 /* $ Index_Entries */
604
605 /* Jacobian of rectangular w.r.t. planetographic coordinates */
606
607 /* -& */
608 /* $ Revisions */
609
610 /* None. */
611
612 /* -& */
613
614 /* SPICELIB functions */
615
616
617 /* Local parameters */
618
619
620 /* Saved body name length. */
621
622
623 /* Local variables */
624
625
626 /* Saved name/ID item declarations. */
627
628
629 /* Saved name/ID items. */
630
631
632 /* Initial values. */
633
634
635 /* Standard SPICE error handling. */
636
637 if (return_()) {
638 return 0;
639 }
640 chkin_("DRDPGR", (ftnlen)6);
641
642 /* Initialization. */
643
644 if (first) {
645
646 /* Initialize counter. */
647
648 zzctruin_(svctr1);
649 first = FALSE_;
650 }
651
652 /* Convert the body name to an ID code. */
653
654 zzbods2c_(svctr1, svbody, &svbdid, &svfnd1, body, &bodyid, &found, (
655 ftnlen)36, body_len);
656 if (! found) {
657 setmsg_("The value of the input argument BODY is #, this is not a re"
658 "cognized name of an ephemeris object. The cause of this prob"
659 "lem may be that you need an updated version of the SPICE Too"
660 "lkit. ", (ftnlen)185);
661 errch_("#", body, (ftnlen)1, body_len);
662 sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
663 chkout_("DRDPGR", (ftnlen)6);
664 return 0;
665 }
666
667 /* The equatorial radius must be positive. If not, signal an error */
668 /* and check out. */
669
670 if (*re <= 0.) {
671 setmsg_("Equatorial radius was #.", (ftnlen)24);
672 errdp_("#", re, (ftnlen)1);
673 sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
674 chkout_("DRDPGR", (ftnlen)6);
675 return 0;
676 }
677
678 /* If the flattening coefficient is greater than 1, the polar radius */
679 /* is negative. If F is equal to 1, the polar radius is zero. Either */
680 /* case is a problem, so signal an error and check out. */
681
682 if (*f >= 1.) {
683 setmsg_("Flattening coefficient was #.", (ftnlen)29);
684 errdp_("#", f, (ftnlen)1);
685 sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
686 chkout_("DRDPGR", (ftnlen)6);
687 return 0;
688 }
689
690 /* Look up the longitude sense override variable from the */
691 /* kernel pool. */
692
693 repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, (
694 ftnlen)1, (ftnlen)32);
695 gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80);
696 if (found) {
697
698 /* Make sure we recognize the value of PGRLON. */
699
700 ljucrs_(&c__0, kvalue, pgrlon, (ftnlen)80, (ftnlen)4);
701 if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) {
702 sense = 1;
703 } else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) {
704 sense = -1;
705 } else {
706 setmsg_("Kernel variable # may have the values EAST or WEST. Ac"
707 "tual value was #.", (ftnlen)72);
708 errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
709 errch_("#", kvalue, (ftnlen)1, (ftnlen)80);
710 sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
711 chkout_("DRDPGR", (ftnlen)6);
712 return 0;
713 }
714 } else {
715
716 /* Look up the spin sense of the body's prime meridian. */
717
718 sense = plnsns_(&bodyid);
719
720 /* If the required prime meridian rate was not available, */
721 /* PLNSNS returns the code 0. Here we consider this situation */
722 /* to be an error. */
723
724 if (sense == 0) {
725 repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, (
726 ftnlen)32);
727 setmsg_("Prime meridian rate coefficient defined by kernel varia"
728 "ble # is required but not available for body #. ", (
729 ftnlen)103);
730 errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
731 errch_("#", body, (ftnlen)1, body_len);
732 sigerr_("SPICE(MISSINGDATA)", (ftnlen)18);
733 chkout_("DRDPGR", (ftnlen)6);
734 return 0;
735 }
736
737 /* Handle the special cases: earth, moon, and sun. */
738
739 if (bodyid == 399 || bodyid == 301 || bodyid == 10) {
740 sense = 1;
741 }
742 }
743
744 /* At this point, SENSE is set to +/- 1. */
745
746 /* Adjust the longitude according to the sense of the body's */
747 /* spin, or according to the override value if one is provided. */
748 /* We want positive east longitude. */
749
750 geolon = sense * *lon;
751
752 /* Now that we have geodetic longitude in hand, use the */
753 /* geodetic equivalent of the input coordinates to find the */
754 /* Jacobian matrix of rectangular coordinates with respect */
755 /* to geodetic coordinates. */
756
757 drdgeo_(&geolon, lat, alt, re, f, jacobi);
758
759 /* The matrix JACOBI is */
760
761 /* .- -. */
762 /* | DX/DGEOLON DX/DLAT DX/DALT | */
763 /* | DY/DGEOLON DY/DLAT DY/DALT | */
764 /* | DZ/DGEOLON DZ/DLAT DZ/DALT | */
765 /* `- -' */
766
767 /* which, applying the chain rule to D(*)/DGEOLON, is equivalent to */
768
769 /* .- -. */
770 /* | (1/SENSE) * DX/DLON DX/DLAT DX/DALT | */
771 /* | (1/SENSE) * DY/DLON DY/DLAT DY/DALT | */
772 /* | (1/SENSE) * DZ/DLON DZ/DLAT DZ/DALT | */
773 /* `- -' */
774
775 /* So, multiplying the first column of JACOBI by SENSE gives us the */
776 /* matrix we actually want to compute: the Jacobian matrix of */
777 /* rectangular coordinates with respect to planetographic */
778 /* coordinates. */
779
780 for (i__ = 1; i__ <= 3; ++i__) {
781 jacobi[(i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("jacobi",
782 i__1, "drdpgr_", (ftnlen)793)] = sense * jacobi[(i__2 = i__ -
783 1) < 9 && 0 <= i__2 ? i__2 : s_rnge("jacobi", i__2, "drdpgr_",
784 (ftnlen)793)];
785 }
786 chkout_("DRDPGR", (ftnlen)6);
787 return 0;
788 } /* drdpgr_ */
789
790