/* $Procedure ZZDYNBID ( Fetch body ID kernel variable ) */
/* Subroutine */ int zzdynbid_(char *frname, integer *frcode, char *item,
integer *idcode, ftnlen frname_len, ftnlen item_len)
{
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen,
ftnlen, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
char dtype[1];
extern integer rtrim_(char *, ftnlen);
extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
extern logical failed_(void);
char bodnam[36];
integer codeln, nameln;
char kvname[32], cdestr[32];
integer itemln, reqnam;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
integer reqnum;
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_(
char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen), gcpool_(char *, integer *, integer *, integer *, char
*, logical *, ftnlen, ftnlen), gipool_(char *, integer *, integer
*, integer *, integer *, logical *, ftnlen);
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Look up a frame definition kernel variable whose associated value */
/* is a body name or body ID code. The returned value is always an */
/* ID code. The frame name or frame ID may be used as part of the */
/* variable's name. */
/* If the kernel variable is not present, or if the variable */
/* is not a body name or a numeric value, signal an error. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* FRAMES */
/* KERNEL */
/* PRIVATE */
/* UTILITY */
/* $ Declarations */
/* $ Abstract */
/* This include file lists the parameter collection */
/* defining the number of SPICE ID -> NAME mappings. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* naif_ids.req */
/* $ Keywords */
/* Body mappings. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* $ Version */
/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */
/* A script generates this file. Do not edit by hand. */
/* Edit the creation script to modify the contents of */
/* ZZBODTRN.INC. */
/* Maximum size of a NAME string */
/* Count of default SPICE mapping assignments. */
/* $ Abstract */
/* Include file zzdyn.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters defined below are used by the SPICELIB dynamic */
/* frame subsystem. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* This file declares parameters required by the dynamic */
/* frame routines of the SPICELIB frame subsystem. */
/* $ Restrictions */
/* The parameter BDNMLN is this routine must be kept */
/* consistent with the parameter MAXL defined in */
/* zzbodtrn.inc */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */
/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */
/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */
/* -& */
/* String length parameters */
/* ======================== */
/* Kernel variable name length. This parameter must be */
/* kept consistent with the parameter MAXLEN used in the */
/* POOL umbrella routine. */
/* Length of a character kernel pool datum. This parameter must be */
/* kept consistent with the parameter MAXCHR used in the POOL */
/* umbrella routine. */
/* Reference frame name length. This parameter must be */
/* kept consistent with the parameter WDSIZE used in the */
/* FRAMEX umbrella routine. */
/* Body name length. This parameter is used to provide a level */
/* of indirection so the dynamic frame source code doesn't */
/* have to change if the name of this SPICELIB-scope parameter */
/* is changed. The value MAXL used here is defined in the */
/* INCLUDE file */
/* zzbodtrn.inc */
/* Current value of MAXL = 36 */
/* Numeric parameters */
/* =================================== */
/* The parameter MAXCOF is the maximum number of polynomial */
/* coefficients that may be used to define an Euler angle */
/* in an "Euler frame" definition */
/* The parameter LBSEP is the default angular separation limit for */
/* the vectors defining a two-vector frame. The angular separation */
/* of the vectors must differ from Pi and 0 by at least this amount. */
/* The parameter QEXP is used to determine the width of */
/* the interval DELTA used for the discrete differentiation */
/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */
/* recursive analogs. This parameter is appropriate for */
/* 64-bit IEEE double precision numbers; when SPICELIB */
/* is hosted on platforms where longer mantissas are supported, */
/* this parameter (and hence this INCLUDE file) will become */
/* platform-dependent. */
/* The choice of QEXP is based on heuristics. It's believed to */
/* be a reasonable choice obtainable without expensive computation. */
/* QEXP is the largest power of 2 such that */
/* 1.D0 + 2**QEXP = 1.D0 */
/* Given an epoch T0 at which a discrete derivative is to be */
/* computed, this choice provides a value of DELTA that usually */
/* contributes no round-off error in the computation of the function */
/* evaluation epochs */
/* T0 +/- DELTA */
/* while providing the largest value of DELTA having this form that */
/* causes the order of the error term O(DELTA**2) in the quadratric */
/* function approximation to round to zero. Note that the error */
/* itself will normally be small but doesn't necessarily round to */
/* zero. Note also that the small function approximation error */
/* is not a measurement of the error in the discrete derivative */
/* itself. */
/* For ET values T0 > 2**27 seconds past J2000, the value of */
/* DELTA will be set to */
/* T0 * 2**QEXP */
/* For smaller values of T0, DELTA should be set to 1.D0. */
/* Frame kernel parameters */
/* ======================= */
/* Parameters relating to kernel variable names (keywords) start */
/* with the letters */
/* KW */
/* Parameters relating to kernel variable values start with the */
/* letters */
/* KV */
/* Generic parameters */
/* --------------------------------- */
/* Token used to build the base frame keyword: */
/* Frame definition style parameters */
/* --------------------------------- */
/* Token used to build the frame definition style keyword: */
/* Token indicating parameterized dynamic frame. */
/* Freeze epoch parameters */
/* --------------------------------- */
/* Token used to build the freeze epoch keyword: */
/* Rotation state parameters */
/* --------------------------------- */
/* Token used to build the rotation state keyword: */
/* Token indicating rotating rotation state: */
/* Token indicating inertial rotation state: */
/* Frame family parameters */
/* --------------------------------- */
/* Token used to build the frame family keyword: */
/* Token indicating mean equator and equinox of date frame. */
/* Token indicating mean ecliptic and equinox of date frame. */
/* Token indicating true equator and equinox of date frame. */
/* Token indicating two-vector frame. */
/* Token indicating Euler frame. */
/* "Of date" frame family parameters */
/* --------------------------------- */
/* Token used to build the precession model keyword: */
/* Token used to build the nutation model keyword: */
/* Token used to build the obliquity model keyword: */
/* Mathematical models used to define "of date" frames will */
/* likely accrue over time. We will simply assign them */
/* numbers. */
/* Token indicating the Lieske earth precession model: */
/* Token indicating the IAU 1980 earth nutation model: */
/* Token indicating the IAU 1980 earth mean obliqity of */
/* date model. Note the name matches that of the preceding */
/* nutation model---this is intentional. The keyword */
/* used in the kernel variable definition indicates what */
/* kind of model is being defined. */
/* Two-vector frame family parameters */
/* --------------------------------- */
/* Token used to build the vector axis keyword: */
/* Tokens indicating axis values: */
/* Prefixes used for primary and secondary vector definition */
/* keywords: */
/* Token used to build the vector definition keyword: */
/* Token indicating observer-target position vector: */
/* Token indicating observer-target velocity vector: */
/* Token indicating observer-target near point vector: */
/* Token indicating constant vector: */
/* Token used to build the vector observer keyword: */
/* Token used to build the vector target keyword: */
/* Token used to build the vector frame keyword: */
/* Token used to build the vector aberration correction keyword: */
/* Token used to build the constant vector specification keyword: */
/* Token indicating rectangular coordinates used to */
/* specify constant vector: */
/* Token indicating latitudinal coordinates used to */
/* specify constant vector: */
/* Token indicating RA/DEC coordinates used to */
/* specify constant vector: */
/* Token used to build the cartesian vector literal keyword: */
/* Token used to build the constant vector latitude keyword: */
/* Token used to build the constant vector longitude keyword: */
/* Token used to build the constant vector right ascension keyword: */
/* Token used to build the constant vector declination keyword: */
/* Token used to build the angular separation tolerance keyword: */
/* See the section "Physical unit parameters" below for additional */
/* parameters applicable to two-vector frames. */
/* Euler frame family parameters */
/* --------------------------------- */
/* Token used to build the epoch keyword: */
/* Token used to build the Euler axis sequence keyword: */
/* Tokens used to build the Euler angle coefficients keywords: */
/* See the section "Physical unit parameters" below for additional */
/* parameters applicable to Euler frames. */
/* Physical unit parameters */
/* --------------------------------- */
/* Token used to build the units keyword: */
/* Token indicating radians: */
/* Token indicating degrees: */
/* End of include file zzdyn.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ------------------------------------------------- */
/* FRNAME I Frame name. */
/* FRCODE I Frame ID code. */
/* ITEM I Item associated with frame definition. */
/* IDCODE O Body ID code. */
/* $ Detailed_Input */
/* FRNAME is the name of the reference frame with which */
/* the requested variable is associated. */
/* FRCODE is the frame ID code of the reference frame with */
/* which the requested variable is associated. */
/* ITEM is a string identifying the specific datum */
/* to be fetched. The kernel variable name */
/* has the form */
/* FRAME_<frame ID code>_<ITEM> */
/* or */
/* FRAME_<frame name>_<ITEM> */
/* The former of the two names takes precedence: */
/* this routine will look for a numeric variable */
/* of that name first. */
/* The value associated with the kernel variable */
/* must be one of */
/* - a nbody ID code */
/* - a string representation of an integer, */
/* for example '5' */
/* - a body frame name */
/* $ Detailed_Output */
/* IDCODE is the requested body ID code. */
/* The kernel variable name of the form */
/* FRAME_<frame ID code>_<ITEM> */
/* will be looked up first; if this variable */
/* is found and has numeric type, the associated */
/* value will be returned. If this variable is */
/* found and has character type, the value will */
/* be converted to a body ID code, and that */
/* code will be returned. */
/* If this variable is not found, the variable */
/* FRAME_<frame name>_<ITEM> */
/* will be looked up. If this variable is found and */
/* has numeric type, the associated value will be */
/* returned. If this variable is found and has */
/* character type, the value will be converted to a */
/* body ID code, and that code will be returned. */
/* If a numeric value associated with the selected */
/* kernel variable is not integral, it will be */
/* rounded to the closest integer. */
/* $ Parameters */
/* See zzdyn.inc for definition of KVNMLN. */
/* $ Exceptions */
/* 1) If neither the frame-ID-based or frame-name-based form of the */
/* requested kernel variable name matches a kernel variable */
/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */
/* will be signaled. */
/* 2) If either the frame-ID-based or frame-name-based form of the */
/* requested kernel variable name has length greater than KVNMLN, */
/* that variable will not be searched for. */
/* 3) If both the frame-ID-based and frame-name-based forms of the */
/* requested kernel variable name have length greater than KVNMLN, */
/* the error SPICE(VARNAMETOOLONG) will be signaled. */
/* 4) If kernel variable matching one form of the requested kernel */
/* variable names is found, but that variable has more than 1 */
/* associated value, the error SPICE(BADVARIABLESIZE) will be */
/* signaled. */
/* 5) If a name match is found for a character kernel variable, but */
/* the value associated with the variable cannot be mapped to a */
/* body ID code, the error SPICE(NOTRANSLATION) will be */
/* signaled. */
/* 6) If a name match is found for a numeric kernel variable, */
/* but that variable has a value that cannot be rounded to an */
/* integer representable on the host platform, an error will */
/* be signaled by a routine in the call tree of this routine. */
/* $ Files */
/* 1) Kernel variables fetched by this routine are normally */
/* introduced into the kernel pool by loading one or more */
/* frame kernels. See the Frames Required Reading for */
/* details. */
/* $ Particulars */
/* This routine centralizes logic for kernel variable lookups that */
/* must be performed by the SPICELIB frame subsystem. Part of the */
/* functionality of this routine consists of handling error */
/* conditions such as the unavailability of required kernel */
/* variables; hence no "found" flag is returned to the caller. */
/* As indicated above, the requested kernel variable may have a name */
/* of the form */
/* FRAME_<frame ID code>_<ITEM> */
/* or */
/* FRAME_<frame name>_<ITEM> */
/* Because most frame definition keywords have the first form, this */
/* routine looks for a name of that form first. */
/* Note that although this routine considers the two forms of the */
/* names to be synonymous, from the point of view of the kernel pool */
/* access routines, these names are distinct. Hence kernel */
/* variables having names of both forms, but having possibly */
/* different attributes, can be simultaneously present in the kernel */
/* pool. Intentional use of this kernel pool feature is discouraged. */
/* $ Examples */
/* 1) See ZZDYNFRM. */
/* 2) Applications of this routine include finding ID codes of */
/* observer or target bodies serving to define two-vector dynamic */
/* frames. */
/* $ Restrictions */
/* 1) This is a SPICE private routine; the routine is subject */
/* to change without notice. User applications should not */
/* call this routine. */
/* 2) An array-valued kernel variable matching the "ID code form" */
/* of the requested kernel variable name could potentially */
/* mask a scalar-valued kernel variable matching the "name */
/* form" of the requested name. This problem can be prevented */
/* by sensible frame kernel design. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */
/* References to parameterized dynamic frames in long error */
/* messages were changed to references to "reference frames." */
/* This change was made to enable this utility to support */
/* kernel variable look-ups for non-dynamic frames. */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */
/* References to parameterized dynamic frames in long error */
/* messages were changed to references to "reference frames." */
/* This change was made to enable this utility to support */
/* kernel variable look-ups for non-dynamic frames. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* TEMPLN is the length of the keyword template, minus */
/* the sum of the lengths of the two substitution markers ('#'). */
/* Local variables */
if (return_()) {
return 0;
}
chkin_("ZZDYNBID", (ftnlen)8);
/* Prepare to check the name of the kernel variable we're about */
/* to look up. */
/* Convert the frame code to a string. */
intstr_(frcode, cdestr, (ftnlen)32);
if (failed_()) {
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Get the lengths of the input frame code, name and item. */
/* Compute the length of the ID-based kernel variable name; */
/* check this length against the maximum allowed value. If */
/* the name is too long, proceed to look up the form of the */
/* kernel variable name based on the frame name. */
codeln = rtrim_(cdestr, (ftnlen)32);
nameln = rtrim_(frname, frname_len);
itemln = rtrim_(item, item_len);
reqnum = codeln + itemln + 7;
if (reqnum <= 32) {
/* First try looking for a kernel variable including the frame ID */
/* code. */
/* Note the template is */
/* 'FRAME_#_#' */
repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, (
ftnlen)32);
repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
ftnlen)32);
dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
} else {
/* The ID-based name is too long. We can't find the variable if */
/* we can't look it up. */
found = FALSE_;
}
if (! found) {
/* We need to look up the frame name-based kernel variable. */
/* Determine the length of the name of this variable; make */
/* sure it's not too long. */
reqnam = nameln + itemln + 7;
if (reqnam > 32 && reqnum > 32) {
/* Both forms of the name are too long. */
setmsg_("Kernel variable FRAME_#_# has length #; kernel variable"
" FRAME_#_# has length #; maximum allowed length is #. N"
"either variable could be searched for in the kernel pool"
" due to these name length errors.", (ftnlen)200);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnum, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnam, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
} else if (reqnam > 32) {
/* We couldn't find the variable having the ID-based name, */
/* and the frame name-based variable name is too long to */
/* look up. */
/* Note that at this point KVNAME contains the ID-based */
/* kernel variable name. */
setmsg_("Kernel variable # was expected to be present in the ker"
"nel pool but was not found. The alternative form of ker"
"nel variable name FRAME_#_# was not searched for because"
" this name has excessive length (# characters vs allowed"
" maximum of #). One of these variables is needed to def"
"ine the reference frame #. Usually this type of problem"
" is due to a missing keyword assignment in a frame kerne"
"l. Another, less likely, possibility is that other erro"
"rs in a frame kernel have confused the frame subsystem i"
"nto wrongly deciding these variables are needed.", (
ftnlen)551);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnam, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Now try looking for a kernel variable including the frame */
/* name. */
repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1,
frname_len, (ftnlen)32);
repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
ftnlen)32);
dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
if (! found && reqnum > 32) {
/* The kernel variable's presence (in one form or the other) */
/* is mandatory: signal an error. The error message */
/* depends on which variables we were able to try to */
/* look up. In this case, we never tried to look up the */
/* frame ID-based name. */
/* Note that at this point KVNAME contains the name-based */
/* kernel variable name. */
setmsg_("Kernel variable # was expected to be present in the ker"
"nel pool but was not found. The alternative form of ker"
"nel variable name FRAME_#_# was not searched for because"
" this name has excessive length (# characters vs allowed"
" maximum of #). One of these variables is needed to def"
"ine the reference frame #. Usually this type of problem"
" is due to a missing keyword assignment in a frame kerne"
"l. Another, less likely, possibility is that other erro"
"rs in a frame kernel have confused the frame subsystem i"
"nto wrongly deciding these variables are needed.", (
ftnlen)551);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnum, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
} else if (! found) {
/* We tried to look up both names and failed. */
setmsg_("At least one of the kernel variables FRAME_#_# or FRAME"
"_#_# was expected to be present in the kernel pool but n"
"either was found. One of these variables is needed to de"
"fine the reference frame #. Usually this type of proble"
"m is due to a missing keyword assignment in a frame kern"
"el. Another, less likely, possibility is that other err"
"ors in a frame kernel have confused the frame subsystem "
"into wrongly deciding these variables are needed.", (
ftnlen)440);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
}
/* Getting to this point means we found a kernel variable. The name */
/* of the variable is KVNAME. The data type is DTYPE and the */
/* cardinality is N. */
if (*(unsigned char *)dtype == 'C') {
/* Rather than using BADKPV, we check the cardinality of the */
/* kernel variable in-line so we can create a more detailed error */
/* message if need be. */
if (n > 1) {
setmsg_("The kernel variable # has used to define frame # was ex"
"pected to have size not exceeding 1 but in fact has size"
" #. Usually this type of problem is due to an error in a"
" frame definition provided in a frame kernel.", (ftnlen)
212);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errint_("#", &n, (ftnlen)1);
sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Look up the kernel variable. */
gcpool_(kvname, &c__1, &c__1, &n, bodnam, &found, (ftnlen)32, (ftnlen)
36);
if (! found) {
setmsg_("Variable # not found after DTPOOL indicated it was pres"
"ent in pool.", (ftnlen)67);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Convert the body name to a body code. */
bods2c_(bodnam, idcode, &found, (ftnlen)36);
if (! found) {
setmsg_("Body name # could not be translated to an ID code.", (
ftnlen)50);
errch_("#", bodnam, (ftnlen)1, (ftnlen)36);
sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
} else {
/* The variable has numeric type. */
if (n > 1) {
setmsg_("The kernel variable # has used to define frame # was ex"
"pected to have size not exceeding 1 but in fact has size"
" #. Usually this type of problem is due to an error in a"
" frame definition provided in a frame kernel.", (ftnlen)
212);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errint_("#", &n, (ftnlen)1);
sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Look up the kernel variable. */
gipool_(kvname, &c__1, &c__1, &n, idcode, &found, (ftnlen)32);
if (! found) {
setmsg_("Variable # not found after DTPOOL indicated it was pres"
"ent in pool.", (ftnlen)67);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
}
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
} /* zzdynbid_ */
/* $Procedure DRDPGR ( Derivative of rectangular w.r.t. planetographic ) */
/* Subroutine */ int drdpgr_(char *body, doublereal *lon, doublereal *lat,
doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi,
ftnlen body_len)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
integer i__, n;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer sense;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen), bods2c_(char *, integer *, logical *,
ftnlen), drdgeo_(doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
integer bodyid;
doublereal geolon;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen);
char kvalue[80];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
char pmkvar[32], pgrlon[4];
extern /* Subroutine */ int setmsg_(char *, ftnlen), cmprss_(char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen);
extern integer plnsns_(integer *);
extern logical return_(void);
char tmpstr[32];
/* $ Abstract */
/* This routine computes the Jacobian matrix of the transformation */
/* from planetographic to rectangular coordinates. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* COORDINATES */
/* DERIVATIVES */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* BODY I Name of body with which coordinates are associated. */
/* LON I Planetographic longitude of a point (radians). */
/* LAT I Planetographic latitude of a point (radians). */
/* ALT I Altitude of a point above reference spheroid. */
/* RE I Equatorial radius of the reference spheroid. */
/* F I Flattening coefficient. */
/* JACOBI O Matrix of partial derivatives. */
/* $ Detailed_Input */
/* BODY Name of the body with which the planetographic */
/* coordinate system is associated. */
/* BODY is used by this routine to look up from the */
/* kernel pool the prime meridian rate coefficient giving */
/* the body's spin sense. See the Files and Particulars */
/* header sections below for details. */
/* LON Planetographic longitude of the input point. This is */
/* the angle between the prime meridian and the meridian */
/* containing the input point. For bodies having */
/* prograde (aka direct) rotation, the direction of */
/* increasing longitude is positive west: from the +X */
/* axis of the rectangular coordinate system toward the */
/* -Y axis. For bodies having retrograde rotation, the */
/* direction of increasing longitude is positive east: */
/* from the +X axis toward the +Y axis. */
/* The earth, moon, and sun are exceptions: */
/* planetographic longitude is measured positive east for */
/* these bodies. */
/* The default interpretation of longitude by this */
/* and the other planetographic coordinate conversion */
/* routines can be overridden; see the discussion in */
/* Particulars below for details. */
/* Longitude is measured in radians. On input, the range */
/* of longitude is unrestricted. */
/* LAT Planetographic latitude of the input point. For a */
/* point P on the reference spheroid, this is the angle */
/* between the XY plane and the outward normal vector at */
/* P. For a point P not on the reference spheroid, the */
/* planetographic latitude is that of the closest point */
/* to P on the spheroid. */
/* Latitude is measured in radians. On input, the */
/* range of latitude is unrestricted. */
/* ALT Altitude of point above the reference spheroid. */
/* Units of ALT must match those of RE. */
/* RE Equatorial radius of a reference spheroid. This */
/* spheroid is a volume of revolution: its horizontal */
/* cross sections are circular. The shape of the */
/* spheroid is defined by an equatorial radius RE and */
/* a polar radius RP. Units of RE must match those of */
/* ALT. */
/* F Flattening coefficient = */
/* (RE-RP) / RE */
/* where RP is the polar radius of the spheroid, and the */
/* units of RP match those of RE. */
/* $ Detailed_Output */
/* JACOBI is the matrix of partial derivatives of the conversion */
/* from planetographic to rectangular coordinates. It */
/* has the form */
/* .- -. */
/* | DX/DLON DX/DLAT DX/DALT | */
/* | DY/DLON DY/DLAT DY/DALT | */
/* | DZ/DLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* evaluated at the input values of LON, LAT and ALT. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the body name BODY cannot be mapped to a NAIF ID code, */
/* and if BODY is not a string representation of an integer, */
/* the error SPICE(IDCODENOTFOUND) will be signaled. */
/* 2) If the kernel variable */
/* BODY<ID code>_PGR_POSITIVE_LON */
/* is present in the kernel pool but has a value other */
/* than one of */
/* 'EAST' */
/* 'WEST' */
/* the error SPICE(INVALIDOPTION) will be signaled. Case */
/* and blanks are ignored when these values are interpreted. */
/* 3) If polynomial coefficients for the prime meridian of BODY */
/* are not available in the kernel pool, and if the kernel */
/* variable BODY<ID code>_PGR_POSITIVE_LON is not present in */
/* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */
/* 4) If the equatorial radius is non-positive, the error */
/* SPICE(VALUEOUTOFRANGE) is signaled. */
/* 5) If the flattening coefficient is greater than or equal to one, */
/* the error SPICE(VALUEOUTOFRANGE) is signaled. */
/* $ Files */
/* This routine expects a kernel variable giving BODY's prime */
/* meridian angle as a function of time to be available in the */
/* kernel pool. Normally this item is provided by loading a PCK */
/* file. The required kernel variable is named */
/* BODY<body ID>_PM */
/* where <body ID> represents a string containing the NAIF integer */
/* ID code for BODY. For example, if BODY is 'JUPITER', then */
/* the name of the kernel variable containing the prime meridian */
/* angle coefficients is */
/* BODY599_PM */
/* See the PCK Required Reading for details concerning the prime */
/* meridian kernel variable. */
/* The optional kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* also is normally defined via loading a text kernel. When this */
/* variable is present in the kernel pool, the prime meridian */
/* coefficients for BODY are not required by this routine. See the */
/* Particulars section below for details. */
/* $ Particulars */
/* It is often convenient to describe the motion of an object in the */
/* planetographic coordinate system. However, when performing */
/* vector computations it's hard to beat rectangular coordinates. */
/* To transform states given with respect to planetographic */
/* coordinates to states with respect to rectangular coordinates, */
/* one makes use of the Jacobian of the transformation between the */
/* two systems. */
/* Given a state in planetographic coordinates */
/* ( lon, lat, alt, dlon, dlat, dalt ) */
/* the velocity in rectangular coordinates is given by the matrix */
/* equation: */
/* t | t */
/* (dx, dy, dz) = JACOBI| * (dlon, dlat, dalt) */
/* |(lon,lat,alt) */
/* This routine computes the matrix */
/* | */
/* JACOBI| */
/* |(lon,lat,alt) */
/* In the planetographic coordinate system, longitude is defined */
/* using the spin sense of the body. Longitude is positive to the */
/* west if the spin is prograde and positive to the east if the spin */
/* is retrograde. The spin sense is given by the sign of the first */
/* degree term of the time-dependent polynomial for the body's prime */
/* meridian Euler angle "W": the spin is retrograde if this term is */
/* negative and prograde otherwise. For the sun, planets, most */
/* natural satellites, and selected asteroids, the polynomial */
/* expression for W may be found in a SPICE PCK kernel. */
/* The earth, moon, and sun are exceptions: planetographic longitude */
/* is measured positive east for these bodies. */
/* If you wish to override the default sense of positive longitude */
/* for a particular body, you can do so by defining the kernel */
/* variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* where <body ID> represents the NAIF ID code of the body. This */
/* variable may be assigned either of the values */
/* 'WEST' */
/* 'EAST' */
/* For example, you can have this routine treat the longitude */
/* of the earth as increasing to the west using the kernel */
/* variable assignment */
/* BODY399_PGR_POSITIVE_LON = 'WEST' */
/* Normally such assignments are made by placing them in a text */
/* kernel and loading that kernel via FURNSH. */
/* The definition of this kernel variable controls the behavior of */
/* the SPICELIB planetographic routines */
/* PGRREC */
/* RECPGR */
/* DPGRDR */
/* DRDPGR */
/* It does not affect the other SPICELIB coordinate conversion */
/* routines. */
/* $ Examples */
/* Numerical results shown for this example may differ between */
/* platforms as the results depend on the SPICE kernels used as */
/* input and the machine specific arithmetic implementation. */
/* Find the planetographic state of the earth as seen from */
/* Mars in the J2000 reference frame at January 1, 2005 TDB. */
/* Map this state back to rectangular coordinates as a check. */
/* PROGRAM EX1 */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION RPD */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION ALT */
/* DOUBLE PRECISION DRECTN ( 3 ) */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION F */
/* DOUBLE PRECISION JACOBI ( 3, 3 ) */
/* DOUBLE PRECISION LAT */
/* DOUBLE PRECISION LON */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION PGRVEL ( 3 ) */
/* DOUBLE PRECISION RADII ( 3 ) */
/* DOUBLE PRECISION RE */
/* DOUBLE PRECISION RECTAN ( 3 ) */
/* DOUBLE PRECISION RP */
/* DOUBLE PRECISION STATE ( 6 ) */
/* INTEGER N */
/* C */
/* C Load a PCK file containing a triaxial */
/* C ellipsoidal shape model and orientation */
/* C data for Mars. */
/* C */
/* CALL FURNSH ( 'pck00008.tpc' ) */
/* C */
/* C Load an SPK file giving ephemerides of earth and Mars. */
/* C */
/* CALL FURNSH ( 'de405.bsp' ) */
/* C */
/* C Load a leapseconds kernel to support time conversion. */
/* C */
/* CALL FURNSH ( 'naif0007.tls' ) */
/* C */
/* C Look up the radii for Mars. Although we */
/* C omit it here, we could first call BADKPV */
/* C to make sure the variable BODY499_RADII */
/* C has three elements and numeric data type. */
/* C If the variable is not present in the kernel */
/* C pool, BODVRD will signal an error. */
/* C */
/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */
/* C */
/* C Compute flattening coefficient. */
/* C */
/* RE = RADII(1) */
/* RP = RADII(3) */
/* F = ( RE - RP ) / RE */
/* C */
/* C Look up the geometric state of earth as seen from Mars at */
/* C January 1, 2005 TDB, relative to the J2000 reference */
/* C frame. */
/* C */
/* CALL STR2ET ( 'January 1, 2005 TDB', ET ) */
/* CALL SPKEZR ( 'Earth', ET, 'J2000', 'LT+S', */
/* . 'Mars', STATE, LT ) */
/* C */
/* C Convert position to planetographic coordinates. */
/* C */
/* CALL RECPGR ( 'MARS', STATE, RE, F, LON, LAT, ALT ) */
/* C */
/* C Convert velocity to planetographic coordinates. */
/* C */
/* CALL DPGRDR ( 'MARS', STATE(1), STATE(2), STATE(3), */
/* . RE, F, JACOBI ) */
/* CALL MXV ( JACOBI, STATE(4), PGRVEL ) */
/* C */
/* C As a check, convert the planetographic state back to */
/* C rectangular coordinates. */
/* C */
/* CALL PGRREC ( 'MARS', LON, LAT, ALT, RE, F, RECTAN ) */
/* CALL DRDPGR ( 'MARS', LON, LAT, ALT, RE, F, JACOBI ) */
/* CALL MXV ( JACOBI, PGRVEL, DRECTN ) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular coordinates:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' X (km) = ', STATE(1) */
/* WRITE(*,*) ' Y (km) = ', STATE(2) */
/* WRITE(*,*) ' Z (km) = ', STATE(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular velocity:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' dX/dt (km/s) = ', STATE(4) */
/* WRITE(*,*) ' dY/dt (km/s) = ', STATE(5) */
/* WRITE(*,*) ' dZ/dt (km/s) = ', STATE(6) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Ellipsoid shape parameters: ' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' Equatorial radius (km) = ', RE */
/* WRITE(*,*) ' Polar radius (km) = ', RP */
/* WRITE(*,*) ' Flattening coefficient = ', F */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Planetographic coordinates:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' Longitude (deg) = ', LON / RPD() */
/* WRITE(*,*) ' Latitude (deg) = ', LAT / RPD() */
/* WRITE(*,*) ' Altitude (km) = ', ALT */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Planetographic velocity:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' d Longitude/dt (deg/s) = ', PGRVEL(1)/RPD() */
/* WRITE(*,*) ' d Latitude/dt (deg/s) = ', PGRVEL(2)/RPD() */
/* WRITE(*,*) ' d Altitude/dt (km/s) = ', PGRVEL(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular coordinates from inverse ' // */
/* . 'mapping:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' X (km) = ', RECTAN(1) */
/* WRITE(*,*) ' Y (km) = ', RECTAN(2) */
/* WRITE(*,*) ' Z (km) = ', RECTAN(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular velocity from inverse mapping:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' dX/dt (km/s) = ', DRECTN(1) */
/* WRITE(*,*) ' dY/dt (km/s) = ', DRECTN(2) */
/* WRITE(*,*) ' dZ/dt (km/s) = ', DRECTN(3) */
/* WRITE(*,*) ' ' */
/* END */
/* Output from this program should be similar to the following */
/* (rounding and formatting differ across platforms): */
/* Rectangular coordinates: */
/* X (km) = 146039732. */
/* Y (km) = 278546607. */
/* Z (km) = 119750315. */
/* Rectangular velocity: */
/* dX/dt (km/s) = -47.0428824 */
/* dY/dt (km/s) = 9.07021778 */
/* dZ/dt (km/s) = 4.75656274 */
/* Ellipsoid shape parameters: */
/* Equatorial radius (km) = 3396.19 */
/* Polar radius (km) = 3376.2 */
/* Flattening coefficient = 0.00588600756 */
/* Planetographic coordinates: */
/* Longitude (deg) = 297.667659 */
/* Latitude (deg) = 20.844504 */
/* Altitude (km) = 336531825. */
/* Planetographic velocity: */
/* d Longitude/dt (deg/s) = -8.35738632E-06 */
/* d Latitude/dt (deg/s) = 1.59349355E-06 */
/* d Altitude/dt (km/s) = -11.2144327 */
/* Rectangular coordinates from inverse mapping: */
/* X (km) = 146039732. */
/* Y (km) = 278546607. */
/* Z (km) = 119750315. */
/* Rectangular velocity from inverse mapping: */
/* dX/dt (km/s) = -47.0428824 */
/* dY/dt (km/s) = 9.07021778 */
/* dZ/dt (km/s) = 4.75656274 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 26-DEC-2004 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* Jacobian of rectangular w.r.t. planetographic coordinates */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("DRDPGR", (ftnlen)6);
/* Convert the body name to an ID code. */
bods2c_(body, &bodyid, &found, body_len);
if (! found) {
setmsg_("The value of the input argument BODY is #, this is not a re"
"cognized name of an ephemeris object. The cause of this prob"
"lem may be that you need an updated version of the SPICE Too"
"lkit. ", (ftnlen)185);
errch_("#", body, (ftnlen)1, body_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* The equatorial radius must be positive. If not, signal an error */
/* and check out. */
if (*re <= 0.) {
setmsg_("Equatorial radius was #.", (ftnlen)24);
errdp_("#", re, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* If the flattening coefficient is greater than 1, the polar radius */
/* is negative. If F is equal to 1, the polar radius is zero. Either */
/* case is a problem, so signal an error and check out. */
if (*f >= 1.) {
setmsg_("Flattening coefficient was #.", (ftnlen)29);
errdp_("#", f, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* Look up the longitude sense override variable from the */
/* kernel pool. */
repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, (
ftnlen)1, (ftnlen)32);
gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80);
if (found) {
/* Make sure we recognize the value of PGRLON. */
cmprss_(" ", &c__0, kvalue, tmpstr, (ftnlen)1, (ftnlen)80, (ftnlen)32)
;
ucase_(tmpstr, pgrlon, (ftnlen)32, (ftnlen)4);
if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) {
sense = 1;
} else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) {
sense = -1;
} else {
setmsg_("Kernel variable # may have the values EAST or WEST. Ac"
"tual value was #.", (ftnlen)72);
errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
errch_("#", kvalue, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
} else {
/* Look up the spin sense of the body's prime meridian. */
sense = plnsns_(&bodyid);
/* If the required prime meridian rate was not available, */
/* PLNSNS returns the code 0. Here we consider this situation */
/* to be an error. */
if (sense == 0) {
repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, (
ftnlen)32);
setmsg_("Prime meridian rate coefficient defined by kernel varia"
"ble # is required but not available for body #. ", (
ftnlen)103);
errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
errch_("#", body, (ftnlen)1, body_len);
sigerr_("SPICE(MISSINGDATA)", (ftnlen)18);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* Handle the special cases: earth, moon, and sun. */
if (bodyid == 399 || bodyid == 301 || bodyid == 10) {
sense = 1;
}
}
/* At this point, SENSE is set to +/- 1. */
/* Adjust the longitude according to the sense of the body's */
/* spin, or according to the override value if one is provided. */
/* We want positive east longitude. */
geolon = sense * *lon;
/* Now that we have geodetic longitude in hand, use the */
/* geodetic equivalent of the input coordinates to find the */
/* Jacobian matrix of rectangular coordinates with respect */
/* to geodetic coordinates. */
drdgeo_(&geolon, lat, alt, re, f, jacobi);
/* The matrix JACOBI is */
/* .- -. */
/* | DX/DGEOLON DX/DLAT DX/DALT | */
/* | DY/DGEOLON DY/DLAT DY/DALT | */
/* | DZ/DGEOLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* which, applying the chain rule to D(*)/DGEOLON, is equivalent to */
/* .- -. */
/* | (1/SENSE) * DX/DLON DX/DLAT DX/DALT | */
/* | (1/SENSE) * DY/DLON DY/DLAT DY/DALT | */
/* | (1/SENSE) * DZ/DLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* So, multiplying the first column of JACOBI by SENSE gives us the */
/* matrix we actually want to compute: the Jacobian matrix of */
/* rectangular coordinates with respect to planetographic */
/* coordinates. */
for (i__ = 1; i__ <= 3; ++i__) {
jacobi[(i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("jacobi",
i__1, "drdpgr_", (ftnlen)736)] = sense * jacobi[(i__2 = i__ -
1) < 9 && 0 <= i__2 ? i__2 : s_rnge("jacobi", i__2, "drdpgr_",
(ftnlen)736)];
}
chkout_("DRDPGR", (ftnlen)6);
return 0;
} /* drdpgr_ */
/* $Procedure SUBSOL ( Sub-solar point ) */
/* Subroutine */ int subsol_(char *method, char *target, doublereal *et, char
*abcorr, char *obsrvr, doublereal *spoint, ftnlen method_len, ftnlen
target_len, ftnlen abcorr_len, ftnlen obsrvr_len)
{
/* Initialized data */
static doublereal origin[3] = { 0.,0.,0. };
doublereal radii[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), ltime_(doublereal *, integer *, char *, integer
*, doublereal *, doublereal *, ftnlen);
logical found;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal sunlt;
extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
integer obscde;
doublereal lt;
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
integer nradii;
char frname[80];
integer trgcde;
doublereal ettarg;
extern /* Subroutine */ int nearpt_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int spkpos_(char *, doublereal *, char *, char *,
char *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen,
ftnlen), surfpt_(doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, logical *);
doublereal alt, pos[3];
/* $ Abstract */
/* Deprecated: This routine has been superseded by the SPICELIB */
/* routine SUBSLR. This routine is supported for purposes of */
/* backward compatibility only. */
/* Determine the coordinates of the sub-solar point on a target */
/* body as seen by a specified observer at a specified epoch, */
/* optionally corrected for planetary (light time) and stellar */
/* aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* FRAMES */
/* PCK */
/* SPK */
/* TIME */
/* $ Keywords */
/* GEOMETRY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TARGET I Name of target body. */
/* ET I Epoch in ephemeris seconds past J2000 TDB. */
/* ABCORR I Aberration correction. */
/* OBSRVR I Name of observing body. */
/* SPOINT O Sub-solar point on the target body. */
/* $ Detailed_Input */
/* METHOD is a short string specifying the computation method */
/* to be used. The choices are: */
/* 'Near point' The sub-solar point is defined */
/* as the nearest point on the */
/* target to the sun. */
/* 'Intercept' The sub-observer point is */
/* defined as the target surface */
/* intercept of the line */
/* containing the target's center */
/* and the sun's center. */
/* In both cases, the intercept computation treats the */
/* surface of the target body as a triaxial ellipsoid. */
/* The ellipsoid's radii must be available in the kernel */
/* pool. */
/* Neither case nor white space are significant in */
/* METHOD. For example, the string ' NEARPOINT' is */
/* valid. */
/* TARGET is the name of the target body. TARGET is */
/* case-insensitive, and leading and trailing blanks in */
/* TARGET are not significant. Optionally, you may */
/* supply a string containing the integer ID code for */
/* the object. For example both 'MOON' and '301' are */
/* legitimate strings that indicate the moon is the */
/* target body. */
/* This routine assumes that the target body is modeled */
/* by a tri-axial ellipsoid, and that a PCK file */
/* containing its radii has been loaded into the kernel */
/* pool via FURNSH. */
/* ET is the epoch in ephemeris seconds past J2000 at which */
/* the sub-solar point on the target body is to be */
/* computed. */
/* ABCORR indicates the aberration corrections to be applied */
/* when computing the observer-target state. ABCORR */
/* may be any of the following. */
/* 'NONE' Apply no correction. Return the */
/* geometric sub-solar point on the target */
/* body. */
/* 'LT' Correct for planetary (light time) */
/* aberration. Both the state and rotation */
/* of the target body are corrected for one */
/* way light time from target to observer. */
/* The state of the sun relative to the */
/* target is corrected for one way light */
/* from the sun to the target; this state */
/* is evaluated at the epoch obtained by */
/* retarding ET by the one way light time */
/* from target to observer. */
/* 'LT+S' Correct for planetary (light time) and */
/* stellar aberrations. Light time */
/* corrections are the same as in the 'LT' */
/* case above. The target state is */
/* additionally corrected for stellar */
/* aberration as seen by the observer, and */
/* the sun state is corrected for stellar */
/* aberration as seen from the target. */
/* 'CN' Converged Newtonian light time */
/* corrections. This is the same as LT */
/* corrections but with further iterations */
/* to a converged Newtonian light time */
/* solution. Given that relativistic */
/* effects may be as large as the higher */
/* accuracy achieved by this computation, */
/* this is correction is seldom worth the */
/* additional computations required unless */
/* the user incorporates additional */
/* relativistic corrections. Light */
/* time corrections are applied as in the */
/* 'LT' case. */
/* 'CN+S' Converged Newtonian light time */
/* corrections and stellar aberration. */
/* Light time and stellar aberration */
/* corrections are applied as in the */
/* 'LT+S' case. */
/* OBSRVR is the name of the observing body, typically a */
/* spacecraft, the earth, or a surface point on the */
/* earth. OBSRVR is case-insensitive, and leading and */
/* trailing blanks in OBSRVR are not significant. */
/* Optionally, you may supply a string containing the */
/* integer ID code for the object. For example both */
/* 'EARTH' and '399' are legitimate strings that indicate */
/* the earth is the observer. */
/* $ Detailed_Output */
/* SPOINT is the sub-solar point on the target body at ET */
/* expressed relative to the body-fixed frame of the */
/* target body. */
/* The sub-solar point is defined either as the point on */
/* the target body that is closest to the sun, or the */
/* target surface intercept of the line containing the */
/* target's center and the sun's center; the input */
/* argument METHOD selects the definition to be used. */
/* The body-fixed frame, which is time-dependent, is */
/* evaluated at ET if ABCORR is 'NONE'; otherwise the */
/* frame is evaluated at ET-LT, where LT is the one way */
/* light time from target to observer. */
/* The state of the target body is corrected for */
/* aberration as specified by ABCORR; the corrected */
/* state is used in the geometric computation. As */
/* indicated above, the rotation of the target is */
/* retarded by one way light time if ABCORR specifies */
/* that light time correction is to be done. */
/* The state of the sun as seen from the observing */
/* body is also corrected for aberration as specified */
/* by ABCORR. The corrections, when selected, are */
/* applied at the epoch ET-LT, where LT is the one way */
/* light time from target to observer. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* If any of the listed errors occur, the output arguments are */
/* left unchanged. */
/* 1) If the input argument METHOD is not recognized, the error */
/* SPICE(DUBIOUSMETHOD) is signaled. */
/* 2) If either of the input body names TARGET or OBSRVR cannot be */
/* mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */
/* is signaled. */
/* 3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */
/* error SPICE(BODIESNOTDISTINCT) is signaled. */
/* 4) If frame definition data enabling the evaluation of the state */
/* of the target relative to the observer in target body-fixed */
/* coordinates have not been loaded prior to calling SUBSOL, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 5) If the specified aberration correction is not recognized, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 6) If insufficient ephemeris data have been loaded prior to */
/* calling SUBSOL, the error will be diagnosed and signaled by a */
/* routine in the call tree of this routine. */
/* 7) If the triaxial radii of the target body have not been loaded */
/* into the kernel pool prior to calling SUBSOL, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* 8) The target must be an extended body: if any of the radii of */
/* the target body are non-positive, the error will be diagnosed */
/* and signaled by routines in the call tree of this routine. */
/* 9) If PCK data supplying a rotation model for the target body */
/* have not been loaded prior to calling SUBSOL, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* Appropriate SPK, PCK, and frame data must be available to */
/* the calling program before this routine is called. Typically */
/* the data are made available by loading kernels; however the */
/* data may be supplied via subroutine interfaces if applicable. */
/* The following data are required: */
/* - SPK data: ephemeris data for sun, target, and observer must */
/* be loaded. If aberration corrections are used, the states of */
/* sun, target, and observer relative to the solar system */
/* barycenter must be calculable from the available ephemeris */
/* data. Ephemeris data are made available by loading */
/* one or more SPK files via FURNSH. */
/* - PCK data: triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: a rotation model for the target body must */
/* be loaded. This may be provided in a text or binary PCK */
/* file which is loaded via FURNSH. */
/* - Frame data: if a frame definition is required to convert */
/* the sun, observer, and target states to the body-fixed frame */
/* of the target, that definition must be available in the */
/* kernel pool. Typically the definition is supplied by loading */
/* a frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* SUBSOL computes the sub-solar point on a target body, as seen by */
/* a specified observer. */
/* There are two different popular ways to define the sub-solar */
/* point: "nearest point on target to the sun" or "target surface */
/* intercept of line containing target and sun." These coincide */
/* when the target is spherical and generally are distinct otherwise. */
/* When comparing sub-point computations with results from sources */
/* other than SPICE, it's essential to make sure the same geometric */
/* definitions are used. */
/* $ Examples */
/* In the following example program, the file MGS.BSP is a */
/* hypothetical binary SPK ephemeris file containing data for the */
/* Mars Global Surveyor orbiter. The SPK file de405s.bsp contains */
/* data for the planet barycenters as well as the Earth, Moon, and */
/* Sun for the time period including the date 1997 Dec 31 12:000 */
/* UTC. MGS0000A.TPC is a planetary constants kernel file */
/* containing radii and rotation model constants. MGS00001.TLS is */
/* a leapseconds file. (File names shown here that are specific */
/* to MGS are not names of actual files.) */
/* IMPLICIT NONE */
/* CHARACTER*25 METHOD ( 2 ) */
/* INTEGER I */
/* DOUBLE PRECISION DPR */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LAT */
/* DOUBLE PRECISION LON */
/* DOUBLE PRECISION RADIUS */
/* DOUBLE PRECISION SPOINT ( 3 ) */
/* DATA METHOD / 'Intercept', 'Near point' / */
/* C */
/* C Load kernel files. */
/* C */
/* CALL FURNSH ( 'MGS00001.TLS' ) */
/* CALL FURNSH ( 'MGS0000A.TPC' ) */
/* CALL FURNSH ( 'de405s.bsp' ) */
/* CALL FURNSH ( 'MGS.BSP' ) */
/* C */
/* C Convert the UTC request time to ET (seconds past */
/* C J2000, TDB). */
/* C */
/* CALL STR2ET ( '1997 Dec 31 12:00:00', ET ) */
/* C */
/* C Compute sub-spacecraft point using light time and stellar */
/* C aberration corrections. Use the "target surface intercept" */
/* C definition of sub-spacecraft point on the first loop */
/* C iteration, and use the "near point" definition on the */
/* C second. */
/* C */
/* DO I = 1, 2 */
/* CALL SUBSOL ( METHOD(I), */
/* . 'MARS', ET, 'LT+S', 'MGS', SPOINT ) */
/* C */
/* C Convert rectangular coordinates to planetocentric */
/* C latitude and longitude. Convert radians to degrees. */
/* C */
/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */
/* LON = LON * DPR () */
/* LAT = LAT * DPR () */
/* C */
/* C Write the results. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Computation method: ', METHOD(I) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) ' Radius (km) = ', RADIUS */
/* WRITE (*,*) ' Planetocentric Latitude (deg) = ', LAT */
/* WRITE (*,*) ' Planetocentric Longitude (deg) = ', LON */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* The appropriate kernel data must have been loaded before this */
/* routine is called. See the Files section above. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* J.E. McLean (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.3, 18-MAY-2010 (BVS) */
/* Index line now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */
/* Typo correction in Required_Reading, changed */
/* FRAME to FRAMES. */
/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */
/* Abstract now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */
/* Call to BODVAR was replaced with call to BODVCD. */
/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */
/* Updated to support representations of integers in the input */
/* arguments TARGET and OBSRVR. Deleted references in header to */
/* kernel-specific loaders. Made miscellaneous minor corrections */
/* to header comments. */
/* - SPICELIB Version 1.0.2, 12-DEC-2002 (NJB) */
/* Corrected and updated code example in header. */
/* - SPICELIB Version 1.0.1, 1-NOV-1999 (WLT) */
/* Declared routine LTIME to be external. */
/* - SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED sub-solar point */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */
/* Updated to support representations of integers in the */
/* input arguments TARGET and OBSRVR: calls to BODN2C */
/* were replaced by calls to BODS2C. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SUBSOL", (ftnlen)6);
}
/* Obtain integer codes for the target and observer. */
bods2c_(target, &trgcde, &found, target_len);
if (! found) {
setmsg_("The target, '#', is not a recognized name for an ephemeris "
"object. The cause of this problem may be that you need an up"
"dated version of the SPICE Toolkit. ", (ftnlen)155);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
bods2c_(obsrvr, &obscde, &found, obsrvr_len);
if (! found) {
setmsg_("The observer, '#', is not a recognized name for an ephemeri"
"s object. The cause of this problem may be that you need an "
"updated version of the SPICE Toolkit. ", (ftnlen)157);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
/* Check the input body codes. If they are equal, signal */
/* an error. */
if (obscde == trgcde) {
setmsg_("In computing the sub-observer point, the observing body and"
" target body are the same. Both are #.", (ftnlen)97);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
/* Get the radii of the target body from the kernel pool. */
bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5);
/* Find the name of the body-fixed frame associated with the */
/* target body. We'll want the state of the target relative to */
/* the observer in this body-fixed frame. */
cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
if (! found) {
setmsg_("No body-fixed frame is associated with target body #; a fra"
"me kernel must be loaded to make this association. Consult "
"the FRAMES Required Reading for details.", (ftnlen)159);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
/* If we're using aberration corrections, we'll need the */
/* one way light time from the target to the observer. Otherwise, */
/* we set the time time to zero. */
if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) {
lt = 0.;
ettarg = *et;
} else {
ltime_(et, &obscde, "<-", &trgcde, &ettarg, <, (ftnlen)2);
}
/* Determine the position of the sun in target body-fixed */
/* coordinates. */
/* Call SPKEZ to compute the position of the sun as seen from the */
/* target body and the light time between them SUNLT. This state is */
/* evaluated at the target epoch ETTARG. We request that the */
/* coordinates of the target-sun position vector POS be returned */
/* relative to the body fixed reference frame associated with the */
/* target body, using aberration corrections specified by the input */
/* argument ABCORR. */
spkpos_("SUN", &ettarg, frname, abcorr, target, pos, &sunlt, (ftnlen)3, (
ftnlen)80, abcorr_len, target_len);
/* Find the sub-solar point using the specified geometric definition. */
if (eqstr_(method, "Near point", method_len, (ftnlen)10)) {
/* Locate the nearest point to the sun on the target. */
nearpt_(pos, radii, &radii[1], &radii[2], spoint, &alt);
} else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) {
surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found);
/* Since the line in question passes through the center of the */
/* target, there will always be a surface intercept. So we should */
/* never have FOUND = .FALSE. */
if (! found) {
setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex "
"of ray is at target center. This indicates a bug. Please"
" contact NAIF.", (ftnlen)125);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
} else {
setmsg_("The computation method # was not recognized. Allowed values"
" are \"Near point\" and \"Intercept.\"", (ftnlen)93);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
chkout_("SUBSOL", (ftnlen)6);
return 0;
} /* subsol_ */
/* $Procedure ZZBODS2C ( Body name to ID translation, with bypass ) */
/* Subroutine */ int zzbods2c_(integer *usrctr, char *savnam, integer *savcde,
logical *savfnd, char *name__, integer *code, logical *found, ftnlen
savnam_len, ftnlen name_len)
{
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int zzbctrck_(integer *, logical *), chkin_(char *
, ftnlen), bods2c_(char *, integer *, logical *, ftnlen);
logical update;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Translate a string containing a body name or ID code to an */
/* integer code, but bypass calling BODS2C and return saved values */
/* provided by the caller if the name is the same as the saved name */
/* and the ZZBODTRN state did not change. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* NAIF_IDS */
/* $ Keywords */
/* PRIVATE */
/* BODY */
/* $ Declarations */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* USRCTR I/O ZZBODTRN state counter saved by the caller. */
/* SAVNAM I/O Body name saved by the caller. */
/* SAVCDE I/O Body ID code saved by the caller. */
/* SAVFND I/O Translation success flag saved in the caller. */
/* NAME I Body name. */
/* CODE O Body ID code. */
/* FOUND O Translation success flag. */
/* CTRSIZ P Counter array size. */
/* $ Detailed_Input */
/* USRCTR is the value of the ZZBODTRN state counter tracked by */
/* (saved in) the caller (user) routine specifically for */
/* this body name/ID/found flag triplet of variables. */
/* SAVNAM is the body name saved in the caller routine */
/* specifically for this body name/ID/found flag triplet */
/* of variables. For detailed description of allowed */
/* values see description of the NAME argument in */
/* BODS2C. */
/* SAVCDE is the body ID code saved in the caller routine */
/* specifically for this body name/ID/found flag triplet */
/* of variables. For detailed description of allowed */
/* values see description of the CODE argument in */
/* BODS2C. */
/* SAVFND is the body name to ID translation success flag saved */
/* in the caller routine specifically for this body */
/* name/ID/found flag triplet of variables. SAVFND */
/* should .TRUE. if NAME had a translation or represents */
/* an integer. */
/* NAME is the input body name. For detailed description of */
/* allowed values see description of the NAME argument */
/* in BODS2C. */
/* $ Detailed_Output */
/* USRCTR is the current ZZBODTRN state counter. */
/* SAVNAM is the body name saved in the caller routine */
/* specifically for this body name/ID/found flag triplet */
/* of variables. On the output SAVNAM always equals */
/* NAME. */
/* SAVCDE is the body ID code saved in the caller routine */
/* specifically for this body name/ID/found flag triplet */
/* of variables. On the output SAVCDE always equals */
/* CODE. */
/* SAVFND is the body name to ID translation success flag saved */
/* in the caller routine specifically for this body */
/* name/ID/found flag triplet of variables. On the */
/* output SAVFND always equals FOUND. */
/* CODE is the output body ID code. For detailed description */
/* of possible values see description of the CODE */
/* argument in BODS2C. On the output CODE always equals */
/* SAVCDE. */
/* FOUND is the body name to ID translation success flag. */
/* FOUND is .TRUE. if NAME has a translation or */
/* represents an integer. Otherwise, FOUND is .FALSE. */
/* On the output FOUND always equals SAVFND. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. This parameter is */
/* defined in the private include file 'zzctr.inc'. */
/* $ Exceptions */
/* 1) Errors may be signaled by routines in the call tree of this */
/* routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine translates a string containing a body name or ID code */
/* to an integer code but bypasses calling BODS2C to do the */
/* translation and simply returns the saved ID value and translation */
/* success flag provided by the caller if the input name is the same */
/* as the saved name provided by the caller, the saved translation */
/* success flag provided by the caller is .TRUE. and the ZZBODTRN */
/* state counter tracked by the caller is the same as the current */
/* ZZBODTRN state counter. */
/* The ZZBODTRN state counter and name/ID/found flag triplet of */
/* saved variables tracked by the caller must be specific for each */
/* body of interest. I.e. if the caller routine needs to call this */
/* routine to do translations for a target body and for an observer */
/* body, the caller routine mush use must have its own set of saved */
/* ZZBODTRN state counter and name/ID/found flag variables for each */
/* of the two bodies . */
/* $ Examples */
/* This example shows how a routine that needs to do body name-ID */
/* conversion for two distinct bodies can do it using ZZBODS2C. */
/* SUBROUTINE <name> ( TARG, OBS, ... ) */
/* ... */
/* INCLUDE 'zzctr.inc' */
/* ... */
/* C */
/* C Saved body name length. */
/* C */
/* INTEGER MAXL */
/* PARAMETER ( MAXL = 36 ) */
/* .... */
/* C */
/* C */
/* C Saved name/ID item declarations. */
/* C */
/* INTEGER SVCTR1 ( CTRSIZ ) */
/* CHARACTER*(MAXL) SVTARG */
/* INTEGER SVTGID */
/* LOGICAL SVFND1 */
/* INTEGER SVCTR2 ( CTRSIZ ) */
/* CHARACTER*(MAXL) SVOBSN */
/* INTEGER SVOBSI */
/* LOGICAL SVFND2 */
/* LOGICAL FIRST */
/* C */
/* C Saved name/ID items. */
/* C */
/* SAVE SVCTR1 */
/* SAVE SVTARG */
/* SAVE SVTGID */
/* SAVE SVFND1 */
/* SAVE SVCTR2 */
/* SAVE SVOBSN */
/* SAVE SVOBSI */
/* SAVE SVFND2 */
/* SAVE FIRST */
/* C */
/* C Initial values. */
/* C */
/* DATA FIRST / .TRUE. / */
/* ... */
/* C */
/* C Initialization. */
/* C */
/* IF ( FIRST ) THEN */
/* C */
/* C Initialize ZZBODTRN counters. */
/* C */
/* CALL ZZCTRUIN( SVCTR1 ) */
/* CALL ZZCTRUIN( SVCTR2 ) */
/* FIRST = .FALSE. */
/* END IF */
/* C */
/* C Starting from translation of target name to ID. */
/* C */
/* CALL ZZBODS2C ( SVCTR1, SVTARG, SVTGID, SVFND1, */
/* . TARG, TARGID, FOUND ) */
/* IF ( .NOT. FOUND ) THEN */
/* CALL SETMSG ( '...' ) */
/* CALL SIGERR ( 'SPICE(TARGIDCODENOTFOUND)' ) */
/* CALL CHKOUT ( '<name>' ) */
/* RETURN */
/* END IF */
/* C */
/* C Now do the same for observer */
/* C */
/* CALL ZZBODS2C ( SVCTR2, SVOBSN, SVOBSI, SVFND2, */
/* . OBS, OBSID, FOUND ) */
/* IF ( .NOT. FOUND ) THEN */
/* CALL SETMSG ( '...' ) */
/* CALL SIGERR ( 'SPICE(OBSIDCODENOTFOUND)' ) */
/* CALL CHKOUT ( '<name>' ) */
/* RETURN */
/* END IF */
/* ... */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 21-SEP-2013 (BVS) */
/* -& */
/* SPICE functions. */
/* Local variables. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
/* Check/update ZZBODTRN state counter. */
zzbctrck_(usrctr, &update);
/* Check update flag, saved found flag, and saved name against the */
/* input. */
if (! update && *savfnd && s_cmp(savnam, name__, savnam_len, name_len) ==
0) {
/* No change in body-name mapping state, the saved name was */
/* successfully resolved earlier, and input and saved names are */
/* the same. Return saved ID and FOUND. */
*code = *savcde;
*found = *savfnd;
} else {
/* Check in because BODS2C may fail. */
chkin_("ZZBODS2C", (ftnlen)8);
/* Body-name mapping state changed, or the saved name was never */
/* successfully resolved earlier, or input and saved names are */
/* different. Call BODS2C to look up ID and FOUND and reset saved */
/* values. */
bods2c_(name__, code, found, name_len);
s_copy(savnam, name__, savnam_len, name_len);
*savcde = *code;
*savfnd = *found;
/* Check out. */
chkout_("ZZBODS2C", (ftnlen)8);
}
return 0;
} /* zzbods2c_ */
/* $Procedure SUBPT ( Sub-observer point ) */
/* Subroutine */ int subpt_(char *method, char *target, doublereal *et, char *
abcorr, char *obsrvr, doublereal *spoint, doublereal *alt, ftnlen
method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len)
{
/* Initialized data */
static doublereal origin[3] = { 0.,0.,0. };
doublereal radii[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
extern doublereal vdist_(doublereal *, doublereal *);
extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
integer obscde;
doublereal lt;
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
integer nradii;
char frname[80];
integer trgcde;
extern /* Subroutine */ int nearpt_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
doublereal tstate[6];
extern logical return_(void);
extern /* Subroutine */ int vminus_(doublereal *, doublereal *), surfpt_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, logical *);
doublereal pos[3];
/* $ Abstract */
/* Deprecated: This routine has been superseded by the SPICELIB */
/* routine SUBPNT. This routine is supported for purposes of */
/* backward compatibility only. */
/* Compute the rectangular coordinates of the sub-observer point on */
/* a target body at a particular epoch, optionally corrected for */
/* planetary (light time) and stellar aberration. Return these */
/* coordinates expressed in the body-fixed frame associated with the */
/* target body. Also, return the observer's altitude above the */
/* target body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* FRAMES */
/* PCK */
/* SPK */
/* TIME */
/* $ Keywords */
/* GEOMETRY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TARGET I Name of target body. */
/* ET I Epoch in ephemeris seconds past J2000 TDB. */
/* ABCORR I Aberration correction. */
/* OBSRVR I Name of observing body. */
/* SPOINT O Sub-observer point on the target body. */
/* ALT O Altitude of the observer above the target body. */
/* $ Detailed_Input */
/* METHOD is a short string specifying the computation method */
/* to be used. The choices are: */
/* 'Near point' The sub-observer point is */
/* defined as the nearest point on */
/* the target relative to the */
/* observer. */
/* 'Intercept' The sub-observer point is */
/* defined as the target surface */
/* intercept of the line */
/* containing the observer and the */
/* target's center. */
/* In both cases, the intercept computation treats the */
/* surface of the target body as a triaxial ellipsoid. */
/* The ellipsoid's radii must be available in the kernel */
/* pool. */
/* Neither case nor white space are significant in */
/* METHOD. For example, the string ' NEARPOINT' is */
/* valid. */
/* TARGET is the name of a target body. Optionally, you may */
/* supply the integer ID code for the object as */
/* an integer string. For example both 'MOON' and */
/* '301' are legitimate strings that indicate the */
/* moon is the target body. This routine assumes */
/* that this body is modeled by a tri-axial ellipsoid, */
/* and that a PCK file containing its radii has been */
/* loaded into the kernel pool via FURNSH. */
/* ET is the epoch in ephemeris seconds past J2000 at which */
/* the sub-observer point on the target body is to be */
/* computed. */
/* ABCORR indicates the aberration corrections to be applied */
/* when computing the observer-target state. ABCORR */
/* may be any of the following. */
/* 'NONE' Apply no correction. Return the */
/* geometric sub-observer point on the */
/* target body. */
/* 'LT' Correct for planetary (light time) */
/* aberration. Both the state and rotation */
/* of the target body are corrected for */
/* light time. */
/* 'LT+S' Correct for planetary (light time) and */
/* stellar aberrations. Both the state and */
/* rotation of the target body are */
/* corrected for light time. */
/* 'CN' Converged Newtonian light time */
/* corrections. This is the same as LT */
/* corrections but with further iterations */
/* to a converged Newtonian light time */
/* solution. Given that relativistic */
/* effects may be as large as the higher */
/* accuracy achieved by this computation, */
/* this is correction is seldom worth the */
/* additional computations required unless */
/* the user incorporates additional */
/* relativistic corrections. Both the */
/* state and rotation of the target body */
/* are corrected for light time. */
/* 'CN+S' Converged Newtonian light time */
/* corrections and stellar aberration. */
/* Both the state and rotation of the */
/* target body are corrected for light */
/* time. */
/* OBSRVR is the name of the observing body. This is typically */
/* a spacecraft, the earth, or a surface point on the */
/* earth. Optionally, you may supply the ID code of */
/* the object as an integer string. For example, both */
/* 'EARTH' and '399' are legitimate strings to supply */
/* to indicate the observer is Earth. */
/* $ Detailed_Output */
/* SPOINT is the sub-observer point on the target body at ET */
/* expressed relative to the body-fixed frame of the */
/* target body. */
/* The sub-observer point is defined either as the point */
/* on the target body that is closest to the observer, */
/* or the target surface intercept of the line from the */
/* observer to the target's center; the input argument */
/* METHOD selects the definition to be used. */
/* The body-fixed frame, which is time-dependent, is */
/* evaluated at ET if ABCORR is 'NONE'; otherwise the */
/* frame is evaluated at ET-LT, where LT is the one-way */
/* light time from target to observer. */
/* The state of the target body is corrected for */
/* aberration as specified by ABCORR; the corrected */
/* state is used in the geometric computation. As */
/* indicated above, the rotation of the target is */
/* retarded by one-way light time if ABCORR specifies */
/* that light time correction is to be done. */
/* ALT is the "altitude" of the observer above the target */
/* body. When METHOD specifies a "near point" */
/* computation, ALT is truly altitude in the standard */
/* geometric sense: the length of a segment dropped from */
/* the observer to the target's surface, such that the */
/* segment is perpendicular to the surface at the */
/* contact point SPOINT. */
/* When METHOD specifies an "intercept" computation, ALT */
/* is still the length of the segment from the observer */
/* to the surface point SPOINT, but this segment in */
/* general is not perpendicular to the surface. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* If any of the listed errors occur, the output arguments are */
/* left unchanged. */
/* 1) If the input argument METHOD is not recognized, the error */
/* SPICE(DUBIOUSMETHOD) is signaled. */
/* 2) If either of the input body names TARGET or OBSRVR cannot be */
/* mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */
/* is signaled. */
/* 3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */
/* error SPICE(BODIESNOTDISTINCT) is signaled. */
/* 4) If frame definition data enabling the evaluation of the state */
/* of the target relative to the observer in target body-fixed */
/* coordinates have not been loaded prior to calling SUBPT, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 5) If the specified aberration correction is not recognized, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 6) If insufficient ephemeris data have been loaded prior to */
/* calling SUBPT, the error will be diagnosed and signaled by a */
/* routine in the call tree of this routine. */
/* 7) If the triaxial radii of the target body have not been loaded */
/* into the kernel pool prior to calling SUBPT, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* 8) The target must be an extended body: if any of the radii of */
/* the target body are non-positive, the error will be diagnosed */
/* and signaled by routines in the call tree of this routine. */
/* 9) If PCK data supplying a rotation model for the target body */
/* have not been loaded prior to calling SUBPT, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* Appropriate SPK, PCK, and frame kernels must be loaded */
/* prior by the calling program before this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for target and observer must be */
/* loaded. If aberration corrections are used, the states of */
/* target and observer relative to the solar system barycenter */
/* must be calculable from the available ephemeris data. */
/* Typically ephemeris data are made available by loading one */
/* or more SPK files via FURNSH. */
/* - PCK data: triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: rotation data for the target body must */
/* be loaded. These may be provided in a text or binary PCK */
/* file. Either type of file may be loaded via FURNSH. */
/* - Frame data: if a frame definition is required to convert */
/* the observer and target states to the body-fixed frame of */
/* the target, that definition must be available in the kernel */
/* pool. Typically the definition is supplied by loading a */
/* frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* SUBPT computes the sub-observer point on a target body. */
/* (The sub-observer point is commonly called the sub-spacecraft */
/* point when the observer is a spacecraft.) SUBPT also */
/* determines the altitude of the observer above the target body. */
/* There are two different popular ways to define the sub-observer */
/* point: "nearest point on target to observer" or "target surface */
/* intercept of line containing observer and target." These */
/* coincide when the target is spherical and generally are distinct */
/* otherwise. */
/* When comparing sub-point computations with results from sources */
/* other than SPICE, it's essential to make sure the same geometric */
/* definitions are used. */
/* $ Examples */
/* The numerical results shown for this example may differ across */
/* platforms. The results depend on the SPICE kernels used as */
/* input, the compiler and supporting libraries, and the machine */
/* specific arithmetic implementation. */
/* In the following example program, the file */
/* spk_m_031103-040201_030502.bsp */
/* is a binary SPK file containing data for Mars Global Surveyor, */
/* Mars, and the Sun for a time interval bracketing the date */
/* 2004 JAN 1 12:00:00 UTC. */
/* pck00007.tpc is a planetary constants kernel file containing */
/* radii and rotation model constants. naif0007.tls is a */
/* leapseconds kernel. */
/* Find the sub-observer point of the Mars Global Surveyor (MGS) */
/* spacecraft on Mars for a specified time. Perform the computation */
/* twice, using both the "intercept" and "near point" options. */
/* IMPLICIT NONE */
/* CHARACTER*25 METHOD ( 2 ) */
/* INTEGER I */
/* DOUBLE PRECISION ALT */
/* DOUBLE PRECISION DPR */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LAT */
/* DOUBLE PRECISION LON */
/* DOUBLE PRECISION RADIUS */
/* DOUBLE PRECISION SPOINT ( 3 ) */
/* DATA METHOD / 'Intercept', 'Near point' / */
/* C */
/* C Load kernel files. */
/* C */
/* CALL FURNSH ( 'naif0007.tls' ) */
/* CALL FURNSH ( 'pck00007.tpc' ) */
/* CALL FURNSH ( 'spk_m_031103-040201_030502.bsp' ) */
/* C */
/* C Convert the UTC request time to ET (seconds past */
/* C J2000, TDB). */
/* C */
/* CALL STR2ET ( '2004 JAN 1 12:00:00', ET ) */
/* C */
/* C Compute sub-spacecraft point using light time and stellar */
/* C aberration corrections. Use the "target surface intercept" */
/* C definition of sub-spacecraft point on the first loop */
/* C iteration, and use the "near point" definition on the */
/* C second. */
/* C */
/* DO I = 1, 2 */
/* CALL SUBPT ( METHOD(I), */
/* . 'MARS', ET, 'LT+S', */
/* . 'MGS', SPOINT, ALT ) */
/* C */
/* C Convert rectangular coordinates to planetocentric */
/* C latitude and longitude. Convert radians to degrees. */
/* C */
/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */
/* LON = LON * DPR () */
/* LAT = LAT * DPR () */
/* C */
/* C Write the results. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Computation method: ', METHOD(I) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) ' Radius (km) = ', RADIUS */
/* WRITE (*,*) ' Planetocentric Latitude (deg) = ', LAT */
/* WRITE (*,*) ' Planetocentric Longitude (deg) = ', LON */
/* WRITE (*,*) ' Altitude (km) = ', ALT */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* When this program is executed, the output will be: */
/* Computation method: Intercept */
/* Radius (km) = 3387.97077 */
/* Planetocentric Latitude (deg) = -39.7022724 */
/* Planetocentric Longitude (deg) = -159.226663 */
/* Altitude (km) = 373.173506 */
/* Computation method: Near point */
/* Radius (km) = 3387.9845 */
/* Planetocentric Latitude (deg) = -39.6659329 */
/* Planetocentric Longitude (deg) = -159.226663 */
/* Altitude (km) = 373.166636 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* N.J. Bachman (JPL) */
/* J.E. McLean (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.3, 18-MAY-2010 (BVS) */
/* Index line now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */
/* Typo correction in Required_Reading, changed */
/* FRAME to FRAMES. */
/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */
/* Abstract now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */
/* Replaced call to BODVAR with call to BODVCD. */
/* - SPICELIB Version 1.1.0, 21-JUL-2004 (EDW) */
/* Changed BODN2C call to BODS2C giving the routine */
/* the capability to accept string representations of */
/* interger IDs for TARGET and OBSRVR. */
/* - SPICELIB Version 1.0.1, 27-JUL-2003 (NJB) (CHA) */
/* Various header corrections were made. The example program */
/* was upgraded to use real kernels, and the program's output is */
/* shown. */
/* - SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED sub-observer point */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SUBPT", (ftnlen)5);
}
/* Obtain integer codes for the target and observer. */
/* Target... */
bods2c_(target, &trgcde, &found, target_len);
if (! found) {
setmsg_("The target, '#', is not a recognized name for an ephemeris "
"object. The cause of this problem may be that you need an up"
"dated version of the SPICE Toolkit. ", (ftnlen)155);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* ...observer. */
bods2c_(obsrvr, &obscde, &found, obsrvr_len);
if (! found) {
setmsg_("The observer, '#', is not a recognized name for an ephemeri"
"s object. The cause of this problem may be that you need an "
"updated version of the SPICE Toolkit. ", (ftnlen)157);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* Check the input body codes. If they are equal, signal */
/* an error. */
if (obscde == trgcde) {
setmsg_("In computing the sub-observer point, the observing body and"
" target body are the same. Both are #.", (ftnlen)97);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* Get the radii of the target body from the kernel pool. */
bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5);
/* Find the name of the body-fixed frame associated with the */
/* target body. We'll want the state of the target relative to */
/* the observer in this body-fixed frame. */
cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
if (! found) {
setmsg_("No body-fixed frame is associated with target body #; a fra"
"me kernel must be loaded to make this association. Consult "
"the FRAMES Required Reading for details.", (ftnlen)159);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* Determine the position of the observer in target */
/* body-fixed coordinates. */
/* - Call SPKEZR to compute the position of the target */
/* body as seen from the observing body and the light time */
/* (LT) between them. SPKEZR returns a state which is */
/* the position and velocity, but we'll only use the position */
/* which is the first three elements. We request that the */
/* coordinates of POS be returned relative to the body fixed */
/* reference frame associated with the target body, using */
/* aberration corrections specified by the input argument */
/* ABCORR. */
/* - Call VMINUS to negate the direction of the vector (POS) */
/* so it will be the position of the observer as seen from */
/* the target body in target body fixed coordinates. */
/* Note that this result is not the same as the result of */
/* calling SPKEZR with the target and observer switched. We */
/* computed the vector FROM the observer TO the target in */
/* order to get the proper light time and stellar aberration */
/* corrections (if requested). Now we need the inverse of */
/* that corrected vector in order to compute the sub-point. */
spkez_(&trgcde, et, frname, abcorr, &obscde, tstate, <, (ftnlen)80,
abcorr_len);
/* Negate the target's state to obtain the position of the observer */
/* relative to the target. */
vminus_(tstate, pos);
/* Find the sub-point and "altitude" (distance from observer to */
/* sub-point) using the specified geometric definition. */
if (eqstr_(method, "Near point", method_len, (ftnlen)10)) {
/* Locate the nearest point to the observer on the target. */
nearpt_(pos, radii, &radii[1], &radii[2], spoint, alt);
} else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) {
surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found);
/* Since the line in question passes through the center of the */
/* target, there will always be a surface intercept. So we should */
/* never have FOUND = .FALSE. */
if (! found) {
setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex "
"of ray is at target center. This indicates a bug. Please"
" contact NAIF.", (ftnlen)125);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* SURFPT doesn't compute altitude, so do it here. */
*alt = vdist_(pos, spoint);
} else {
setmsg_("The computation method # was not recognized. Allowed values"
" are \"Near point\" and \"Intercept.\"", (ftnlen)93);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
chkout_("SUBPT", (ftnlen)5);
return 0;
} /* subpt_ */
