/* $Procedure ETCAL ( Convert ET to Calendar format ) */
/* Subroutine */ int etcal_(doublereal *et, char *string, ftnlen string_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer extra[12] = { 0,0,1,1,1,1,1,1,1,1,1,1 };
static integer dpjan0[12] = { 0,31,59,90,120,151,181,212,243,273,304,334 }
;
static integer dpbegl[12] = { 0,31,60,91,121,152,182,213,244,274,305,335 }
;
static char months[3*12] = "JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL"
"AUG" "SEP" "OCT" "NOV" "DEC";
/* System generated locals */
address a__1[12];
integer i__1, i__2, i__3[12];
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double d_int(doublereal *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
/* Local variables */
static integer dn2000;
static doublereal dp2000, frac;
static char date[180];
static doublereal remd, secs;
static integer year, mins;
static char dstr[16], hstr[16], mstr[16], sstr[16], ystr[16];
static doublereal halfd, q;
static integer tsecs, dofyr, month, hours;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
static doublereal mynum;
static integer bh, bm, iq;
static doublereal secspd;
static char messge[16];
static integer offset;
static doublereal dmnint;
static logical adjust;
static integer daynum;
extern integer intmin_(void), intmax_(void);
extern /* Subroutine */ int dpstrf_(doublereal *, integer *, char *, char
*, ftnlen, ftnlen);
static doublereal dmxint, mydnom;
extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *,
ftnlen, ftnlen, ftnlen);
extern integer lstlti_(integer *, integer *, integer *);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
static integer yr1, yr4;
static char era[16];
static integer day, rem;
extern doublereal spd_(void);
static integer yr100, yr400;
/* $ Abstract */
/* Convert from an ephemeris epoch measured in seconds past */
/* the epoch of J2000 to a calendar string format using a */
/* formal calendar free of leapseconds. */
/* $ 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 */
/* TIME */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Ephemeris time measured in seconds past J2000. */
/* STRING O A standard calendar representation of ET. */
/* $ Detailed_Input */
/* ET is an epoch measured in ephemeris seconds */
/* past the epoch of J2000. */
/* $ Detailed_Output */
/* STRING is a calendar string representing the input ephemeris */
/* epoch. This string is based upon extending the */
/* Gregorian Calendar backward and forward indefinitely */
/* keeping the same rules for determining leap years. */
/* Moreover, there is no accounting for leapseconds. */
/* To be sure that all of the date can be stored in */
/* STRING, it should be declared to have length at */
/* least 48 characters. */
/* The string will have the following format */
/* year (era) mon day hr:mn:sc.sss */
/* Where: */
/* year --- is the year */
/* era --- is the chronological era associated with */
/* the date. For years after 999 A.D. */
/* the era is omitted. For years */
/* between 1 A.D. and 999 A.D. (inclusive) */
/* era is the string 'A.D.' For epochs */
/* before 1 A.D. Jan 1 00:00:00, era is */
/* given as 'B.C.' and the year is converted */
/* to years before the "Christian Era". */
/* The last B.C. epoch is */
/* 1 B.C. DEC 31 23:59:59.999 */
/* The first A.D. epoch (which occurs .001 */
/* seconds after the last B.C. epoch) is: */
/* 1 A.D. JAN 1 00:00:00.000 */
/* Note: there is no year 0 A.D. or 0 B.C. */
/* mon --- is a 3-letter abbreviation for the month */
/* in all capital letters. */
/* day --- is the day of the month */
/* hr --- is the hour of the day (between 0 and 23) */
/* leading zeros are added to hr if the */
/* numeric value is less than 10. */
/* mn --- is the minute of the hour (0 to 59) */
/* leading zeros are added to mn if the */
/* numeric value is less than 10. */
/* sc.sss is the second of the minute to 3 decimal */
/* places ( 0 to 59.999). Leading zeros */
/* are added if the numeric value is less */
/* than 10. Seconds are truncated, not */
/* rounded. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) If the input ET is so large that the corresponding */
/* number of days since 1 A.D. Jan 1, 00:00:00 is */
/* within 1 of overflowing or underflowing an integer, */
/* ET will not be converted to the correct string */
/* representation rather, the string returned will */
/* state that the epoch was before or after the day */
/* that is INTMIN +1 or INTMAX - 1 days after */
/* 1 A.D. Jan 1, 00:00:00. */
/* 2) If the output string is not sufficiently long to hold */
/* the full date, it will be truncated on the right. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This is an error free routine for converting ephemeris epochs */
/* represented as seconds past the J2000 epoch to formal */
/* calendar strings based upon the Gregorian Calendar. This formal */
/* time is often useful when one needs a human recognizable */
/* form of an ephemeris epoch. There is no accounting for leap */
/* seconds in the output times produced. */
/* Note: The calendar epochs produced are not the same as the */
/* UTC calendar epochs that correspond to ET. The strings */
/* produced by this routine may vary from the corresponding */
/* UTC epochs by more than 1 minute. */
/* This routine can be used in creating error messages or */
/* in routines and programs in which one prefers to report */
/* times without employing leapseconds to produce exact UTC */
/* epochs. */
/* $ Examples */
/* Suppose you wish to report that no data is */
/* available at a particular ephemeris epoch ET. The following */
/* code shows how you might accomplish this task. */
/* CALL DPSTRF ( ET, 6, 'F', ETSTR ) */
/* CALL ETCAL ( ET, STRING ) */
/* E1 = RTRIM ( STRING ) */
/* E2 = RTRIM ( ETSTR ) */
/* WRITE (*,*) 'There is no data available for the body ' */
/* WRITE (*,*) 'at requested time: ' */
/* WRITE (*,*) ' ', STRING(1:E1), ' (', ETSTR(1:E2), ')' */
/* $ Restrictions */
/* One must keep in mind when using this routine that */
/* ancient times are not based upon the Gregorian */
/* calendar. For example the 0 point of the Julian */
/* Date system is 4713 B.C. Jan 1, 12:00:00 on the Julian */
/* Calendar. If one formalized the Gregorian calendar */
/* and extended it indefinitely, the zero point of the Julian */
/* date system corresponds to 4714 B.C. NOV 24 12:00:00 on */
/* the Gregorian calendar. There are several reasons for this. */
/* Leap years in the Julian calendar occur every */
/* 4 years (including *all* centuries). Moreover, the */
/* Gregorian calendar "effectively" begins on 15 Oct, 1582 A.D. */
/* which is 5 Oct, 1582 A.D. in the Julian Calendar. */
/* Therefore you must be careful in your interpretation */
/* of ancient dates produced by this routine. */
/* $ Literature_References */
/* 1. "From Sundial to Atomic Clocks---Understanding Time and */
/* Frequency" by James Jespersen and Jane Fitz-Randolph */
/* Dover Publications, Inc. New York (1982). */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - SPICELIB Version 2.2.0, 05-MAR-1998 (WLT) */
/* The documentation concerning the appearance of the output */
/* time string was corrected so that it does not suggest */
/* a comma is inserted after the day of the month. The */
/* comma was removed from the output string in Version 2.0.0 */
/* (see the note below) but the documentation was not upgraded */
/* accordingly. */
/* - SPICELIB Version 2.1.0, 20-MAY-1996 (WLT) */
/* Two arrays that were initialized but never used were */
/* removed. */
/* - SPICELIB Version 2.0.0, 16-AUG-1995 (KRG) */
/* If the day number was less than 10, the spacing was off for */
/* the rest of the time by one space, that for the "tens" digit. */
/* This has been fixed by using a leading zero when the number of */
/* days is < 10. */
/* Also, the comma that appeared between the month/day/year */
/* and the hour:minute:seconds tokens has been removed. This was */
/* done in order to make the calendar date format of ETCAL */
/* consistent with the calendar date format of ET2UTC. */
/* - SPICELIB Version 1.0.0, 14-DEC-1993 (WLT) */
/* -& */
/* $ Index_Entries */
/* Convert ephemeris time to a formal calendar date */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.1.0, 20-MAY-1996 (WLT) */
/* Two arrays that were initialized but never used were */
/* removed. */
/* - SPICELIB Version 2.0.0, 16-AUG-1995 (KRG) */
/* If the day number was less than 10, the spacing was off for */
/* the rest of the time by one space, that for the "tens" digit. */
/* This has been fixed byusing a leading zero when the number of */
/* days is < 10. */
/* Also, the comma that appeared between the month/day/year */
/* and the hour:minute:seconds tokens has been removed. This was */
/* done in order to make the calendar date format of ETCAL */
/* consistent with the calendar date format of ET2UTC. */
/* - SPICELIB Version 1.0.0, 14-DEC-1993 (WLT) */
/* -& */
/* Spicelib Functions. */
/* We declare the variables that contain the number of days in */
/* 400 years, 100 years, 4 years and 1 year. */
/* The following integers give the number of days during the */
/* associated month of a non-leap year. */
/* The integers that follow give the number of days in a normal */
/* year that precede the first of the month. */
/* The integers that follow give the number of days in a leap */
/* year that precede the first of the month. */
/* The variables below hold the components of the output string */
/* before they are put together. */
/* We will construct our string using the local variable DATE */
/* and transfer the results to the output STRING when we are */
/* done. */
/* MONTHS contains 3-letter abbreviations for the months of the year */
/* The array EXTRA contains the number of additional days that */
/* appear before the first of a month during a leap year (as opposed */
/* to a non-leap year). */
/* DPJAN0(I) gives the number of days that occur before the I'th */
/* month of a normal year. */
/* Definitions of statement functions. */
/* The number of days elapsed since Jan 1, of year 1 A.D. to */
/* Jan 1 of YEAR is given by: */
/* The number of leap days in a year is given by: */
/* To compute the day of the year we */
/* look up the number of days to the beginning of the month, */
/* add on the number leap days that occurred prior to that */
/* time */
/* add on the number of days into the month */
/* The number of days since 1 Jan 1 A.D. is given by: */
if (first) {
first = FALSE_;
halfd = spd_() / 2.;
secspd = spd_();
dn2000 = (c__2000 - 1) * 365 + (c__2000 - 1) / 4 - (c__2000 - 1) /
100 + (c__2000 - 1) / 400 + (dpjan0[(i__1 = c__1 - 1) < 12 &&
0 <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "etcal_", (ftnlen)
571)] + extra[(i__2 = c__1 - 1) < 12 && 0 <= i__2 ? i__2 :
s_rnge("extra", i__2, "etcal_", (ftnlen)571)] * ((c__2000 / 4
<< 2) / c__2000 - c__2000 / 100 * 100 / c__2000 + c__2000 /
400 * 400 / c__2000) + c__1) - 1;
dmxint = (doublereal) intmax_();
dmnint = (doublereal) intmin_();
}
/* Now we "in-line" compute the following call. */
/* call rmaind ( et + halfd, secspd, dp2000, secs ) */
/* because we can't make a call to rmaind. */
/* The reader may wonder why we use et + halfd. The value */
/* et is seconds past the ephemeris epoch of J2000 which */
/* is at 2000 Jan 1, 12:00:00. We want to compute days past */
/* 2000 Jan 1, 00:00:00. The seconds past THAT epoch is et + halfd. */
/* We add on 0.0005 seconds so that the string produced will be */
/* rounded to the nearest millisecond. */
mydnom = secspd;
mynum = *et + halfd;
d__1 = mynum / mydnom;
q = d_int(&d__1);
remd = mynum - q * mydnom;
if (remd < 0.) {
q += -1.;
remd += mydnom;
}
secs = remd;
dp2000 = q;
/* Do something about the problem when ET is vastly */
/* out of range. (Day number outside MAX and MIN integer). */
if (dp2000 + dn2000 < dmnint + 1) {
dp2000 = dmnint - dn2000 + 1;
s_copy(messge, "Epoch before ", (ftnlen)16, (ftnlen)13);
secs = 0.;
} else if (dp2000 + dn2000 > dmxint - 1) {
dp2000 = dmxint - dn2000 - 1;
s_copy(messge, "Epoch after ", (ftnlen)16, (ftnlen)12);
secs = 0.;
} else {
s_copy(messge, " ", (ftnlen)16, (ftnlen)1);
}
/* Compute the number of days since 1 .A.D. Jan 1, 00:00:00. */
/* From the tests in the previous IF-ELSE IF-ELSE block this */
/* addition is guaranteed not to overflow. */
daynum = (integer) (dp2000 + (doublereal) dn2000);
/* If the number of days is negative, we need to do a little */
/* work so that we can represent the date in the B.C. era. */
/* We add enough multiples of 400 years so that the year will */
/* be positive and then we subtract off the appropriate multiple */
/* of 400 years later. */
if (daynum < 0) {
/* Since we can't make the call below and remain */
/* error free, we compute it ourselves. */
/* call rmaini ( daynum, dp400y, offset, daynum ) */
iq = daynum / 146097;
rem = daynum - iq * 146097;
if (rem < 0) {
--iq;
rem += 146097;
}
offset = iq;
daynum = rem;
adjust = TRUE_;
} else {
adjust = FALSE_;
}
/* Next we compute the year. Divide out multiples of 400, 100 */
/* 4 and 1 year. Finally combine these to get the correct */
/* value for year. (Note this is all integer arithmetic.) */
/* Recall that DP1Y = 365 */
/* DP4Y = 4*DPY + 1 */
/* DP100Y = 25*DP4Y - 1 */
/* DP400Y = 4*DP100Y + 1 */
yr400 = daynum / 146097;
rem = daynum - yr400 * 146097;
/* Computing MIN */
i__1 = 3, i__2 = rem / 36524;
yr100 = min(i__1,i__2);
rem -= yr100 * 36524;
/* Computing MIN */
i__1 = 24, i__2 = rem / 1461;
yr4 = min(i__1,i__2);
rem -= yr4 * 1461;
/* Computing MIN */
i__1 = 3, i__2 = rem / 365;
yr1 = min(i__1,i__2);
rem -= yr1 * 365;
dofyr = rem + 1;
year = yr400 * 400 + yr100 * 100 + (yr4 << 2) + yr1 + 1;
/* Get the month, and day of month (depending upon whether */
/* we have a leap year or not). */
if ((year / 4 << 2) / year - year / 100 * 100 / year + year / 400 * 400 /
year == 0) {
month = lstlti_(&dofyr, &c__12, dpjan0);
day = dofyr - dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 :
s_rnge("dpjan0", i__1, "etcal_", (ftnlen)698)];
} else {
month = lstlti_(&dofyr, &c__12, dpbegl);
day = dofyr - dpbegl[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 :
s_rnge("dpbegl", i__1, "etcal_", (ftnlen)701)];
}
/* If we had to adjust the year to make it positive, we now */
/* need to correct it and then convert it to a B.C. year. */
if (adjust) {
year += offset * 400;
year = -year + 1;
s_copy(era, " B.C. ", (ftnlen)16, (ftnlen)6);
} else {
/* If the year is less than 1000, we can't just write it */
/* out. We need to add the era. If we don't do this */
/* the dates look very confusing. */
if (year < 1000) {
s_copy(era, " A.D. ", (ftnlen)16, (ftnlen)6);
} else {
s_copy(era, " ", (ftnlen)16, (ftnlen)1);
}
}
/* Convert Seconds to Hours, Minute and Seconds. */
/* We work with thousandths of a second in integer arithmetic */
/* so that all of the truncation work with seconds will already */
/* be done. (Note that we already know that SECS is greater than */
/* or equal to zero so we'll have no problems with HOURS, MINS */
/* or SECS becoming negative.) */
tsecs = (integer) (secs * 1e3);
frac = secs - (doublereal) tsecs;
hours = tsecs / 3600000;
tsecs -= hours * 3600000;
mins = tsecs / 60000;
tsecs -= mins * 60000;
secs = (doublereal) tsecs / 1e3;
/* We round seconds if we can do so without getting seconds to be */
/* bigger than 60. */
if (secs + 5e-4 < 60.) {
secs += 5e-4;
}
/* Finally, get the components of our date string. */
intstr_(&year, ystr, (ftnlen)16);
if (day >= 10) {
intstr_(&day, dstr, (ftnlen)16);
} else {
s_copy(dstr, "0", (ftnlen)16, (ftnlen)1);
intstr_(&day, dstr + 1, (ftnlen)15);
}
/* We want to zero pad the hours minutes and seconds. */
if (hours < 10) {
bh = 2;
} else {
bh = 1;
}
if (mins < 10) {
bm = 2;
} else {
bm = 1;
}
s_copy(mstr, "00", (ftnlen)16, (ftnlen)2);
s_copy(hstr, "00", (ftnlen)16, (ftnlen)2);
s_copy(sstr, " ", (ftnlen)16, (ftnlen)1);
/* Now construct the string components for hours, minutes and */
/* seconds. */
secs = (integer) (secs * 1e3) / 1e3;
intstr_(&hours, hstr + (bh - 1), 16 - (bh - 1));
intstr_(&mins, mstr + (bm - 1), 16 - (bm - 1));
dpstrf_(&secs, &c__6, "F", sstr, (ftnlen)1, (ftnlen)16);
/* The form of the output for SSTR has a leading blank followed by */
/* the first significant digit. If a decimal point is in the */
/* third slot, then SSTR is of the form ' x.xxxxx' and we need */
/* to insert a leading zero. */
if (*(unsigned char *)&sstr[2] == '.') {
*(unsigned char *)sstr = '0';
}
/* We don't want any leading spaces in SSTR, (HSTR and MSTR don't */
/* have leading spaces by construction. */
ljust_(sstr, sstr, (ftnlen)16, (ftnlen)16);
/* Now form the date string, squeeze out extra spaces and */
/* left justify the whole thing. */
/* Writing concatenation */
i__3[0] = 16, a__1[0] = messge;
i__3[1] = 16, a__1[1] = ystr;
i__3[2] = 16, a__1[2] = era;
i__3[3] = 3, a__1[3] = months + ((i__1 = month - 1) < 12 && 0 <= i__1 ?
i__1 : s_rnge("months", i__1, "etcal_", (ftnlen)810)) * 3;
i__3[4] = 1, a__1[4] = " ";
i__3[5] = 3, a__1[5] = dstr;
i__3[6] = 1, a__1[6] = " ";
i__3[7] = 2, a__1[7] = hstr;
i__3[8] = 1, a__1[8] = ":";
i__3[9] = 2, a__1[9] = mstr;
i__3[10] = 1, a__1[10] = ":";
i__3[11] = 6, a__1[11] = sstr;
s_cat(date, a__1, i__3, &c__12, (ftnlen)180);
cmprss_(" ", &c__1, date, date, (ftnlen)1, (ftnlen)180, (ftnlen)180);
ljust_(date, date, (ftnlen)180, (ftnlen)180);
s_copy(string, date, string_len, (ftnlen)180);
return 0;
} /* etcal_ */
/* $Procedure PRINST (Display string of CK-file summary) */
/* Subroutine */ int prinst_0_(int n__, integer *id, doublereal *tbegin,
doublereal *tend, integer *avflag, integer *frame, char *tout,
logical *fdsp, logical *tdsp, logical *gdsp, logical *ndsp, ftnlen
tout_len)
{
/* Initialized data */
static doublereal tbprev = 0.;
static doublereal teprev = 0.;
static integer idprev = 0;
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer hint;
extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
ftnlen, ftnlen, ftnlen);
integer scidw;
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
extern integer rtrim_(char *, ftnlen);
integer frcode;
extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char
*, integer *, logical *, ftnlen);
char idline[256], fnline[256], tbline[256], avline[256], teline[256];
extern /* Subroutine */ int timecn_(doublereal *, integer *, char *, char
*, ftnlen, ftnlen), frmnam_(integer *, char *, ftnlen), repmcw_(
char *, char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen,
ftnlen);
char outlin[256];
extern /* Subroutine */ int tostdo_(char *, ftnlen), intstr_(integer *,
char *, ftnlen);
/* $ Abstract */
/* Write a single CK-file summary record string to standard */
/* output in requested format. */
/* $ 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 */
/* CKBRIEF.UG */
/* $ Keywords */
/* SUMMARY */
/* CK */
/* $ Declarations */
/* $ 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. */
/* $ Author_and_Institution */
/* Y.K. Zaiko (BERC) */
/* B.V. Semenov (NAIF) */
/* $ Version */
/* - Toolkit Version 6.1.0, 27-JUN-2014 (BVS) */
/* BUG FIX: changed logic to make a combination of -a and an ID */
/* specified on the command line work in all cases. */
/* - CKBRIEF Version 6.0.0, 2014-04-28 (BVS) (NJB) */
/* Modified to treat all files as a single file (-a). */
/* Changed SCLKD display format to include 6 decimal */
/* places. */
/* Increased MAXBOD to 1,000,000 (from 100,000) and CMDSIZ to */
/* 50,000 (from 25,000). */
/* Added support for CK type 6. */
/* - CKBRIEF Version 5.0.0, 2009-02-11 (BVS) */
/* Updated version. */
/* - CKBRIEF Version 4.0.0, 2008-01-13 (BVS) */
/* Increased MAXBOD to 100,000 (from 10,000). */
/* Increased CMDSIZ to 25,000 (from 4,000). */
/* Updated version string and changed its format to */
/* '#.#.#, Month DD, YYYY' (from '#.#.#, YYYY-MM-DD'). */
/* - CKBRIEF Version 3.2.0, 2006-11-02 (BVS) */
/* Updated version string. */
/* - CKBRIEF Version 3.1.0, 2005-11-08 (BVS) */
/* Updated version string. */
/* - CKBRIEF Version 2.0.0, 2001-05-16 (BVS) */
/* Increased MAXBOD to 10000 (from 4000). Set LRGWIN to be */
/* MAXBOD*2 (was MAXBOD). Changed version string. */
/* - CKBRIEF Version 1.1.2, 2001-04-09 (BVS) */
/* Changed version parameter. */
/* - CKBRIEF Version 1.0.0 beta, 1999-02-17 (YKZ)(BVS) */
/* Initial release. */
/* -& */
/* The Version is stored as a string. */
/* The maximum number of segments or interpolation intervals */
/* that can be summarized is stored in the parameter MAXBOD. */
/* This is THE LIMIT that should be increased if window */
/* routines called by CKBRIEF fail. */
/* The largest expected window -- must be twice the size of */
/* MAXBOD for consistency. */
/* The longest command line that can be accommodated is */
/* given by CMDSIZ. */
/* MAXUSE is the maximum number of objects that can be explicitly */
/* specified on the command line for ckbrief summaries. */
/* Generic line size for all modules. */
/* Time type keys. */
/* Output time format pictures. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ID I NAIF ID code of object */
/* TBEGIN I Start time of object coverage interval, SCLK ticks */
/* TEND I End time of object coverage interval, SCLK ticks */
/* AVFLAG I Angular velocity flag */
/* FRAME I NAIF ID code of reference frame */
/* TOUT I Key specifying times representation on output */
/* FDSP I Flag defining whether frames name/id is printed */
/* TDSP I Flag defining tabular/non-tabular summary format */
/* GDSP I Flag requesting object grouping by coverage */
/* NDSP I Flag to display frame assosiated with CK ID */
/* $ Detailed_Input */
/* ID Integer NAIF ID code found in summaries */
/* of CK-file and to be written to standard output. */
/* TBEGIN Begin time for object coverage given as DP */
/* SCLK ticks. */
/* TEND End time for object coverage given as DP */
/* SCLK ticks. */
/* AVFLAG Angular velocities presence flag: 0 - not present, */
/* 1 - present, 2 - mixed. */
/* FRAME Integer NAIF ID code of reference frame relative */
/* to which orientation of the ID was given. */
/* TOUT Key specifying time representation on output: */
/* SCLK string, encoded SCLK, ET, UTC or DOY */
/* FDSP Flag defining whether name or ID code of the */
/* FRAME should appear on output. */
/* TDSP Flag defining whether summaries have to be written */
/* in tabular or non-tabular format. */
/* GDSP Flag defining whether objects with the same */
/* coverage must be grouped together. */
/* NDSP Flag requesting display of the name of the frame */
/* associated with CK ID. */
/* $ Detailed_Output */
/* None. This subroutine displays summary line for a CK-file/segment */
/* for subroutine DISPSM. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* Y.K. Zaiko (BERC) */
/* B.V. Semenov (NAIF) */
/* $ Version */
/* - CKBRIEF Beta Version 2.0.0, 13-OCT-2008 (BVS) */
/* Added NDSP argument. Changed to display frame names associated */
/* with CK IDs when NDSP is .TRUE.. */
/* - CKBRIEF Beta Version 1.0.0, 17-FEB-1999 (YKZ)(BVS) */
/* -& */
/* SPICELIB functions */
/* Local parameters. */
/* Output fields widths. */
/* Preset output values. */
/* Local variables */
/* Save previous time boundaries and ID code. */
/* Set initial value to zeros. */
switch(n__) {
case 1: goto L_prinsr;
}
/* Convert all inputs to strings that will appear on output. */
if (*ndsp) {
scidw = 26;
ccifrm_(&c__3, id, &frcode, idline, &hint, &found, (ftnlen)256);
if (! found) {
s_copy(idline, "NO FRAME FOR #", (ftnlen)256, (ftnlen)14);
repmi_(idline, "#", id, idline, (ftnlen)256, (ftnlen)1, (ftnlen)
256);
}
} else {
scidw = 8;
intstr_(id, idline, (ftnlen)256);
}
timecn_(tbegin, id, tout, tbline, tout_len, (ftnlen)256);
timecn_(tend, id, tout, teline, tout_len, (ftnlen)256);
if (*avflag == 2) {
s_copy(avline, "*", (ftnlen)256, (ftnlen)1);
} else if (*avflag == 1) {
s_copy(avline, "Y", (ftnlen)256, (ftnlen)1);
} else {
s_copy(avline, "N", (ftnlen)256, (ftnlen)1);
}
frmnam_(frame, fnline, (ftnlen)256);
if (s_cmp(fnline, " ", (ftnlen)256, (ftnlen)1) == 0) {
if (*frame == 0) {
s_copy(fnline, "MIXED", (ftnlen)256, (ftnlen)5);
} else {
intstr_(frame, fnline, (ftnlen)256);
}
}
/* Make up output string and print them depending on what kind of */
/* output format was requested. */
if (*tdsp) {
/* For table output, set output line template depending on */
/* whether FRAME display was requested. */
if (*fdsp) {
s_copy(outlin, "# # # # #", (ftnlen)256, (ftnlen)11);
} else {
s_copy(outlin, "# # # #", (ftnlen)256, (ftnlen)7);
}
/* Check whether coverage is the same as previous one and */
/* reassign begin and end time to 'same' flag if so. */
if (*tbegin == tbprev && *tend == teprev && s_cmp(tbline, "NEED LSK "
"AND SCLK FILES", (ftnlen)256, (ftnlen)23) != 0 && s_cmp(
teline, "NEED LSK AND SCLK FILES", (ftnlen)256, (ftnlen)23) !=
0) {
s_copy(tbline, " -- same --", (ftnlen)256, (ftnlen)13);
s_copy(teline, " -- same --", (ftnlen)256, (ftnlen)13);
}
/* Substitute string and print out the line. */
repmcw_(outlin, "#", idline, &scidw, outlin, (ftnlen)256, (ftnlen)1, (
ftnlen)256, (ftnlen)256);
repmcw_(outlin, "#", tbline, &c__24, outlin, (ftnlen)256, (ftnlen)1, (
ftnlen)256, (ftnlen)256);
repmcw_(outlin, "#", teline, &c__24, outlin, (ftnlen)256, (ftnlen)1, (
ftnlen)256, (ftnlen)256);
repmcw_(outlin, "#", avline, &c__1, outlin, (ftnlen)256, (ftnlen)1, (
ftnlen)256, (ftnlen)256);
repmcw_(outlin, "#", fnline, &c__32, outlin, (ftnlen)256, (ftnlen)1, (
ftnlen)256, (ftnlen)256);
/* Display the line. */
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
} else {
/* If grouping flag is set, we display single coverage line for */
/* multiple objects. If it's not set, we display multiple */
/* coverage lines for a single object. Also when GDSP set we do */
/* NOT display angular velocity flags or FRAME names/ids. */
if (*gdsp) {
if (*tbegin == tbprev && *tend == teprev) {
/* This is another object in a group with the same */
/* coverage. Display just the object ID. */
s_copy(outlin, " #", (ftnlen)256, (ftnlen)10);
} else {
/* This is the first object in a group with a different */
/* coverage. Display blank line, coverage and ID of the */
/* first object. */
tostdo_(" ", (ftnlen)1);
s_copy(outlin, "Begin #: # End #: # ", (ftnlen)256, (ftnlen)
21);
repmc_(outlin, "#", tout, outlin, (ftnlen)256, (ftnlen)1,
tout_len, (ftnlen)256);
repmcw_(outlin, "#", tbline, &c__24, outlin, (ftnlen)256, (
ftnlen)1, (ftnlen)256, (ftnlen)256);
repmc_(outlin, "#", tout, outlin, (ftnlen)256, (ftnlen)1,
tout_len, (ftnlen)256);
repmcw_(outlin, "#", teline, &c__24, outlin, (ftnlen)256, (
ftnlen)1, (ftnlen)256, (ftnlen)256);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
if (*ndsp) {
s_copy(outlin, "Frames: #", (ftnlen)256, (ftnlen)10);
} else {
s_copy(outlin, "Objects: #", (ftnlen)256, (ftnlen)10);
}
}
repmcw_(outlin, "#", idline, &scidw, outlin, (ftnlen)256, (ftnlen)
1, (ftnlen)256, (ftnlen)256);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
} else {
/* No grouping by time was requested. So, display contains */
/* sets of coverage intervals for a particular object. */
if (*id == idprev) {
/* It's the same object. Print out only interval. */
if (*fdsp) {
s_copy(outlin, " # # # #", (ftnlen)256, (ftnlen)11);
} else {
s_copy(outlin, " # # #", (ftnlen)256, (ftnlen)7);
}
} else {
/* It's another object. Print object ID, header and */
/* the first interval. */
tostdo_(" ", (ftnlen)1);
if (*ndsp) {
s_copy(outlin, "Frame: #", (ftnlen)256, (ftnlen)10);
} else {
s_copy(outlin, "Object: #", (ftnlen)256, (ftnlen)10);
}
repmcw_(outlin, "#", idline, &scidw, outlin, (ftnlen)256, (
ftnlen)1, (ftnlen)256, (ftnlen)256);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
if (*fdsp) {
s_copy(outlin, " Interval Begin ####### Interval End "
"####### AV Relative to FRAME", (ftnlen)256, (
ftnlen)73);
i__1 = rtrim_("#######", (ftnlen)7);
repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
256, (ftnlen)7, tout_len, (ftnlen)256);
i__1 = rtrim_("#######", (ftnlen)7);
repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
256, (ftnlen)7, tout_len, (ftnlen)256);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
s_copy(outlin, " ------------------------ -------------"
"----------- --- ----------------- ", (ftnlen)256,
(ftnlen)74);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
s_copy(outlin, " # # # #", (ftnlen)256, (ftnlen)11);
} else {
s_copy(outlin, " Interval Begin ####### Interval End "
"####### AV ", (ftnlen)256, (ftnlen)56);
i__1 = rtrim_("#######", (ftnlen)7);
repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
256, (ftnlen)7, tout_len, (ftnlen)256);
i__1 = rtrim_("#######", (ftnlen)7);
repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
256, (ftnlen)7, tout_len, (ftnlen)256);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
s_copy(outlin, " ------------------------ -------------"
"----------- --- ", (ftnlen)256, (ftnlen)56);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
s_copy(outlin, " # # #", (ftnlen)256, (ftnlen)7);
}
}
repmcw_(outlin, "#", tbline, &c__24, outlin, (ftnlen)256, (ftnlen)
1, (ftnlen)256, (ftnlen)256);
repmcw_(outlin, "#", teline, &c__24, outlin, (ftnlen)256, (ftnlen)
1, (ftnlen)256, (ftnlen)256);
repmcw_(outlin, "#", avline, &c__1, outlin, (ftnlen)256, (ftnlen)
1, (ftnlen)256, (ftnlen)256);
repmcw_(outlin, "#", fnline, &c__32, outlin, (ftnlen)256, (ftnlen)
1, (ftnlen)256, (ftnlen)256);
tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
}
}
/* Reassign saved variables. */
tbprev = *tbegin;
teprev = *tend;
idprev = *id;
return 0;
/* $Procedure PRINSR (Reset saved variables) */
L_prinsr:
/* $ Abstract */
/* This entry point resets saved ID and start and stop time) */
/* to make sure that CKBRIEF generates table headers correctly. */
/* $ 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 */
/* CKBRIEF.UG */
/* $ Keywords */
/* SUMMARY */
/* CK */
/* $ Declarations */
/* None. */
/* $ Brief_I/O */
/* None. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* Y.K. Zaiko (BERC) */
/* B.V. Semenov (NAIF) */
/* $ Version */
/* - CKBRIEF Beta Version 2.0.0, 13-OCT-2008 (BVS) */
/* -& */
tbprev = 0.;
teprev = 0.;
idprev = 0;
return 0;
} /* prinst_ */
/* $Procedure TKFRAM (Text kernel frame transformation ) */
/* Subroutine */ int tkfram_(integer *id, doublereal *rot, integer *frame,
logical *found)
{
/* Initialized data */
static integer at = 0;
static logical first = TRUE_;
/* System generated locals */
address a__1[2];
integer i__1, i__2[2], i__3;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static char name__[32];
static integer tail;
static char spec[32], item[32*14];
static integer idnt[1], axes[3];
static logical full;
static integer pool[52] /* was [2][26] */;
extern doublereal vdot_(doublereal *, doublereal *);
static char type__[1];
static doublereal qtmp[4];
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
static integer i__, n, r__;
static doublereal buffd[180] /* was [9][20] */;
static integer buffi[20] /* was [1][20] */, oldid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static char agent[32];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
ident_(doublereal *), errch_(char *, char *, ftnlen, ftnlen);
static doublereal tempd;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, vhatg_(doublereal *, integer *, doublereal *);
extern integer lnktl_(integer *, integer *);
static char idstr[32];
extern integer rtrim_(char *, ftnlen);
static char versn[8], units[32];
static integer ar;
extern logical failed_(void), badkpv_(char *, char *, char *, integer *,
integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
static char frname[32];
static doublereal angles[3];
static char oldagt[32];
static logical buffrd;
extern /* Subroutine */ int locati_(integer *, integer *, integer *,
integer *, integer *, logical *), frmnam_(integer *, char *,
ftnlen), namfrm_(char *, integer *, ftnlen);
static logical update;
static char altnat[32];
extern /* Subroutine */ int lnkini_(integer *, integer *);
extern integer lnknfn_(integer *);
static integer idents[20] /* was [1][20] */;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen), gdpool_(char *, integer *,
integer *, integer *, doublereal *, logical *, ftnlen), sigerr_(
char *, ftnlen), gipool_(char *, integer *, integer *, integer *,
integer *, logical *, ftnlen), chkout_(char *, ftnlen), sharpr_(
doublereal *), dtpool_(char *, logical *, integer *, char *,
ftnlen, ftnlen), setmsg_(char *, ftnlen);
static doublereal matrix[9] /* was [3][3] */;
extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), dwpool_(
char *, ftnlen), errint_(char *, integer *, ftnlen), vsclip_(
doublereal *, doublereal *);
static doublereal quatrn[4];
extern /* Subroutine */ int convrt_(doublereal *, char *, char *,
doublereal *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int q2m_(doublereal *, doublereal *), intstr_(
integer *, char *, ftnlen), swpool_(char *, integer *, char *,
ftnlen, ftnlen);
static logical fnd;
static char alt[32*14];
/* $ Abstract */
/* This routine returns the rotation from the input frame */
/* specified by ID to the associated frame given by FRAME. */
/* $ 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 */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ---------------------------------------------- */
/* ID I Class identification code for the instrument */
/* ROT O The rotation from ID to FRAME. */
/* FRAME O The integer code of some reference frame. */
/* FOUND O TRUE if the rotation could be determined. */
/* $ Detailed_Input */
/* ID The identification code used to specify an */
/* instrument in the SPICE system. */
/* $ Detailed_Output */
/* ROT is a rotation matrix that gives the transformation */
/* from the frame specified by ID to the frame */
/* specified by FRAME. */
/* FRAME is the id code of the frame used to define the */
/* orientation of the frame given by ID. ROT gives */
/* the transformation from the IF frame to */
/* the frame specified by FRAME. */
/* FOUND is a logical indicating whether or not a frame */
/* definition for frame ID was constructed from */
/* kernel pool data. If ROT and FRAME were constructed */
/* FOUND will be returned with the value TRUE. */
/* Otherwise it will be returned with the value FALSE. */
/* $ Parameters */
/* BUFSIZ is the number of rotation, frame id pairs that */
/* can have their instance data buffered for the */
/* sake of improving run-time performance. This */
/* value MUST be positive and should probably be */
/* at least 10. */
/* $ Exceptions */
/* 1) If some instance value associated with this frame */
/* cannot be located, or does not have the proper type */
/* or dimension, the error will be diagnosed by the */
/* routine BADKPV. In such a case FOUND will be set to .FALSE. */
/* 2) If the input ID has the value 0, the error */
/* SPICE(ZEROFRAMEID) will be signaled. FOUND will be set */
/* to FALSE. */
/* 3) If the name of the frame corresponding to ID cannot be */
/* determined, the error 'SPICE(INCOMPLETEFRAME)' is signaled. */
/* 4) If the frame given by ID is defined relative to a frame */
/* that is unrecognized, the error SPICE(BADFRAMESPEC) */
/* will be signaled. FOUND will be set to FALSE. */
/* 5) If the kernel pool specification for ID is not one of */
/* MATRIX, ANGLES, or QUATERNION, then the error */
/* SPICE(UNKNOWNFRAMESPEC) will be signaled. FOUND will be */
/* set to FALSE. */
/* $ Files */
/* This routine makes use of the loaded text kernels to */
/* determine the rotation from a constant offset frame */
/* to its defining frame. */
/* $ Particulars */
/* This routine is used to construct the rotation from some frame */
/* that is a constant rotation offset from some other reference */
/* frame. This rotation is derived from data stored in the kernel */
/* pool. */
/* It is considered to be an low level routine that */
/* will need to be called directly only by persons performing */
/* high volume processing. */
/* $ Examples */
/* This is intended to be used as a low level routine by */
/* the frame system software. However, you could use this */
/* routine to directly retrieve the rotation from an offset */
/* frame to its relative frame. One instance in which you */
/* might do this is if you have a properly specified topocentric */
/* frame for some site on earth and you wish to determine */
/* the geodetic latitude and longitude of the site. Here's how. */
/* Suppose the name of the topocentric frame is: 'MYTOPO'. */
/* First we get the id-code of the topocentric frame. */
/* CALL NAMFRM ( 'MYTOPO', FRCODE ) */
/* Next get the rotation from the topocentric frame to */
/* the bodyfixed frame. */
/* CALL TKFRAM ( FRCODE, ROT, FRAME, FOUND ) */
/* Make sure the topoframe is relative to one of the earth */
/* fixed frames. */
/* CALL FRMNAM( FRAME, TEST ) */
/* IF ( TEST .NE. 'IAU_EARTH' */
/* . .AND. TEST .NE. 'EARTH_FIXED' */
/* . .AND. TEST .NE. 'ITRF93' ) THEN */
/* WRITE (*,*) 'The frame MYTOPO does not appear to be ' */
/* WRITE (*,*) 'defined relative to an earth fixed frame.' */
/* STOP */
/* END IF */
/* Things look ok. Get the location of the Z-axis in the */
/* topocentric frame. */
/* Z(1) = ROT(1,3) */
/* Z(2) = ROT(2,3) */
/* Z(3) = ROT(3,3) */
/* Convert the Z vector to latitude longitude and radius. */
/* CALL RECLAT ( Z, LAT, LONG, RAD ) */
/* WRITE (*,*) 'The geodetic coordinates of the center of' */
/* WRITE (*,*) 'the topographic frame are: ' */
/* WRITE (*,*) */
/* WRITE (*,*) 'Latitude (deg): ', LAT *DPR() */
/* WRITE (*,*) 'Longitude (deg): ', LONG*DPR() */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.0, 23-APR-2009 (NJB) */
/* Bug fix: watch is deleted only for frames */
/* that are deleted from the buffer. */
/* - SPICELIB Version 2.0.0, 19-MAR-2009 (NJB) */
/* Bug fix: this routine now deletes watches set on */
/* kernel variables of frames that are discarded from */
/* the local buffering system. */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* - SPICELIB Version 1.1.0, 21-NOV-2001 (FST) */
/* Updated this routine to dump the buffer of frame ID codes */
/* it saves when it or one of the modules in its call tree signals */
/* an error. This fixes a bug where a frame's ID code is */
/* buffered, but the matrix and kernel pool watcher were not set */
/* properly. */
/* - SPICELIB Version 1.0.0, 18-NOV-1996 (WLT) */
/* -& */
/* $ Index_Entries */
/* Fetch the rotation and frame of a text kernel frame */
/* Fetch the rotation and frame of a constant offset frame */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Local Variables */
/* Saved variables */
/* Initial values */
/* Programmer's note: this routine makes use of the *implementation* */
/* of LOCATI. If that routine is changed, the logic this routine */
/* uses to locate buffered, old frame IDs may need to change as well. */
/* Before we even check in, if N is less than 1 we can */
/* just return. */
/* Perform any initializations that might be needed for this */
/* routine. */
if (first) {
first = FALSE_;
s_copy(versn, "1.0.0", (ftnlen)8, (ftnlen)5);
lnkini_(&c__20, pool);
}
/* Now do the standard SPICE error handling. Sure this is */
/* a bit unconventional, but nothing will be hurt by doing */
/* the stuff above first. */
if (return_()) {
return 0;
}
chkin_("TKFRAM", (ftnlen)6);
/* So far, we've not FOUND the rotation to the specified frame. */
*found = FALSE_;
/* Check the ID to make sure it is non-zero. */
if (*id == 0) {
lnkini_(&c__20, pool);
setmsg_("Frame identification codes are required to be non-zero. Yo"
"u've specified a frame with ID value zero. ", (ftnlen)102);
sigerr_("SPICE(ZEROFRAMEID)", (ftnlen)18);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Find out whether our linked list pool is already full. */
/* We'll use this information later to decide whether we're */
/* going to have to delete a watcher. */
full = lnknfn_(pool) == 0;
if (full) {
/* If the input frame ID is not buffered, we'll need to */
/* overwrite an existing buffer entry. In this case */
/* the call to LOCATI we're about to make will overwrite */
/* the ID code in the slot we're about to use. We need */
/* this ID code, so extract it now while we have the */
/* opportunity. The old ID sits at the tail of the list */
/* whose head node is AT. */
tail = lnktl_(&at, pool);
oldid = idents[(i__1 = tail - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"idents", i__1, "tkfram_", (ftnlen)413)];
/* Create the name of the agent associated with the old */
/* frame. */
s_copy(oldagt, "TKFRAME_#", (ftnlen)32, (ftnlen)9);
repmi_(oldagt, "#", &oldid, oldagt, (ftnlen)32, (ftnlen)1, (ftnlen)32)
;
}
/* Look up the address of the instance data. */
idnt[0] = *id;
locati_(idnt, &c__1, idents, pool, &at, &buffrd);
if (full && ! buffrd) {
/* Since the buffer is already full, we'll delete the watcher for */
/* the kernel variables associated with OLDID, since there's no */
/* longer a need for that watcher. */
/* First clear the update status of the old agent; DWPOOL won't */
/* delete an agent with a unchecked update. */
cvpool_(oldagt, &update, (ftnlen)32);
dwpool_(oldagt, (ftnlen)32);
}
/* Until we have better information we put the identity matrix */
/* into the output rotation and set FRAME to zero. */
ident_(rot);
*frame = 0;
/* If we have to look up the data for our frame, we do */
/* it now and perform any conversions and computations that */
/* will be needed when it's time to convert coordinates to */
/* directions. */
/* Construct the name of the agent associated with the */
/* requested frame. (Each frame has its own agent). */
intstr_(id, idstr, (ftnlen)32);
frmnam_(id, frname, (ftnlen)32);
if (s_cmp(frname, " ", (ftnlen)32, (ftnlen)1) == 0) {
lnkini_(&c__20, pool);
setmsg_("The Text Kernel (TK) frame with id-code # does not have a r"
"ecognized name. ", (ftnlen)75);
errint_("#", id, (ftnlen)1);
sigerr_("SPICE(INCOMPLETFRAME)", (ftnlen)21);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = idstr;
s_cat(agent, a__1, i__2, &c__2, (ftnlen)32);
r__ = rtrim_(agent, (ftnlen)32);
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = frname;
s_cat(altnat, a__1, i__2, &c__2, (ftnlen)32);
ar = rtrim_(altnat, (ftnlen)32);
/* If the frame is buffered, we check the kernel pool to */
/* see if there has been an update to this frame. */
if (buffrd) {
cvpool_(agent, &update, r__);
} else {
/* If the frame is not buffered we definitely need to update */
/* things. */
update = TRUE_;
}
if (! update) {
/* Just look up the rotation matrix and relative-to */
/* information from the local buffer. */
rot[0] = buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)506)];
rot[1] = buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)507)];
rot[2] = buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)508)];
rot[3] = buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)509)];
rot[4] = buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)510)];
rot[5] = buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)511)];
rot[6] = buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)512)];
rot[7] = buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)513)];
rot[8] = buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)514)];
*frame = buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"buffi", i__1, "tkfram_", (ftnlen)516)];
} else {
/* Determine how the frame is specified and what it */
/* is relative to. The variables that specify */
/* how the frame is represented and what it is relative to */
/* are TKFRAME_#_SPEC and TKFRAME_#_RELATIVE where # is */
/* replaced by the text value of ID or the frame name. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(alt, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(alt + 32, a__1, i__2, &c__2, (ftnlen)32);
/* See if the friendlier version of the kernel pool variables */
/* are available. */
for (i__ = 1; i__ <= 2; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)537)) << 5), found,
&n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("item", i__1, "tkfram_", (ftnlen)540)) << 5),
alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ? i__3 :
s_rnge("alt", i__3, "tkfram_", (ftnlen)540)) << 5), (
ftnlen)32, (ftnlen)32);
}
}
/* If either the SPEC or RELATIVE frame are missing from */
/* the kernel pool, we simply return. */
if (badkpv_("TKFRAM", item, "=", &c__1, &c__1, "C", (ftnlen)6, (
ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM", item +
32, "=", &c__1, &c__1, "C", (ftnlen)6, (ftnlen)32, (ftnlen)1,
(ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* If we make it this far, look up the SPEC and RELATIVE frame. */
gcpool_(item, &c__1, &c__1, &n, spec, &fnd, (ftnlen)32, (ftnlen)32);
gcpool_(item + 32, &c__1, &c__1, &n, name__, &fnd, (ftnlen)32, (
ftnlen)32);
/* Look up the id-code for this frame. */
namfrm_(name__, frame, (ftnlen)32);
if (*frame == 0) {
lnkini_(&c__20, pool);
setmsg_("The frame to which frame # is relatively defined is not"
" recognized. The kernel pool specification of the relati"
"ve frame is '#'. This is not a recognized frame. ", (
ftnlen)161);
errint_("#", id, (ftnlen)1);
errch_("#", name__, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BADFRAMESPEC)", (ftnlen)19);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Convert SPEC to upper case so that we can easily check */
/* to see if this is one of the expected specification types. */
ucase_(spec, spec, (ftnlen)32, (ftnlen)32);
if (s_cmp(spec, "MATRIX", (ftnlen)32, (ftnlen)6) == 0) {
/* This is the easiest case. Just grab the matrix */
/* from the kernel pool (and polish it up a bit just */
/* to make sure we have a rotation matrix). */
/* We give preference to the kernel pool variable */
/* TKFRAME_<name>_MATRIX if it is available. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__9, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* The variable meets current expectations, look it up */
/* from the kernel pool. */
gdpool_(item + 64, &c__1, &c__9, &n, matrix, &fnd, (ftnlen)32);
/* In this case the full transformation matrix has been */
/* specified. We simply polish it up a bit. */
moved_(matrix, &c__9, rot);
sharpr_(rot);
/* The matrix might not be right-handed, so correct */
/* the sense of the second and third columns if necessary. */
if (vdot_(&rot[3], &matrix[3]) < 0.) {
vsclip_(&c_b95, &rot[3]);
}
if (vdot_(&rot[6], &matrix[6]) < 0.) {
vsclip_(&c_b95, &rot[6]);
}
} else if (s_cmp(spec, "ANGLES", (ftnlen)32, (ftnlen)6) == 0) {
/* Look up the angles, their units and axes for the */
/* frame specified by ID. (Note that UNITS are optional). */
/* As in the previous case we give preference to the */
/* form TKFRAME_<name>_<item> over TKFRAME_<id>_<item>. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(alt + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(alt + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Again, we give preference to the more friendly form */
/* of TKFRAME specification. */
for (i__ = 3; i__ <= 5; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)668)) << 5),
found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1
: s_rnge("item", i__1, "tkfram_", (ftnlen)671)) <<
5), alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ?
i__3 : s_rnge("alt", i__3, "tkfram_", (ftnlen)671)
) << 5), (ftnlen)32, (ftnlen)32);
}
}
if (badkpv_("TKFRAM", item + 64, "=", &c__3, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM",
item + 96, "=", &c__3, &c__1, "N", (ftnlen)6, (ftnlen)32,
(ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
s_copy(units, "RADIANS", (ftnlen)32, (ftnlen)7);
gdpool_(item + 64, &c__1, &c__3, &n, angles, &fnd, (ftnlen)32);
gipool_(item + 96, &c__1, &c__3, &n, axes, &fnd, (ftnlen)32);
gcpool_(item + 128, &c__1, &c__1, &n, units, &fnd, (ftnlen)32, (
ftnlen)32);
/* Convert angles to radians. */
for (i__ = 1; i__ <= 3; ++i__) {
convrt_(&angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("angles", i__1, "tkfram_", (ftnlen)700)],
units, "RADIANS", &tempd, (ftnlen)32, (ftnlen)7);
angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"angles", i__1, "tkfram_", (ftnlen)701)] = tempd;
}
if (failed_()) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Compute the rotation from instrument frame to CK frame. */
eul2m_(angles, &angles[1], &angles[2], axes, &axes[1], &axes[2],
rot);
} else if (s_cmp(spec, "QUATERNION", (ftnlen)32, (ftnlen)10) == 0) {
/* Look up the quaternion and convert it to a rotation */
/* matrix. Again there are two possible variables that */
/* may point to the quaternion. We give preference to */
/* the form TKFRAME_<name>_Q over the form TKFRAME_<id>_Q. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__4, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* In this case we have the quaternion representation. */
/* Again, we do a small amount of polishing of the input. */
gdpool_(item + 64, &c__1, &c__4, &n, quatrn, &fnd, (ftnlen)32);
vhatg_(quatrn, &c__4, qtmp);
q2m_(qtmp, rot);
} else {
/* We don't recognize the SPEC for this frame. Say */
/* so. Also note that perhaps the user needs to upgrade */
/* the toolkit. */
lnkini_(&c__20, pool);
setmsg_("The frame specification \"# = '#'\" is not one of the r"
"econized means of specifying a text-kernel constant offs"
"et frame (as of version # of the routine TKFRAM). This m"
"ay reflect a typographical error or may indicate that yo"
"u need to consider updating your version of the SPICE to"
"olkit. ", (ftnlen)284);
errch_("#", item, (ftnlen)1, (ftnlen)32);
errch_("#", spec, (ftnlen)1, (ftnlen)32);
errch_("#", versn, (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(UNKNOWNFRAMESPEC)", (ftnlen)23);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Buffer the identifier, relative frame and rotation matrix. */
buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)784)] = rot[0];
buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)785)] = rot[1];
buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)786)] = rot[2];
buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)787)] = rot[3];
buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)788)] = rot[4];
buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)789)] = rot[5];
buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)790)] = rot[6];
buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)791)] = rot[7];
buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)792)] = rot[8];
buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("buffi", i__1,
"tkfram_", (ftnlen)794)] = *frame;
/* If these were not previously buffered, we need to set */
/* a watch on the various items that might be used to define */
/* this frame. */
if (! buffrd) {
/* Immediately check for an update so that we will */
/* not redundantly look for this item the next time this */
/* routine is called. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 160, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 192, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 224, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 256, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 288, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 320, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 352, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 384, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 416, a__1, i__2, &c__2, (ftnlen)32);
swpool_(agent, &c__14, item, (ftnlen)32, (ftnlen)32);
cvpool_(agent, &update, (ftnlen)32);
}
}
if (failed_()) {
lnkini_(&c__20, pool);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* All errors cause the routine to exit before we get to this */
/* point. If we reach this point we didn't have an error and */
/* hence did find the rotation from ID to FRAME. */
*found = TRUE_;
/* That's it */
chkout_("TKFRAM", (ftnlen)6);
return 0;
} /* tkfram_ */
/* $Procedure WRLINE ( Write Output Line to a Device ) */
/* Subroutine */ int wrline_0_(int n__, char *device, char *line, ftnlen
device_len, ftnlen line_len)
{
/* System generated locals */
integer i__1;
cilist ci__1;
olist o__1;
cllist cl__1;
inlist ioin__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
integer *, char *, ftnlen), e_wsfe(void), f_inqu(inlist *),
s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void), f_open(olist *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer f_clos(cllist *);
/* Local variables */
integer unit;
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
extern integer ltrim_(char *, ftnlen);
char error[240];
extern integer rtrim_(char *, ftnlen);
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
logical opened;
extern /* Subroutine */ int fndlun_(integer *);
char tmpnam[128];
integer iostat;
extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen,
ftnlen);
logical exists;
char errstr[11];
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
/* Fortran I/O blocks */
static cilist io___6 = { 0, 6, 0, 0, 0 };
static cilist io___7 = { 0, 6, 0, 0, 0 };
static cilist io___8 = { 0, 6, 0, 0, 0 };
static cilist io___9 = { 0, 6, 0, 0, 0 };
static cilist io___10 = { 0, 6, 0, 0, 0 };
static cilist io___11 = { 0, 6, 0, 0, 0 };
static cilist io___12 = { 0, 6, 0, 0, 0 };
static cilist io___15 = { 0, 6, 0, 0, 0 };
static cilist io___16 = { 0, 6, 0, 0, 0 };
static cilist io___17 = { 0, 6, 0, 0, 0 };
static cilist io___18 = { 0, 6, 0, 0, 0 };
/* $ Abstract */
/* Write a character string to an output device. */
/* $ 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 */
/* TEXT */
/* FILES */
/* ERROR */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* DEVICE I A string specifying an output device. */
/* LINE I A line of text to be output. */
/* FILEN P Maximum length of a file name. */
/* $ Detailed_Input */
/* LINE is a line of text to be written to the output */
/* device specified by DEVICE. */
/* DEVICE is the output device to which the line of text */
/* will be written. */
/* Possible values and meanings of DEVICE are: */
/* a device name This may be the name of a */
/* file, or any other name that */
/* is valid in a FORTRAN OPEN */
/* statement. For example, on a */
/* VAX, a logical name may be */
/* used. */
/* The device name must not */
/* be any of the reserved strings */
/* below. */
/* 'SCREEN' The output will go to the */
/* terminal screen. */
/* 'NULL' The data will not be output. */
/* 'SCREEN' and 'NULL' can be written in mixed */
/* case. For example, the following call will work: */
/* CALL WRLINE ( 'screEn', LINE ) */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* FILEN is the maximum length of a file name. */
/* $ Exceptions */
/* This routine is a special case as far as error handling */
/* is concerned because it is called to output error */
/* messages resulting from errors detected by other routines. */
/* In such a case, calling SIGERR would constitute recursion. */
/* Therefore, this routine prints error messages rather */
/* than signalling errors via SIGERR and setting the long */
/* error message via SETMSG. */
/* The following exceptional cases are treated as errors: */
/* 1) SPICE(NOFREELOGICALUNIT) -- No logical unit number */
/* is available to refer to the device. */
/* 2) SPICE(FILEOPENFAILED) -- General file open error. */
/* 3) SPICE(FILEWRITEFAILED) -- General file write error. */
/* 4) SPICE(INQUIREFAILED) -- INQUIRE statement failed. */
/* 5) Leading blanks in (non-blank) file names are not */
/* significant. The file names */
/* 'MYFILE.DAT' */
/* ' MYFILE.DAT' */
/* are considered to name the same file. */
/* 6) If different names that indicate the same file are supplied */
/* to this routine on different calls, all output associated */
/* with these calls WILL be written to the file. For example, */
/* on a system where logical filenames are supported, if */
/* ALIAS is a logical name pointing to MYFILE, then the calls */
/* CALL WRLINE ( 'MYFILE', 'This is the first line' ) */
/* CALL WRLINE ( 'ALIAS', 'This is the second line' ) */
/* will place the lines of text */
/* 'This is the first line' */
/* 'This is the second line' */
/* in MYFILE. See $Restrictions for more information on use */
/* of logical names on VAX systems. */
/* $ Files */
/* 1) If DEVICE specifies a device other than 'SCREEN' or 'NULL', */
/* that device is opened (if it's not already open) as a NEW, */
/* SEQUENTIAL, FORMATTED file. The logical unit used is */
/* determined at run time. */
/* $ Particulars */
/* If the output device is a file that is not open, the file will */
/* be opened (if possible) as a NEW, sequential, formatted file, */
/* and the line of text will be written to the file. If the file */
/* is already opened as a sequential, formatted file, the line of */
/* text will be written to the file. */
/* Use the entry point CLLINE to close files opened by WRLINE. */
/* $ Examples */
/* 1) Write a message to the screen: */
/* CALL WRLINE ( 'SCREEN', 'Here''s a message.' ) */
/* The text */
/* Here's a message. */
/* will be written to the screen. */
/* 2) Write out all of the elements of a character string array */
/* to a file. */
/* CHARACTER*(80) STRING ( ASIZE ) */
/* . */
/* . */
/* . */
/* DO I = 1, ASIZE */
/* CALL WRLINE ( FILE, STRING(I) ) */
/* END DO */
/* 3) Set DEVICE to NULL to suppress output: */
/* C */
/* C Ask the user whether verbose program output is */
/* C desired. Set the output device accordingly. */
/* C */
/* WRITE (*,*) 'Do you want to see test results ' // */
/* . 'on the screen?' */
/* READ (*,FMT='(A)') VERBOS */
/* CALL LJUST ( VERBOS, VERBOS ) */
/* CALL UCASE ( VERBOS, VERBOS ) */
/* IF ( VERBOS(1:1) .EQ. 'Y' ) THEN */
/* DEVICE = 'SCREEN' */
/* ELSE */
/* DEVICE = 'NULL' */
/* ENDIF */
/* . */
/* . */
/* . */
/* C */
/* C Output test results. */
/* C */
/* CALL WRLINE ( DEVICE, STRING ) */
/* . */
/* . */
/* . */
/* $ Restrictions */
/* 1) File names must not exceed FILEN characters. */
/* 2) On VAX systems, caution should be exercised when using */
/* multiple logical names to point to the same file. Logical */
/* name translation supporting execution of the Fortran */
/* INQUIRE statement does not appear to work reliably in all */
/* cases, which may lead this routine to believe that different */
/* logical names indicate different files. The specific problem */
/* that has been observed is that logical names that include */
/* disk specifications are not always recognized as pointing */
/* to the file they actually name. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* $ Version */
/* - SPICELIB Version 4.25.0, 10-MAR-2014 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-INTEL. */
/* - SPICELIB Version 4.24.0, 10-MAR-2014 (BVS) */
/* Updated for PC-LINUX-64BIT-IFORT. */
/* - SPICELIB Version 4.23.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-GFORTRAN. */
/* - SPICELIB Version 4.22.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.21.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GCC_C. */
/* - SPICELIB Version 4.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 4.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 4.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 4.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 4.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 4.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 4.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 4.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 4.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 4.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 4.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 4.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 4.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 4.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 4.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 4.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 4.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 4.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are WIN-NT */
/* - SPICELIB Version 4.0.3, 16-SEP-1999 (NJB) */
/* CSPICE environments were added. Some typos were corrected. */
/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */
/* References to the PC-LINUX environment were added. The */
/* write format for the case where the output device is the */
/* screen has been made system-dependent; list-directed output */
/* format is now used for systems that require a leading carriage */
/* control character; other systems use character format. The */
/* write format for the case where the output device is a file */
/* has been changed from list-directed to character. */
/* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */
/* Module was updated to include the value for FILEN */
/* and the appropriate OPEN statement for the Silicon */
/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */
/* value of 256 for Unix platforms was changed to 255. */
/* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */
/* Module was updated to include the value of FILEN for the */
/* Hewlett Packard UX 9000/750 environment. */
/* The code was also reformatted so that a utility program can */
/* create the source file for a specific environment given a */
/* master source file. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
/* This routine now can write to files that have been opened */
/* by other routines. */
/* The limit imposed by this routine on the number of files it */
/* can open has been removed. */
/* The output file is now opened as a normal text file on */
/* VAX systems. */
/* Improper treatment of the case where DEVICE is blank was */
/* remedied. */
/* Unneeded variable declarations and references were removed. */
/* Initialization of SAVED variables was added. */
/* All occurrences of "PRINT *" have been replaced by */
/* "WRITE (*,*)". */
/* Calls to UCASE and LJUST replace in-line code that performed */
/* these operations. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* write output line to a device */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */
/* References to the PC-LINUX environment were added. */
/* The write format for the case where the output device is the */
/* screen has been made system-dependent; list-directed output */
/* format is now used for systems that require a leading carriage */
/* control character; other systems use character format. The */
/* write format for the case where the output device is a file */
/* has been changed from list-directed to character. */
/* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */
/* Module was updated to include the value for FILEN */
/* and the appropriate OPEN statement for the Silicon */
/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */
/* value of 256 for Unix platforms was changed to 255. */
/* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */
/* Module was updated to include the value of FILEN for the */
/* Hewlett Packard UX 9000/750 environment. */
/* The code was also reformatted so that a utility program can */
/* create the source file for a specific environment given a */
/* master source file. */
/* - SPICELIB Version 2.0.0, 25-MAR-1991 (NJB) */
/* 1) This routine now can write to files that have been opened */
/* by other routines. WRLINE uses an INQUIRE statement to */
/* determine whether the file indicated by DEVICE is open, */
/* and if it is, WRLINE does not attempt to open it. This */
/* allows use of WRLINE to feed error output into a log file */
/* opened by another routine. */
/* The header has been updated accordingly. */
/* This fix also fixes a bug wherein this routine would treat */
/* different character strings naming the same file as though */
/* they indicated different files. */
/* 2) The limit imposed by this routine on the number of files it */
/* can open has been removed. The file database used in */
/* previous versions of this routine is no longer used. */
/* 3) On VAX systems, this routine now opens the output file */
/* (when required to do so) as a normal text file. */
/* 4) Improper treatment of the case where DEVICE is blank was */
/* remedied. Any value of DEVICE that is not equal to */
/* 'SCREEN' or 'NULL' after being left-justified and */
/* converted to upper case is considered to be a file name. */
/* 5) Unneeded variable declarations and references were removed. */
/* The arrays called STATUS and FILES are not needed. */
/* 6) All instances if "PRINT *" have been replaced by */
/* "WRITE (*,*)" because Language Systems Fortran on the */
/* Macintosh interprets "PRINT *" in a non-standard manner. */
/* 7) Use of the EXIST specifier was added to the INQUIRE */
/* statement used to determine whether the file named by */
/* DEVICE is open. This is a work-around for a rather */
/* peculiar behavior of at least one version of Sun Fortran: */
/* files that don't exist may be considered to be open, as */
/* indicated by the OPENED specifier of the INQUIRE statement. */
/* 8) One other thing: now that LJUST and UCASE are error-free, */
/* WRLINE uses them; this simplifies the code. */
/* - Beta Version 1.2.0, 27-FEB-1989 (NJB) */
/* Call to GETLUN replaced by call to FNDLUN, which is error-free. */
/* Call to IOERR replaced with in-line code to construct long */
/* error message indicating file open failure. Arrangement of */
/* declarations changed. Keywords added. FILEN declaration */
/* moved to "declarations" section. Parameters section added. */
/* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */
/* Upper bound of written substring changed to prevent use of */
/* invalid substring bound. Specifically, LASTNB ( LINE ) was */
/* replaced by MAX ( 1, LASTNB (LINE) ). This upper bound */
/* now used in the PRINT statement as well. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Executable Code: */
switch(n__) {
case 1: goto L_clline;
}
ljust_(device, tmpnam, device_len, (ftnlen)128);
ucase_(tmpnam, tmpnam, (ftnlen)128, (ftnlen)128);
/* TMPNAM is now left justified and is in upper case. */
if (s_cmp(tmpnam, "NULL", (ftnlen)128, (ftnlen)4) == 0) {
return 0;
} else if (s_cmp(tmpnam, "SCREEN", (ftnlen)128, (ftnlen)6) == 0) {
ci__1.cierr = 1;
ci__1.ciunit = 6;
ci__1.cifmt = "(A)";
iostat = s_wsfe(&ci__1);
if (iostat != 0) {
goto L100001;
}
iostat = do_fio(&c__1, line, rtrim_(line, line_len));
if (iostat != 0) {
goto L100001;
}
iostat = e_wsfe();
L100001:
return 0;
}
/* Find out whether we'll need to open the file. */
/* We use the EXIST inquiry specifier because files that don't exist */
/* may be (possibly due to a Sun compiler bug) deemed to be OPEN by */
/* Sun Fortran. */
i__1 = ltrim_(device, device_len) - 1;
ioin__1.inerr = 1;
ioin__1.infilen = device_len - i__1;
ioin__1.infile = device + i__1;
ioin__1.inex = &exists;
ioin__1.inopen = &opened;
ioin__1.innum = &unit;
ioin__1.innamed = 0;
ioin__1.inname = 0;
ioin__1.inacc = 0;
ioin__1.inseq = 0;
ioin__1.indir = 0;
ioin__1.infmt = 0;
ioin__1.inform = 0;
ioin__1.inunf = 0;
ioin__1.inrecl = 0;
ioin__1.innrec = 0;
ioin__1.inblank = 0;
iostat = f_inqu(&ioin__1);
if (iostat != 0) {
/* This is weird. How can an INQUIRE statement fail, */
/* if the syntax is correct? But just in case... */
s_wsle(&io___6);
do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20);
e_wsle();
s_wsle(&io___7);
do_lio(&c__9, &c__1, "WRLINE: File = ", (ftnlen)15);
do_lio(&c__9, &c__1, device, device_len);
do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9);
do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer));
e_wsle();
return 0;
}
if (! (opened && exists)) {
/* We will need a free logical unit. There is always the chance */
/* that no units are available. */
fndlun_(&unit);
if (unit < 1) {
s_wsle(&io___8);
do_lio(&c__9, &c__1, "SPICE(NOFREELOGICALUNIT)", (ftnlen)24);
e_wsle();
s_wsle(&io___9);
do_lio(&c__9, &c__1, " ", (ftnlen)1);
e_wsle();
s_wsle(&io___10);
do_lio(&c__9, &c__1, "WRLINE: Maximum number of logical units th"
"at can be allocated by SPICELIB has already been reached",
(ftnlen)98);
e_wsle();
return 0;
}
/* Okay, we have a unit. Open the file, and hope nothing */
/* goes awry. (On the VAX, the qualifier */
/* CARRIAGECONTROL = 'LIST' */
/* may be inserted into the OPEN statement.) */
i__1 = ltrim_(device, device_len) - 1;
o__1.oerr = 1;
o__1.ounit = unit;
o__1.ofnmlen = device_len - i__1;
o__1.ofnm = device + i__1;
o__1.orl = 0;
o__1.osta = "NEW";
o__1.oacc = 0;
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
if (iostat != 0) {
s_wsle(&io___11);
do_lio(&c__9, &c__1, "SPICE(FILEOPENFAILED)", (ftnlen)21);
e_wsle();
s_wsle(&io___12);
do_lio(&c__9, &c__1, " ", (ftnlen)1);
e_wsle();
s_copy(error, "WRLINE: An error occurred while attempting to open"
, (ftnlen)240, (ftnlen)50);
suffix_(device, &c__1, error, device_len, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)
32, (ftnlen)240);
suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240);
intstr_(&iostat, errstr, (ftnlen)11);
suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
s_wsle(&io___15);
do_lio(&c__9, &c__1, error, (ftnlen)240);
e_wsle();
return 0;
}
/* Whew! We're ready to write to this file. */
}
/* At this point, either we opened the file, or it was already */
/* opened by somebody else. */
/* This is the easy part. Write the next line to the file. */
ci__1.cierr = 1;
ci__1.ciunit = unit;
ci__1.cifmt = "(A)";
iostat = s_wsfe(&ci__1);
if (iostat != 0) {
goto L100002;
}
iostat = do_fio(&c__1, line, rtrim_(line, line_len));
if (iostat != 0) {
goto L100002;
}
iostat = e_wsfe();
L100002:
/* Well, what happened? Any non-zero value for IOSTAT indicates */
/* an error. */
if (iostat != 0) {
s_copy(error, "WRLINE: An error occurred while attempting to WRITE t"
"o ", (ftnlen)240, (ftnlen)55);
suffix_(device, &c__1, error, device_len, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)32,
(ftnlen)240);
suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240);
intstr_(&iostat, errstr, (ftnlen)11);
suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
s_wsle(&io___16);
do_lio(&c__9, &c__1, error, (ftnlen)240);
e_wsle();
return 0;
}
return 0;
/* $Procedure CLLINE ( Close a device ) */
L_clline:
/* $ Abstract */
/* Close a device. */
/* $ 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 */
/* TEXT, FILES, ERROR */
/* $ Declarations */
/* CHARACTER*(*) DEVICE */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* DEVICE I Device to be closed. */
/* $ Detailed_Input */
/* DEVICE is the name of a device which is currently */
/* opened for reading or writing. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* This routine is called by SPICELIB error handling routines, so */
/* it cannot use the normal SPICELIB error signalling mechanism. */
/* Instead, it writes error messages to the screen if necessary. */
/* 1) If the device indicated by DEVICE was not opened by WRLINE, */
/* this routine closes it anyway. */
/* 2) If the INQUIRE performed by this routine fails, an error */
/* diagnosis is printed to the screen. */
/* $ Files */
/* This routin */
/* $ Particulars */
/* CLLINE closes a device that is currently open. */
/* $ Examples */
/* 1) Write two lines to the file, SPUD.DAT (VAX file name */
/* syntax), and then close the file. */
/* CALL WRLINE ( 'SPUD.DAT', ' This is line 1 ' ) */
/* CALL WRLINE ( 'SPUD.DAT', ' This is line 2 ' ) */
/* CALL CLLINE ( 'SPUD.DAT' ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are WIN-NT */
/* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
/* All occurrences of "PRINT *" have been replaced by */
/* "WRITE (*,*)". */
/* Also, this routine now closes the device named by DEVICE */
/* whether or not the device was opened by WRLINE. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* None. */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
/* All instances if "PRINT *" have been replaced by "WRITE (*,*)" */
/* because Language Systems Fortran on the Macintosh interprets */
/* "PRINT *" in a non-standard manner. */
/* This routine no longer has to maintain the file database, since */
/* WRLINE does not use it any more. */
/* Also, this routine now closes the device named by DEVICE, */
/* whether or not the device was opened by WRLINE. */
/* - Beta Version 1.0.1, 08-NOV-1988 (NJB) */
/* Keywords added. */
/* -& */
/* Find the unit connected to DEVICE. */
i__1 = ltrim_(device, device_len) - 1;
ioin__1.inerr = 1;
ioin__1.infilen = device_len - i__1;
ioin__1.infile = device + i__1;
ioin__1.inex = 0;
ioin__1.inopen = 0;
ioin__1.innum = &unit;
ioin__1.innamed = 0;
ioin__1.inname = 0;
ioin__1.inacc = 0;
ioin__1.inseq = 0;
ioin__1.indir = 0;
ioin__1.infmt = 0;
ioin__1.inform = 0;
ioin__1.inunf = 0;
ioin__1.inrecl = 0;
ioin__1.innrec = 0;
ioin__1.inblank = 0;
iostat = f_inqu(&ioin__1);
if (iostat != 0) {
/* This is weird. How can an INQUIRE statement fail, */
/* if the syntax is correct? But just in case... */
s_wsle(&io___17);
do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20);
e_wsle();
s_wsle(&io___18);
do_lio(&c__9, &c__1, "CLLINE: File = ", (ftnlen)16);
do_lio(&c__9, &c__1, device, device_len);
do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9);
do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer));
e_wsle();
return 0;
}
cl__1.cerr = 0;
cl__1.cunit = unit;
cl__1.csta = 0;
f_clos(&cl__1);
return 0;
} /* wrline_ */
/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */
/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref,
integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
integer cobs, legs;
doublereal sobs[6];
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *), zznamfrm_(integer *, char *,
integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer
*);
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
char oname[40];
doublereal descr[5];
integer ctarg[20];
char ident[40], tname[40];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
moved_(doublereal *, integer *, doublereal *);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal starg[120] /* was [6][20] */;
logical nofrm;
static char svref[32];
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
static integer svctr1[2];
extern logical failed_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
integer handle, cframe;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
extern doublereal clight_(void);
integer tframe[20];
extern integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svrefi;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
integer tmpfrm;
extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *),
spksfs_(integer *, doublereal *, integer *, doublereal *, char *,
logical *, ftnlen);
extern integer frstnp_(char *, ftnlen);
extern logical return_(void);
doublereal psxfrm[9] /* was [3][3] */;
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), intstr_(integer *, char *,
ftnlen);
integer nct;
doublereal rot[9] /* was [3][3] */;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
char tstring[80];
/* $ Abstract */
/* Compute the geometric position of a target body relative to an */
/* observing 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 */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* This file contains the number of inertial reference */
/* frames that are currently known by the SPICE toolkit */
/* software. */
/* $ 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 */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NINERT P Number of known inertial reference frames. */
/* $ Parameters */
/* NINERT is the number of recognized inertial reference */
/* frames. This value is needed by both CHGIRF */
/* ZZFDAT, and FRAMEX. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */
/* -& */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* OBS I Observing body. */
/* POS O Position of target. */
/* LT O Light time. */
/* $ Detailed_Input */
/* TARG is the standard NAIF ID code for a target body. */
/* ET is the epoch (ephemeris time) at which the position */
/* of the target body is to be computed. */
/* REF is the name of the reference frame to */
/* which the vectors returned by the routine should */
/* be rotated. This may be any frame supported by */
/* the SPICELIB subroutine REFCHG. */
/* OBS is the standard NAIF ID code for an observing body. */
/* $ Detailed_Output */
/* POS contains the position of the target */
/* body, relative to the observing body. This vector is */
/* rotated into the specified reference frame. Units */
/* are always km. */
/* LT is the one-way light time from the observing body */
/* to the geometric position of the target body at the */
/* specified epoch. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If insufficient ephemeris data has been loaded to compute */
/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */
/* signalled. */
/* $ Files */
/* See: $Restrictions. */
/* $ Particulars */
/* SPKGPS computes the geometric position, T(t), of the target */
/* body and the geometric position, O(t), of the observing body */
/* relative to the first common center of motion. Subtracting */
/* O(t) from T(t) gives the geometric position of the target */
/* body relative to the observer. */
/* CENTER ----- O(t) */
/* | / */
/* | / */
/* | / */
/* | / T(t) - O(t) */
/* | / */
/* T(t) */
/* The one-way light time, tau, is given by */
/* | T(t) - O(t) | */
/* tau = ----------------- */
/* c */
/* For example, if the observing body is -94, the Mars Observer */
/* spacecraft, and the target body is 401, Phobos, then the */
/* first common center is probably 4, the Mars Barycenter. */
/* O(t) is the position of -94 relative to 4 and T(t) is the */
/* position of 401 relative to 4. */
/* The center could also be the Solar System Barycenter, body 0. */
/* For example, if the observer is 399, Earth, and the target */
/* is 299, Venus, then O(t) would be the position of 399 relative */
/* to 0 and T(t) would be the position of 299 relative to 0. */
/* Ephemeris data from more than one segment may be required */
/* to determine the positions of the target body and observer */
/* relative to a common center. SPKGPS reads as many segments */
/* as necessary, from as many files as necessary, using files */
/* that have been loaded by previous calls to SPKLEF (load */
/* ephemeris file). */
/* SPKGPS is similar to SPKGEO but returns geometric positions */
/* only. */
/* $ Examples */
/* The following code example computes the geometric */
/* position of the moon with respect to the earth and */
/* then prints the distance of the moon from the */
/* the earth at a number of epochs. */
/* Assume the SPK file SAMPLE.BSP contains ephemeris data */
/* for the moon relative to earth over the time interval */
/* from BEGIN to END. */
/* INTEGER EARTH */
/* PARAMETER ( EARTH = 399 ) */
/* INTEGER MOON */
/* PARAMETER ( MOON = 301 ) */
/* INTEGER N */
/* PARAMETER ( N = 100 ) */
/* INTEGER I */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL FURNSH ( 'SAMPLE.BSP' ) */
/* . */
/* . */
/* . */
/* C */
/* C Divide the interval of coverage [BEGIN,END] into */
/* C N steps. At each step, compute the position, and */
/* C print out the epoch in UTC time and position norm. */
/* C */
/* DELTA = ( END - BEGIN ) / N */
/* DO I = 0, N */
/* ET = BEGIN + I*DELTA */
/* CALL SPKGPS ( MOON, ET, 'J2000', EARTH, POS, LT ) */
/* CALL ET2UTC ( ET, 'C', 0, UTC ) */
/* WRITE (*,*) UTC, VNORM ( POS ) */
/* END DO */
/* $ Restrictions */
/* 1) The ephemeris files to be used by SPKGPS must be loaded */
/* by SPKLEF before SPKGPS is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* Updated to map the input frame name to its ID by first calling */
/* ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/* change is that now the frame with the fixed name 'DEFAULT' */
/* that can be associated with any code via CHGIRF's entry point */
/* IRFDEF will be fully masked by a frame with indentical name */
/* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/* frame masked the text kernel frame with the same name. */
/* Replaced SPKLEF with FURNSH and fixed errors in Examples. */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. */
/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */
/* -& */
/* $ Index_Entries */
/* geometric position of one body relative to another */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* -& */
/* This is the idea: */
/* Every body moves with respect to some center. The center */
/* is itself a body, which in turn moves about some other */
/* center. If we begin at the target body (T), follow */
/* the chain, */
/* T */
/* \ */
/* SSB \ */
/* \ C[1] */
/* \ / */
/* \ / */
/* \ / */
/* \ / */
/* C[3]-----------C[2] */
/* and avoid circular definitions (A moves about B, and B moves */
/* about A), eventually we get the position relative to the solar */
/* system barycenter (which, for our purposes, doesn't move). */
/* Thus, */
/* T = T + C[1] + C[2] + ... + C[n] */
/* SSB C[1] C[2] [C3] SSB */
/* where */
/* X */
/* Y */
/* is the position of body X relative to body Y. */
/* However, we don't want to follow each chain back to the SSB */
/* if it isn't necessary. Instead we will just follow the chain */
/* of the target body and follow the chain of the observing body */
/* until we find a common node in the tree. */
/* In the example below, C is the first common node. We compute */
/* the position of TARG relative to C and the position of OBS */
/* relative to C, then subtract the two positions. */
/* TARG */
/* \ */
/* SSB \ */
/* \ A */
/* \ / OBS */
/* \ / | */
/* \ / | */
/* \ / | */
/* B-------------C-----------------D */
/* SPICELIB functions */
/* Local parameters */
/* CHLEN is the maximum length of a chain. That is, */
/* it is the maximum number of bodies in the chain from */
/* the target or observer to the SSB. */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKGPS", (ftnlen)6);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* We take care of the obvious case first. It TARG and OBS are the */
/* same we can just fill in zero. */
if (*targ == *obs) {
*lt = 0.;
cleard_(&c__3, pos);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* CTARG contains the integer codes of the bodies in the */
/* target body chain, beginning with TARG itself and then */
/* the successive centers of motion. */
/* STARG(1,I) is the position of the target body relative */
/* to CTARG(I). The id-code of the frame of this position is */
/* stored in TFRAME(I). */
/* COBS and SOBS will contain the centers and positions of the */
/* observing body. (They are single elements instead of arrays */
/* because we only need the current center and position of the */
/* observer relative to it.) */
/* First, we construct CTARG and STARG. CTARG(1) is */
/* just the target itself, and STARG(1,1) is just a zero */
/* vector, that is, the position of the target relative */
/* to itself. */
/* Then we follow the chain, filling up CTARG and STARG */
/* as we go. We use SPKSFS to search through loaded */
/* files to find the first segment applicable to CTARG(1) */
/* and time ET. Then we use SPKPVN to compute the position */
/* of the body CTARG(1) at ET in the segment that was found */
/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */
/* We repeat the process for CTARG(2) and so on, until */
/* there is no data found for some CTARG(I) or until we */
/* reach the SSB. */
/* Next, we find centers and positions in a similar manner */
/* for the observer. It's a similar construction as */
/* described above, but I is always 1. COBS and SOBS */
/* are overwritten with each new center and position, */
/* beginning at OBS. However, we stop when we encounter */
/* a common center of motion, that is when COBS is equal */
/* to CTARG(I) for some I. */
/* Finally, we compute the desired position of the target */
/* relative to the observer by subtracting the position of */
/* the observing body relative to the common node from */
/* the position of the target body relative to the common */
/* node. */
/* CTPOS is the position in CTARG of the common node. */
/* Since the upgrade to use hashes and counter bypass ZZNAMFRM */
/* became more efficient in looking up frame IDs than IRFNUM. So the */
/* original order of calls "IRFNUM first, NAMFRM second" was */
/* switched to "ZZNAMFRM first, IRFNUM second". */
/* The call to IRFNUM, now redundant for built-in inertial frames, */
/* was preserved to for a sole reason -- to still support the */
/* ancient and barely documented ability for the users to associate */
/* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/* frame code via CHGIRF's entry point IRFDEF. */
/* Note that in the case of ZZNAMFRM's failure to resolve name and */
/* IRFNUM's success to do so, the code returned by IRFNUM for */
/* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/* should it change between the calls. */
zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
if (refid == 0) {
irfnum_(ref, &refid, ref_len);
}
if (refid == 0) {
if (frstnp_(ref, ref_len) > 0) {
setmsg_("The string supplied to specify the reference frame, ('#"
"') contains non-printing characters. The two most commo"
"n causes for this kind of error are: 1. an error in the "
"call to SPKGPS; 2. an uninitialized variable. ", (ftnlen)
213);
errch_("#", ref, (ftnlen)1, ref_len);
} else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) {
setmsg_("The string supplied to specify the reference frame is b"
"lank. The most common cause for this kind of error is a"
"n uninitialized variable. ", (ftnlen)137);
} else {
setmsg_("The string supplied to specify the reference frame was "
"'#'. This frame is not recognized. Possible causes for "
"this error are: 1. failure to load the frame definition "
"into the kernel pool; 2. An out-of-date edition of the t"
"oolkit. ", (ftnlen)231);
errch_("#", ref, (ftnlen)1, ref_len);
}
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
/* Fill in CTARG and STARG until no more data is found */
/* or until we reach the SSB. If the chain gets too */
/* long to fit in CTARG, that is if I equals CHLEN, */
/* then overwrite the last elements of CTARG and STARG. */
/* Note the check for FAILED in the loop. If SPKSFS */
/* or SPKPVN happens to fail during execution, and the */
/* current error handling action is to NOT abort, then */
/* FOUND may be stuck at TRUE, CTARG(I) will never */
/* become zero, and the loop will execute indefinitely. */
/* Construct CTARG and STARG. Begin by assigning the */
/* first elements: TARG and the position of TARG relative */
/* to itself. */
i__ = 1;
ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1,
"spkgps_", (ftnlen)603)] = *targ;
found = TRUE_;
cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)606)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)608)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "spkgps_", (ftnlen)608)] != 0) {
/* Find a file and segment that has position */
/* data for CTARG(I). */
spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"ctarg", i__1, "spkgps_", (ftnlen)617)], et, &handle, descr,
ident, &found, (ftnlen)40);
if (found) {
/* Get the position of CTARG(I) relative to some */
/* center of motion. This new center goes in */
/* CTARG(I+1) and the position is called STEMP. */
++i__;
spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <=
i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
627)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)627)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "spkgps_", (ftnlen)627)]);
/* Here's what we have. STARG is the position of CTARG(I-1) */
/* relative to CTARG(I) in reference frame TFRAME(I) */
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
tframe[0] = tframe[1];
/* If the loop above ended because we ran out of */
/* room in the arrays CTARG and STARG, then we */
/* continue finding positions but we overwrite the */
/* last elements of CTARG and STARG. */
/* If, as a result, the first common node is */
/* overwritten, we'll just have to settle for */
/* the last common node. This will cause a small */
/* loss of precision, but it's better than other */
/* alternatives. */
if (i__ == 20) {
while(found && ctarg[19] != 0 && ctarg[19] != *obs) {
/* Find a file and segment that has position */
/* data for CTARG(CHLEN). */
spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
;
if (found) {
/* Get the position of CTARG(CHLEN) relative to */
/* some center of motion. The new center */
/* overwrites the old. The position is called */
/* STEMP. */
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);
/* Add STEMP to the position of TARG relative to */
/* the old center to get the position of TARG */
/* relative to the new center. Overwrite */
/* the last element of STARG. */
if (tframe[19] == tmpfrm) {
moved_(&starg[114], &c__3, vtemp);
} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 &&
tframe[19] <= 21) {
irfrot_(&tframe[19], &tmpfrm, rot);
mxv_(rot, &starg[114], vtemp);
} else {
refchg_(&tframe[19], &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[114], vtemp);
}
vadd_(vtemp, stemp, &starg[114]);
tframe[19] = tmpfrm;
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
}
nct = i__;
/* NCT is the number of elements in CTARG, */
/* the chain length. We have in hand the following information */
/* STARG(1...3,K) position of body */
/* CTARG(K-1) relative to body CTARG(K) in the frame */
/* TFRAME(K) */
/* For K = 2,..., NCT. */
/* CTARG(1) = TARG */
/* STARG(1...3,1) = ( 0, 0, 0 ) */
/* TFRAME(1) = TFRAME(2) */
/* Now follow the observer's chain. Assign */
/* the first values for COBS and SOBS. */
cobs = *obs;
cleard_(&c__6, sobs);
/* Perhaps we have a common node already. */
/* If so it will be the last node on the */
/* list CTARG. */
/* We let CTPOS will be the position of the common */
/* node in CTARG if one is found. It will */
/* be zero if COBS is not found in CTARG. */
if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg",
i__1, "spkgps_", (ftnlen)762)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)764)];
} else {
ctpos = 0;
}
/* Repeat the same loop as above, but each time */
/* we encounter a new center of motion, check to */
/* see if it is a common node. (When CTPOS is */
/* not zero, CTARG(CTPOS) is the first common node.) */
/* Note that we don't need a centers array nor a */
/* positions array, just a single center and position */
/* is sufficient --- we just keep overwriting them. */
/* When the common node is found, we have everything */
/* we need in that one center (COBS) and position */
/* (SOBS-position of the target relative to COBS). */
found = TRUE_;
nofrm = TRUE_;
legs = 0;
while(found && cobs != 0 && ctpos == 0) {
/* Find a file and segment that has position */
/* data for COBS. */
spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
if (found) {
/* Get the position of COBS; call it STEMP. */
/* The center of motion of COBS becomes the */
/* new COBS. */
if (legs == 0) {
spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs);
} else {
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs);
}
if (nofrm) {
nofrm = FALSE_;
cframe = tmpfrm;
}
/* Add STEMP to the position of OBS relative to */
/* the old COBS to get the position of OBS */
/* relative to the new COBS. */
if (cframe == tmpfrm) {
/* On the first leg of the position of the observer, we */
/* don't have to add anything, the position of the */
/* observer is already in SOBS. We only have to add when */
/* the number of legs in the observer position is one or */
/* greater. */
if (legs > 0) {
vadd_(sobs, stemp, vtemp);
vequ_(vtemp, sobs);
}
} else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <=
21) {
irfrot_(&cframe, &tmpfrm, rot);
mxv_(rot, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
} else {
refchg_(&cframe, &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
}
/* Check failed. We don't want to loop */
/* indefinitely. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* We now have one more leg of the path for OBS. Set */
/* LEGS to reflect this. Then see if the new center */
/* is a common node. If not, repeat the loop. */
++legs;
ctpos = isrchi_(&cobs, &nct, ctarg);
}
}
/* If CTPOS is zero at this point, it means we */
/* have not found a common node though we have */
/* searched through all the available data. */
if (ctpos == 0) {
bodc2n_(targ, tname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40);
repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40)
;
} else {
intstr_(targ, tname, (ftnlen)40);
}
bodc2n_(obs, oname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40);
repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40);
} else {
intstr_(obs, oname, (ftnlen)40);
}
setmsg_("Insufficient ephemeris data has been loaded to compute the "
"position of TARG relative to OBS at the ephemeris epoch #. ",
(ftnlen)118);
etcal_(et, tstring, (ftnlen)80);
errch_("TARG", tname, (ftnlen)4, (ftnlen)40);
errch_("OBS", oname, (ftnlen)3, (ftnlen)40);
errch_("#", tstring, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* If CTPOS is not zero, then we have reached a */
/* common node, specifically, */
/* CTARG(CTPOS) = COBS = CENTER */
/* (in diagram below). The POSITION of the target */
/* (TARG) relative to the observer (OBS) is just */
/* STARG(1,CTPOS) - SOBS. */
/* SOBS */
/* CENTER ---------------->OBS */
/* | . */
/* | . N */
/* S | . O */
/* T | . I */
/* A | . T */
/* R | . I */
/* G | . S */
/* | . O */
/* | . P */
/* V L */
/* TARG */
/* And the light-time between them is just */
/* | POSITION | */
/* LT = --------- */
/* c */
/* Compute the position of the target relative to CTARG(CTPOS) */
if (ctpos == 1) {
tframe[0] = cframe;
}
i__1 = ctpos - 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe"
, i__2, "spkgps_", (ftnlen)960)] == tframe[(i__3 = i__) < 20
&& 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", (
ftnlen)960)]) {
vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)962)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "spkgps_", (ftnlen)962)], stemp);
moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
963)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "spkgps_", (ftnlen)965)] > 0 && tframe[(i__3 =
i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk"
"gps_", (ftnlen)965)] <= 21 && tframe[(i__2 = i__ - 1) < 20 &&
0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen)
965)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2
: s_rnge("tframe", i__2, "spkgps_", (ftnlen)965)] <= 21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)967)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)967)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)968)], stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)969)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
970)]);
} else {
refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)974)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)974)], et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)981)],
stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)982)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
983)]);
}
}
/* To avoid unnecessary frame transformations we'll do */
/* a bit of extra decision making here. It's a lot */
/* faster to make logical checks than it is to compute */
/* frame transformations. */
if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe",
i__1, "spkgps_", (ftnlen)996)] == cframe) {
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)998)], sobs, pos);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1000)] == refid) {
/* If the last frame associated with the target is already */
/* in the requested output frame, we convert the position of */
/* the observer to that frame and then subtract the position */
/* of the observer from the position of the target. */
if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
irfrot_(&cframe, &refid, rot);
mxv_(rot, sobs, stemp);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, stemp);
}
/* We've now transformed SOBS into the requested reference frame. */
/* Set CFRAME to reflect this. */
cframe = refid;
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1031)], stemp, pos);
} else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
1034)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "spkgps_", (ftnlen)1034)] <= 21) {
/* If both frames are inertial we use IRFROT instead of */
/* REFCHG to get things into a common frame. */
irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1040)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1041)], stemp);
vsub_(stemp, sobs, pos);
} else {
/* Use the more general routine REFCHG to make the transformation. */
refchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1048)], &cframe, et,
psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1055)], stemp);
vsub_(stemp, sobs, pos);
}
/* Finally, rotate as needed into the requested frame. */
if (cframe == refid) {
/* We don't have to do anything in this case. */
} else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
/* Since both frames are inertial, we use the more direct */
/* routine IRFROT to get the transformation to REFID. */
irfrot_(&cframe, &refid, rot);
mxv_(rot, pos, stemp);
moved_(stemp, &c__3, pos);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, pos, stemp);
moved_(stemp, &c__3, pos);
}
*lt = vnorm_(pos) / clight_();
chkout_("SPKGPS", (ftnlen)6);
return 0;
} /* spkgps_ */
/* $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 SCDECD ( Decode spacecraft clock ) */
/* Subroutine */ int scdecd_(integer *sc, doublereal *sclkdp, char *sclkch,
ftnlen sclkch_len)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
doublereal d__1;
/* Builtin functions */
double d_nint(doublereal *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen);
/* Local variables */
integer part, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
doublereal ticks;
extern /* Subroutine */ int scfmt_(integer *, doublereal *, char *,
ftnlen);
doublereal pstop[9999];
extern logical failed_(void);
extern integer lastnb_(char *, ftnlen);
integer prelen;
extern integer lstled_(doublereal *, integer *, doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer suflen;
extern /* Subroutine */ int scpart_(integer *, integer *, doublereal *,
doublereal *), chkout_(char *, ftnlen), prefix_(char *, integer *,
char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen,
ftnlen);
integer nparts;
doublereal pstart[9999];
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
doublereal ptotls[9999];
char prtstr[5];
/* $ Abstract */
/* Convert double precision encoding of spacecraft clock time into */
/* a character representation. */
/* $ 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 */
/* SCLK */
/* $ Keywords */
/* CONVERSION */
/* TIME */
/* $ Declarations */
/* $ Abstract */
/* Include file sclk.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 below define sizes and limits used by */
/* the SCLK system. */
/* $ 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 */
/* See the declaration section below. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */
/* Increased value of maximum coefficient record count */
/* parameter MXCOEF from 10K to 50K. */
/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */
/* -& */
/* Number of supported SCLK field delimiters: */
/* Supported SCLK string field delimiters: */
/* Maximum number of partitions: */
/* Partition string length. */
/* Since the maximum number of partitions is given by MXPART is */
/* 9999, PRTSTR needs at most 4 characters for the partition number */
/* and one character for the slash. */
/* Maximum number of coefficient records: */
/* Maximum number of fields in an SCLK string: */
/* Length of strings used to represent D.P. */
/* numbers: */
/* Maximum number of supported parallel time systems: */
/* End of include file sclk.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* SC I NAIF spacecraft identification code. */
/* SCLKDP I Encoded representation of a spacecraft clock count. */
/* SCLKCH O Character representation of a clock count. */
/* MXPART P Maximum number of spacecraft clock partitions. */
/* $ Detailed_Input */
/* SC is the NAIF integer code of the spacecraft whose */
/* clock's time is being decoded. */
/* SCLKDP is the double precision encoding of a clock time in */
/* units of ticks since the spacecraft clock start time. */
/* This value does reflect partition information. */
/* An analogy may be drawn between a spacecraft clock */
/* and a standard wall clock. The number of ticks */
/* corresponding to the wall clock string */
/* hh:mm:ss */
/* would be the number of seconds represented by that */
/* time. */
/* For example: */
/* Clock string Number of ticks */
/* ------------ --------------- */
/* 00:00:10 10 */
/* 00:01:00 60 */
/* 00:10:00 600 */
/* 01:00:00 3600 */
/* If SCLKDP contains a fractional part the result */
/* is the same as if SCLKDP had been rounded to the */
/* nearest whole number. */
/* $ Detailed_Output */
/* SCLKCH is the character representation of the clock count. */
/* The exact form that SCLKCH takes depends on the */
/* spacecraft. */
/* Nevertheless, SCLKCH will have the following general */
/* format: */
/* 'pp/sclk_string' */
/* 'pp' is an integer greater than or equal to one and */
/* represents a "partition number". */
/* Each mission is divided into some number of partitions. */
/* A new partition starts when the spacecraft clock */
/* resets, either to zero, or to some other */
/* value. Thus, the first partition for any mission */
/* starts with launch, and ends with the first clock */
/* reset. The second partition starts immediately when */
/* the first stopped, and so on. */
/* In order to be completely unambiguous about a */
/* particular time, you need to specify a partition number */
/* along with the standard clock string. */
/* Information about when partitions occur for different */
/* missions is contained in a spacecraft clock kernel */
/* file which needs to be loaded into the kernel pool */
/* before calling SCDECD. */
/* The routine SCPART may be used to read the partition */
/* start and stop times, in encoded units of ticks, from */
/* the kernel file. */
/* Since the end time of one partition is coincident with */
/* the begin time of the next, two different time strings */
/* with different partition numbers can encode into the */
/* same value. */
/* For example, if partition 1 ends at time t1, and */
/* partition 2 starts at time t2, then */
/* '1/t1' and '2/t2' */
/* will be encoded into the same value, say X. SCDECD */
/* always decodes such values into the latter of the */
/* two partitions. In this example, */
/* CALL SCDECD ( X, SC, CLKSTR ) */
/* will result in */
/* CLKSTR = '2/t2'. */
/* 'sclk_string' is a spacecraft specific clock string, */
/* typically consisting of a number of components */
/* separated by delimiters. */
/* Using Galileo as an example, the full format is */
/* wwwwwwww:xx:y:z */
/* where z is a mod-8 counter (values 0-7) which */
/* increments approximately once every 8 1/3 ms., y is a */
/* mod-10 counter (values 0-9) which increments once */
/* every time z turns over, i.e., approximately once every */
/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */
/* which increments once every time y turns over, i.e., */
/* once every 2/3 seconds. wwwwwwww is the Real-Time Image */
/* Count (RIM), which increments once every time xx turns */
/* over, i.e., once every 60 2/3 seconds. The roll-over */
/* expression for the RIM is 16777215, which corresponds */
/* to approximately 32 years. */
/* wwwwwwww, xx, y, and z are referred to interchangeably */
/* as the fields or components of the spacecraft clock. */
/* SCLK components may be separated by any of these five */
/* characters: ' ' ':' ',' '-' '.' */
/* The delimiter used is determined by a kernel pool */
/* variable and can be adjusted by the user. */
/* Some spacecraft clock components have offset, or */
/* starting, values different from zero. For example, */
/* with an offset value of 1, a mod 20 counter would */
/* cycle from 1 to 20 instead of from 0 to 19. */
/* See the SCLK required reading for a detailed */
/* description of the Voyager and Mars Observer clock */
/* formats. */
/* $ Parameters */
/* MXPART is the maximum number of spacecraft clock partitions */
/* expected in the kernel file for any one spacecraft. */
/* See the INCLUDE file sclk.inc for this parameter's */
/* value. */
/* $ Exceptions */
/* 1) If kernel variables required by this routine are unavailable, */
/* the error will be diagnosed by routines called by this routine. */
/* SCLKCH will be returned as a blank string in this case. */
/* 2) If the number of partitions in the kernel file for spacecraft */
/* SC exceeds the parameter MXPART, the error */
/* 'SPICE(TOOMANYPARTS)' is signaled. SCLKCH will be returned */
/* as a blank string in this case. */
/* 3) If the encoded value does not fall in the boundaries of the */
/* mission, the error 'SPICE(VALUEOUTOFRANGE)' is signaled. */
/* SCLKCH will be returned as a blank string in this case. */
/* 4) If the declared length of SCLKCH is not large enough to */
/* contain the output clock string the error */
/* 'SPICE(SCLKTRUNCATED)' is signaled either by this routine */
/* or by a routine called by this routine. On output SCLKCH */
/* will contain a portion of the truncated clock string. */
/* $ Files */
/* A kernel file containing spacecraft clock partition information */
/* for the desired spacecraft must be loaded, using the routine */
/* FURNSH, before calling this routine. */
/* $ Particulars */
/* In general, it is difficult to compare spacecraft clock counts */
/* numerically since there are too many clock components for a */
/* single comparison. The routine SCENCD provides a method of */
/* assigning a single double precision number to a spacecraft's */
/* clock count, given one of its character representations. */
/* This routine performs the inverse operation to SCENCD, converting */
/* an encoded double precision number to character format. */
/* To convert the number of ticks since the start of the mission to */
/* a clock format character string, SCDECD: */
/* 1) Determines the spacecraft clock partition that TICKS falls */
/* in. */
/* 2) Subtracts off the number of ticks occurring in previous */
/* partitions, to get the number of ticks since the beginning */
/* of the current partition. */
/* 3) Converts the resulting ticks to clock format and forms the */
/* string */
/* 'partition_number/clock_string' */
/* $ Examples */
/* Double precision encodings of spacecraft clock counts are used to */
/* tag pointing data in the C-kernel. */
/* In the following example, pointing for a sequence of images from */
/* the Voyager 2 narrow angle camera is requested from the C-kernel */
/* using an array of character spacecraft clock counts as input. */
/* The clock counts attached to the output are then decoded to */
/* character and compared with the input strings. */
/* CHARACTER*(25) CLKIN ( 4 ) */
/* CHARACTER*(25) CLKOUT */
/* CHARACTER*(25) CLKTOL */
/* DOUBLE PRECISION TIMEIN */
/* DOUBLE PRECISION TIMOUT */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* INTEGER NPICS */
/* INTEGER SC */
/* DATA NPICS / 4 / */
/* DATA CLKIN / '2/20538:39:768', */
/* . '2/20543:21:768', */
/* . '2/20550:37', */
/* . '2/20561:59' / */
/* DATA CLKTOL / ' 0:01:000' / */
/* C */
/* C The instrument we want pointing for is the Voyager 2 */
/* C narrow angle camera. The reference frame we want is */
/* C J2000. The spacecraft is Voyager 2. */
/* C */
/* INST = -32001 */
/* REF = 'J2000' */
/* SC = -32 */
/* C */
/* C Load the appropriate files. We need */
/* C */
/* C 1) CK file containing pointing data. */
/* C 2) Spacecraft clock kernel file, for SCENCD and SCDECD. */
/* C */
/* CALL CKLPF ( 'VGR2NA.CK' ) */
/* CALL FURNSH ( 'SCLK.KER' ) */
/* C */
/* C Convert the tolerance string to ticks. */
/* C */
/* CALL SCTIKS ( SC, CLKTOL, TOL ) */
/* DO I = 1, NPICS */
/* CALL SCENCD ( SC, CLKIN( I ), TIMEIN ) */
/* CALL CKGP ( INST, TIMEIN, TOL, REF, CMAT, TIMOUT, */
/* . FOUND ) */
/* CALL SCDECD ( SC, TIMOUT, CLKOUT ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Input s/c clock count: ', CLKIN( I ) */
/* WRITE (*,*) 'Output s/c clock count: ', CLKOUT */
/* WRITE (*,*) 'Output C-Matrix: ', CMAT */
/* END DO */
/* The output from such a program might look like: */
/* Input s/c clock count: 2/20538:39:768 */
/* Output s/c clock count: 2/20538:39:768 */
/* Output C-Matrix: 'first C-matrix' */
/* Input s/c clock count: 2/20543:21:768 */
/* Output s/c clock count: 2/20543:22:768 */
/* Output C-Matrix: 'second C-matrix' */
/* Input s/c clock count: 2/20550:37 */
/* Output s/c clock count: 2/20550:36:768 */
/* Output C-Matrix: 'third C-matrix' */
/* Input s/c clock count: 2/20561:59 */
/* Output s/c clock count: 2/20561:58:768 */
/* Output C-Matrix: 'fourth C-matrix' */
/* $ Restrictions */
/* 1) Assumes that an SCLK kernel file appropriate for the clock */
/* designated by SC is loaded in the kernel pool at the time */
/* this routine is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* J.M. Lynch (JPL) */
/* R.E. Thurman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.0, 05-FEB-2008 (NJB) */
/* Values of parameter MXPART and PARTLN are now */
/* provided by the INCLUDE file sclk.inc. */
/* - SPICELIB Version 2.0.1, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 2.0.0, 17-APR-1992 (JML) (WLT) */
/* The routine was changed to signal an error when SCLKCH is */
/* not long enough to contain the output spacecraft clock */
/* string. */
/* FAILED is now checked after calling SCPART. */
/* References to CLPOOL were deleted. */
/* Miscellaneous minor updates to the header were performed. */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 06-SEP-1990 (JML) (RET) */
/* -& */
/* $ Index_Entries */
/* decode spacecraft_clock */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 10-APR-1992 (JML) (WLT) */
/* The routine was changed to signal an error when SCLKCH is */
/* not long enough to contain the output spacecraft clock */
/* string. Previously, the SCLK routines simply truncated */
/* the clock string on the right. It was determined that */
/* since this truncation could easily go undetected by the */
/* user ( only the leftmost field of a clock string is */
/* required when clock string is used as an input to a */
/* SCLK routine ), it would be better to signal an error */
/* when this happens. */
/* FAILED is checked after calling SCPART in case an */
/* error has occurred reading the kernel file and the */
/* error action is not set to 'abort'. */
/* References to CLPOOL were deleted. */
/* Miscellaneous minor updates to the header were performed. */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SCDECD", (ftnlen)6);
}
/* Use a working copy of the input. */
ticks = d_nint(sclkdp);
s_copy(sclkch, " ", sclkch_len, (ftnlen)1);
/* Read the partition start and stop times (in ticks) for this */
/* mission. Error if there are too many of them. Also need to */
/* check FAILED in case error handling is not in ABORT or */
/* DEFAULT mode. */
scpart_(sc, &nparts, pstart, pstop);
if (failed_()) {
chkout_("SCDECD", (ftnlen)6);
return 0;
}
if (nparts > 9999) {
setmsg_("The number of partitions, #, for spacecraft # exceeds the v"
"alue for parameter MXPART, #.", (ftnlen)88);
errint_("#", &nparts, (ftnlen)1);
errint_("#", sc, (ftnlen)1);
errint_("#", &c__9999, (ftnlen)1);
sigerr_("SPICE(TOOMANYPARTS)", (ftnlen)19);
chkout_("SCDECD", (ftnlen)6);
return 0;
}
/* For each partition, compute the total number of ticks in that */
/* partition plus all preceding partitions. */
d__1 = pstop[0] - pstart[0];
ptotls[0] = d_nint(&d__1);
i__1 = nparts;
for (i__ = 2; i__ <= i__1; ++i__) {
d__1 = ptotls[(i__3 = i__ - 2) < 9999 && 0 <= i__3 ? i__3 : s_rnge(
"ptotls", i__3, "scdecd_", (ftnlen)495)] + pstop[(i__4 = i__
- 1) < 9999 && 0 <= i__4 ? i__4 : s_rnge("pstop", i__4, "scd"
"ecd_", (ftnlen)495)] - pstart[(i__5 = i__ - 1) < 9999 && 0 <=
i__5 ? i__5 : s_rnge("pstart", i__5, "scdecd_", (ftnlen)495)];
ptotls[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls",
i__2, "scdecd_", (ftnlen)495)] = d_nint(&d__1);
}
/* The partition corresponding to the input ticks is the first one */
/* whose tick total is greater than the input value. The one */
/* exception is when the input ticks is equal to the total number */
/* of ticks represented by all the partitions. In this case the */
/* partition number is the last one, i.e. NPARTS. */
/* Error if TICKS comes before the first partition (that is, if it's */
/* negative), or after the last one. */
if (ticks == ptotls[(i__1 = nparts - 1) < 9999 && 0 <= i__1 ? i__1 :
s_rnge("ptotls", i__1, "scdecd_", (ftnlen)510)]) {
part = nparts;
} else {
part = lstled_(&ticks, &nparts, ptotls) + 1;
}
if (ticks < 0. || part > nparts) {
setmsg_("Value for ticks, #, does not fall in any partition for spac"
"ecraft #.", (ftnlen)68);
errdp_("#", &ticks, (ftnlen)1);
errint_("#", sc, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("SCDECD", (ftnlen)6);
return 0;
}
/* To get the count in this partition, subtract off the total of */
/* the preceding partition counts and add the beginning count for */
/* this partition. */
if (part == 1) {
ticks += pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : s_rnge(
"pstart", i__1, "scdecd_", (ftnlen)535)];
} else {
ticks = ticks + pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 :
s_rnge("pstart", i__1, "scdecd_", (ftnlen)537)] - ptotls[(
i__2 = part - 2) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls",
i__2, "scdecd_", (ftnlen)537)];
}
/* Now create the output SCLK clock string. */
/* First convert from ticks to clock string format. */
scfmt_(sc, &ticks, sclkch, sclkch_len);
/* Now convert the partition number to a character string and prefix */
/* it to the output string. */
intstr_(&part, prtstr, (ftnlen)5);
suffix_("/", &c__0, prtstr, (ftnlen)1, (ftnlen)5);
prelen = lastnb_(prtstr, (ftnlen)5);
suflen = lastnb_(sclkch, sclkch_len);
if (i_len(sclkch, sclkch_len) - suflen < prelen) {
setmsg_("Output string too short to contain clock string. Input tick"
" value: #, requires string of length #, but declared length "
"is #.", (ftnlen)124);
errdp_("#", sclkdp, (ftnlen)1);
i__1 = prelen + suflen;
errint_("#", &i__1, (ftnlen)1);
i__1 = i_len(sclkch, sclkch_len);
errint_("#", &i__1, (ftnlen)1);
sigerr_("SPICE(SCLKTRUNCATED)", (ftnlen)20);
chkout_("SCDECD", (ftnlen)6);
return 0;
}
prefix_(prtstr, &c__0, sclkch, (ftnlen)5, sclkch_len);
chkout_("SCDECD", (ftnlen)6);
return 0;
} /* scdecd_ */
/* $Procedure ET2LST ( ET to Local Solar Time ) */
/* Subroutine */ int et2lst_(doublereal *et, integer *body, doublereal *
long__, char *type__, integer *hr, integer *mn, integer *sc, char *
time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len)
{
/* System generated locals */
address a__1[5], a__2[7];
integer i__1[5], i__2[7];
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
/* Local variables */
doublereal rate, slat, mins;
char h__[2], m[2];
integer n;
doublereal q;
char s[2];
doublereal angle;
char frame[32];
doublereal range;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), dpfmt_(
doublereal *, char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal state[6], slong;
extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
doublereal hours;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
extern doublereal twopi_(void);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
extern doublereal pi_(void);
char bodnam[36];
doublereal lt;
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
extern /* Subroutine */ int reclat_(doublereal *, doublereal *,
doublereal *, doublereal *), rmaind_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal secnds;
extern /* Subroutine */ int pgrrec_(char *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, ftnlen);
char bpmkwd[32];
integer hrampm;
doublereal tmpang;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char amorpm[4];
doublereal tmpsec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), dtpool_(char *, logical *, integer *, char *, ftnlen,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
doublereal mylong, spoint[3];
extern logical return_(void);
char kwtype[1];
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
char mytype[32];
doublereal lat;
/* $ Abstract */
/* Given an ephemeris epoch ET, compute the local solar time for */
/* an object on the surface of a body at a specified longitude. */
/* $ 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 */
/* TIME */
/* $ Keywords */
/* TIME */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ET I Epoch in seconds past J2000 epoch */
/* BODY I ID-code of the body of interest */
/* LONG I Longitude of surface point (RADIANS) */
/* TYPE I Type of longitude 'PLANETOCENTRIC', etc. */
/* HR O Local hour on a "24 hour" clock */
/* MN O Minutes past the hour */
/* SC O Seconds past the minute */
/* TIME O String giving local time on 24 hour clock */
/* AMPM O String giving time on A.M./ P.M. scale */
/* $ Detailed_Input */
/* ET is the epoch expressed in TDB seconds past */
/* the J2000 epoch at which a local time is desired. */
/* BODY is the NAIF ID-code of a body on which local */
/* time is to be measured. */
/* LONG is the longitude (either planetocentric or */
/* planetographic) in radians of the site on the */
/* surface of body for which local time should be */
/* computed. */
/* TYPE is the form of longitude supplied by the variable */
/* LONG. Allowed values are 'PLANETOCENTRIC' and */
/* 'PLANETOGRAPHIC'. Note the case of the letters */
/* in TYPE is insignificant. Both 'PLANETOCENTRIC' */
/* and 'planetocentric' are recognized. */
/* $ Detailed_Output */
/* HR is the local "hour" of the site specified at the */
/* epoch ET. Note that an "hour" of local time does not */
/* have the same duration as an hour measured by */
/* conventional clocks. It is simply a representation */
/* of an angle. See the "Particulars" section for a more */
/* complete discussion of the meaning of local time. */
/* MN is the number of "minutes" past the hour of the */
/* local time of the site at the epoch ET. Again note */
/* that a "local minute" is not the same as a minute */
/* you would measure with conventional clocks. */
/* SC is the number of "seconds" past the minute of the */
/* local time of the site at the epoch ET. Again note */
/* that a "local second" is not the same as a second */
/* you would measure with conventional clocks. */
/* TIME is a string expressing the local time */
/* on a "24 hour" local clock. */
/* AMPM is a string expressing the local time on a "12 hour" */
/* local clock together with the traditional AM/PM */
/* label to indicate whether the sun has crossed */
/* the local zenith meridian. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) This routine defines local solar time for any point on the */
/* surface of the Sun to be 12:00:00 noon. */
/* 2) If the TYPE of the coordinates is not recognized, the */
/* error 'SPICE(UNKNOWNSYSTEM)' will be signaled. */
/* 3) If the body-fixed frame to associate with BODY cannot be */
/* determined, the error 'SPICE(CANTFINDFRAME)' is signaled. */
/* 4) If insufficient data is available to compute the */
/* location of the sun in body-fixed coordinates, the */
/* error will be diagnosed by a routine called by this one. */
/* 5) If the BODY#_PM keyword required to determine the body */
/* rotation sense is not found in the POOL or if it is found but */
/* is not a numeric keyword with at least two elements, the error */
/* 'SPICE(CANTGETROTATIONTYPE)' is signaled. */
/* $ Files */
/* Suitable SPK and PCK files must be loaded prior to calling this */
/* routine so that the body-fixed position of the sun relative to */
/* BODY can be computed. The PCK files must contain the standard */
/* BODY#_PM keyword need by this routine to determine the body */
/* rotation sense. */
/* When the input longitude is planetographic, the default */
/* interpretation of this value can be overridden using the optional */
/* kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* which is normally defined via loading a text kernel. */
/* $ Particulars */
/* This routine returns the local solar time at a user */
/* specified location on a user specified body. */
/* Let SUNLNG be the planetocentric longitude (in degrees) of */
/* the sun as viewed from the center of the body of interest. */
/* Let SITLNG be the planetocentric longitude (in degrees) of */
/* the site for which local time is desired. */
/* We define local time to be 12 + (SITLNG - SUNLNG)/15 */
/* (where appropriate care is taken to map ( SITLNG - SUNLNG ) */
/* into the range from -180 to 180). */
/* Using this definition, we see that from the point of view */
/* of this routine, local solar time is simply a measure of angles */
/* between meridians on the surface of a body. Consequently, */
/* this routine is not appropriate for computing "local times" */
/* in the sense of Pacific Standard Time. For computing times */
/* relative to standard time zones on earth, see the routines */
/* TIMOUT and STR2ET. */
/* Regarding planetographic longitude */
/* ---------------------------------- */
/* 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 */
/* planetographic 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. */
/* $ Examples */
/* The following code fragment illustrates how you */
/* could print the local time at a site on Mars with */
/* planetographic longitude 326.17 deg E at epoch ET. */
/* (This example assumes all required SPK and PCK files have */
/* been loaded). */
/* Convert the longitude to radians, set the type of the longitude */
/* and make up a mnemonic for Mars' ID-code. */
/* LONG = 326.17 * RPD() */
/* TYPE = 'PLANETOGRAPHIC' */
/* MARS = 499 */
/* CALL ET2LST ( ET, MARS, LONG, TYPE, HR, MN, SC, TIME, AMPM ) */
/* WRITE (*,*) 'The local time at Mars 326.17 degrees E ' */
/* WRITE (*,*) 'planetographic longitude is: ', AMPM */
/* $ Restrictions */
/* This routine relies on being able to determine the name */
/* of the body-fixed frame associated with BODY through the */
/* frames subsystem. If the BODY specified is NOT one of the */
/* nine planets or their satellites, you will need to load */
/* an appropriate frame definition kernel that contains */
/* the relationship between the body id and the body-fixed frame */
/* name. See the FRAMES required reading for more details */
/* on specifying this relationship. */
/* The routine determines the body rotation sense using the PCK */
/* keyword BODY#_PM. Therefore, you will need to a text PCK file */
/* defining the complete set of the standard PCK body rotation */
/* keywords for the body of interest. The text PCK file must be */
/* loaded independently of whether a binary PCK file providing */
/* rotation data for the same body is loaded or not. */
/* Although it is not currently the case for any of the Solar System */
/* bodies, it is possible that the retrograde rotation rate of a */
/* body would be slower than the orbital rate of the body rotation */
/* around the Sun. The routine does not account for such cases; for */
/* them it will compute incorrect the local time progressing */
/* backwards. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.2, 18-APR-2014 (BVS) */
/* Minor edits to long error messages. */
/* - SPICELIB Version 3.0.1, 09-SEP-2009 (EDW) */
/* Header edits: deleted a spurious C$ marker from the */
/* "Detailed_Output" section. The existence of the marker */
/* caused a failure in the HTML documentation creation script. */
/* Deleted the "Revisions" section as it contained several */
/* identical entries from the "Version" section. */
/* Corrected order of header sections. */
/* - SPICELIB Version 3.0.0, 28-OCT-2006 (BVS) */
/* Bug fix: incorrect computation of the local time for the */
/* bodies with the retrograde rotation causing the local time to */
/* flow backwards has been fixed. The local time for all types of */
/* bodies now progresses as expected -- midnight, increasing AM */
/* hours, noon, increasing PM hours, next midnight, and so on. */
/* - SPICELIB Version 2.0.0, 03-NOV-2005 (NJB) */
/* Bug fix: treatment of planetographic longitude has been */
/* updated to be consistent with the SPICE planetographic/ */
/* rectangular coordinate conversion routines. The effect of */
/* this change is that the default sense of positive longitude */
/* for the moon is now east; also, the default sense of positive */
/* planetographic longitude now may be overridden for any body */
/* (see Particulars above). */
/* Updated to remove non-standard use of duplicate arguments */
/* in RMAIND calls. */
/* - SPICELIB Version 1.1.0, 24-MAR-1998 (WLT) */
/* The integer variable SUN was never initialized in the */
/* previous version of the routine. Now it is set to */
/* the proper value of 10. */
/* - SPICELIB Version 1.0.0, 9-JUL-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Compute the local time for a point on a body. */
/* -& */
/* SPICELIB Functions */
/* Local parameters */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ET2LST", (ftnlen)6);
ljust_(type__, mytype, type_len, (ftnlen)32);
ucase_(mytype, mytype, (ftnlen)32, (ftnlen)32);
if (s_cmp(mytype, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) {
/* Find planetocentric longitude corresponding to the input */
/* longitude. We first represent in rectangular coordinates */
/* a surface point having zero latitude, zero altitude, and */
/* the input planetographic longitude. We then find the */
/* planetocentric longitude of this point. */
/* Since PGRREC accepts a body name, map the input code to */
/* a name, if possible. Otherwise, just convert the input code */
/* to a string. */
bodc2n_(body, bodnam, &found, (ftnlen)36);
if (! found) {
intstr_(body, bodnam, (ftnlen)36);
}
/* Convert planetographic coordinates to rectangular coordinates. */
/* All we care about here is longitude. Set the other inputs */
/* as follows: */
/* Latitude = 0 */
/* Altitude = 0 */
/* Equatorial radius = 1 */
/* Flattening factor = 0 */
pgrrec_(bodnam, long__, &c_b4, &c_b4, &c_b6, &c_b4, spoint, (ftnlen)
36);
/* The output MYLONG is planetocentric longitude. The other */
/* outputs are not used. Note that the variable RANGE appears */
/* later in another RECLAT call; it's not used after that. */
reclat_(spoint, &range, &mylong, &lat);
} else if (s_cmp(mytype, "PLANETOCENTRIC", (ftnlen)32, (ftnlen)14) == 0) {
mylong = *long__;
} else {
setmsg_("The coordinate system '#' is not a recognized system of lon"
"gitude. The recognized systems are 'PLANETOCENTRIC' and 'PL"
"ANETOGRAPHIC'. ", (ftnlen)134);
errch_("#", type__, (ftnlen)1, type_len);
sigerr_("SPICE(UNKNOWNSYSTEM)", (ftnlen)20);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
/* It's always noon on the surface of the sun. */
if (*body == 10) {
*hr = 12;
*mn = 0;
*sc = 0;
s_copy(time, "12:00:00", time_len, (ftnlen)8);
s_copy(ampm, "12:00:00 P.M.", ampm_len, (ftnlen)13);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
/* Get the body-fixed position of the sun. */
cidfrm_(body, &frcode, frame, &found, (ftnlen)32);
if (! found) {
setmsg_("The body-fixed frame associated with body # could not be de"
"termined. This information needs to be \"loaded\" via a fra"
"mes definition kernel. See frames.req for more details. ", (
ftnlen)174);
errint_("#", body, (ftnlen)1);
sigerr_("SPICE(CANTFINDFRAME)", (ftnlen)20);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
spkez_(&c__10, et, frame, "LT+S", body, state, <, (ftnlen)32, (ftnlen)4)
;
reclat_(state, &range, &slong, &slat);
angle = mylong - slong;
/* Force the angle into the region from -PI to PI */
d__1 = twopi_();
rmaind_(&angle, &d__1, &q, &tmpang);
angle = tmpang;
if (angle > pi_()) {
angle -= twopi_();
}
/* Get the rotation sense of the body and invert the angle if the */
/* rotation sense is retrograde. Use the BODY#_PM PCK keyword to */
/* determine the sense of the body rotation. */
s_copy(bpmkwd, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(bpmkwd, "#", body, bpmkwd, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(bpmkwd, &found, &n, kwtype, (ftnlen)32, (ftnlen)1);
if (! found || *(unsigned char *)kwtype != 'N' || n < 2) {
setmsg_("The rotation type for the body # could not be determined be"
"cause the # keyword was either not found in the POOL or or i"
"t was not of the expected type and/or dimension. This keywor"
"d is usually provided via a planetary constants kernel. See "
"pck.req for more details. ", (ftnlen)265);
errint_("#", body, (ftnlen)1);
errch_("#", bpmkwd, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(CANTGETROTATIONTYPE)", (ftnlen)26);
chkout_("ET2LST", (ftnlen)6);
return 0;
} else {
/* If the rotation rate is negative, invert the angle. */
gdpool_(bpmkwd, &c__2, &c__1, &n, &rate, &found, (ftnlen)32);
if (rate < 0.) {
angle = -angle;
}
}
/* Convert the angle to "angle seconds" before or after local noon. */
secnds = angle * 86400. / twopi_();
secnds = brcktd_(&secnds, &c_b32, &c_b33);
/* Get the hour, and minutes components of the local time. */
rmaind_(&secnds, &c_b34, &hours, &tmpsec);
rmaind_(&tmpsec, &c_b35, &mins, &secnds);
/* Construct the integer components of the local time. */
*hr = (integer) hours + 12;
*mn = (integer) mins;
*sc = (integer) secnds;
/* Set the A.M./P.M. components of local time. */
if (*hr == 24) {
*hr = 0;
hrampm = 12;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr > 12) {
hrampm = *hr - 12;
s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr == 12) {
hrampm = 12;
s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr == 0) {
hrampm = 12;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
} else {
hrampm = *hr;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
}
/* Now construct the two strings we need. */
hours = (doublereal) (*hr);
mins = (doublereal) (*mn);
secnds = (doublereal) (*sc);
dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
dpfmt_(&mins, "0x", m, (ftnlen)2, (ftnlen)2);
dpfmt_(&secnds, "0x", s, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
i__1[0] = 2, a__1[0] = h__;
i__1[1] = 1, a__1[1] = ":";
i__1[2] = 2, a__1[2] = m;
i__1[3] = 1, a__1[3] = ":";
i__1[4] = 2, a__1[4] = s;
s_cat(time, a__1, i__1, &c__5, time_len);
hours = (doublereal) hrampm;
dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
i__2[0] = 2, a__2[0] = h__;
i__2[1] = 1, a__2[1] = ":";
i__2[2] = 2, a__2[2] = m;
i__2[3] = 1, a__2[3] = ":";
i__2[4] = 2, a__2[4] = s;
i__2[5] = 1, a__2[5] = " ";
i__2[6] = 4, a__2[6] = amorpm;
s_cat(ampm, a__2, i__2, &c__7, ampm_len);
chkout_("ET2LST", (ftnlen)6);
return 0;
} /* et2lst_ */
/* $Procedure BODVAR ( Return values from the kernel pool ) */
/* Subroutine */ int bodvar_(integer *body, char *item, integer *dim,
doublereal *values, ftnlen item_len)
{
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char code[16];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
char varnam[32];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), suffix_(char *, integer *, char
*, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int rtpool_(char *, integer *, doublereal *,
logical *, ftnlen), intstr_(integer *, char *, ftnlen);
/* $ Abstract */
/* Deprecated: This routine has been superseded by BODVCD and */
/* BODVRD. This routine is supported for purposes of backward */
/* compatibility only. */
/* Return the values of some item for any body in the */
/* kernel pool. */
/* $ 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 */
/* KERNEL */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ITEM I Item for which values are desired. ('RADII', */
/* 'NUT_PREC_ANGLES', etc. ) */
/* DIM O Number of values returned. */
/* VALUES O Values. */
/* $ Detailed_Input */
/* BODY is the ID code of the body for which ITEM is */
/* requested. Bodies are numbered according to the */
/* standard NAIF numbering scheme. */
/* ITEM is the item to be returned. Together, the body and */
/* item name combine to form a variable name, e.g., */
/* 'BODY599_RADII' */
/* 'BODY401_POLE_RA' */
/* $ Detailed_Output */
/* DIM is the number of values associated with the variable. */
/* VALUES are the values associated with the variable. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* The call */
/* CALL BODVAR ( 399, 'RADII', DIM, VALUE ) */
/* returns the dimension and values associated with the variable */
/* 'BODY399_RADII', for example, */
/* DIM = 3 */
/* VALUE(1) = 6378.140 */
/* VALUE(2) = 6378.140 */
/* VALUE(3) = 6356.755 */
/* $ Restrictions */
/* 1) If the requested item is not found, the error */
/* SPICE(KERNELVARNOTFOUND) is signalled. */
/* $ Literature_References */
/* 1) Refer to the SPK required reading file for a complete list of */
/* the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.5, 18-MAY-2010 (BVS) */
/* Index lines now state that this routine is deprecated. */
/* - SPICELIB Version 1.0.4, 27-OCT-2005 (NJB) */
/* Routine is now deprecated. */
/* - SPICELIB Version 1.0.3, 08-JAN-2004 (EDW) */
/* Trivial typo corrected. */
/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.1, 8-AUG-1990 (HAN) */
/* Detailed Input section of the header was updated. The */
/* description for the variable BODY was incorrect. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED fetch constants for a body from the kernel pool */
/* DEPRECATED physical constants for a body */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("BODVAR", (ftnlen)6);
}
/* Construct the variable name from BODY and ITEM. */
s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4);
intstr_(body, code, (ftnlen)16);
suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32);
suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32);
suffix_(item, &c__0, varnam, item_len, (ftnlen)32);
/* Grab the items. Complain if they aren't there. */
rtpool_(varnam, dim, values, &found, (ftnlen)32);
if (! found) {
setmsg_("The variable # could not be found in the kernel pool.", (
ftnlen)53);
errch_("#", varnam, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
}
chkout_("BODVAR", (ftnlen)6);
return 0;
} /* bodvar_ */
/* $Procedure BODC2S ( Body ID code to string translation ) */
/* Subroutine */ int bodc2s_(integer *code, char *name__, ftnlen name_len)
{
extern /* Subroutine */ int zzbodc2n_(integer *, char *, logical *,
ftnlen), chkin_(char *, ftnlen);
logical found;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
/* $ Abstract */
/* Translate a body ID code to either the corresponding name */
/* or if no name to ID code mapping exists, the string */
/* representation of the body ID value. */
/* $ 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 */
/* BODY */
/* CONVERSION */
/* ID */
/* NAME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CODE I Integer ID code to translate to a string. */
/* NAME O String corresponding to CODE. */
/* $ Detailed_Input */
/* CODE the integer code for a body: planet, satellite, */
/* barycenter, spacecraft, asteroid, comet, or */
/* other ephemeris object. */
/* $ Detailed_Output */
/* NAME the string name of the body identified by CODE */
/* if a mapping between CODE and a body name exists */
/* within SPICE. */
/* If CODE has more than one translation, then the */
/* most recently defined NAME corresponding to CODE */
/* is returned. NAME will have the exact format (case */
/* and blanks) as when the name/code pair was defined. */
/* If the input value of CODE does not map to a body */
/* name, NAME returns the string representation */
/* of CODE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* Body-name mappings may be defined at run time by loading text */
/* kernels containing kernel variable assignments of the form */
/* NAIF_BODY_NAME += ( <name 1>, ... ) */
/* NAIF_BODY_CODE += ( <code 1>, ... ) */
/* See naif_ids.req for details. */
/* $ Particulars */
/* BODS2N is one of five related subroutines, */
/* BODS2C Body string to code */
/* BODC2S Body code to string */
/* BODN2C Body name to code */
/* BODC2N Body code to name */
/* BODDEF Body name/code definition */
/* BODS2C, BODC2S, BODN2C, and BODC2N perform translations between */
/* body names and their corresponding integer ID codes which are */
/* used in SPICE files and routines. */
/* BODS2C is a slightly more general version of BODN2C: support */
/* for strings containing ID codes in string format enables a caller */
/* to identify a body using a string, even when no name is */
/* associated with that body. */
/* BODC2S is a general version of BODC2N; the routine returns either */
/* the name assigned in the body ID to name mapping or a string */
/* representation of the CODE value if no mapping exists. */
/* BODDEF assigns a body name to ID mapping. The mapping has */
/* priority in name-to-ID and ID-to-name translations. */
/* Refer to naif_ids.req for the list of name/code associations built */
/* into SPICE, and for details concerning adding new name/code */
/* associations at run time by loading text kernels. */
/* $ Examples */
/* Apply the BODC2S call to several IDs representing codes */
/* included in the default SPICE ID-name lists and codes not */
/* included in the list. */
/* PROGRAM BODC2S_T */
/* INTEGER CODE (7) */
/* CHARACTER*(32) NAME */
/* C */
/* C Assign an array of body IDs. Not all the listed IDS */
/* C map to a body name. */
/* C */
/* CODE(1) = 399 */
/* CODE(2) = 0 */
/* CODE(3) = 3 */
/* CODE(4) = -77 */
/* CODE(5) = 11 */
/* CODE(6) = -1 */
/* CODE(7) = 6000001 */
/* C */
/* C Loop over the CODE array, call BODC2S for each */
/* C element of CODE. */
/* C */
/* DO I= 1, 7 */
/* CALL BODC2S( CODE(I), NAME ) */
/* WRITE(*, '(I8,3x,A)' ) CODE(I), NAME */
/* END DO */
/* END */
/* Given these codes, BODC2S returns the following NAME strings: */
/* Code Name */
/* ------- ------------------- */
/* 399 'EARTH' */
/* 0 'SOLAR SYSTEM BARYCENTER' */
/* 3 'EARTH BARYCENTER' */
/* -77 'GALILEO ORBITER' */
/* 11 '11' */
/* -1 'GEOTAIL' */
/* 6000001 '6000001' */
/* The codes 11 and 6000001 did not map to a name so the call */
/* returns as NAME the string expression of the codes. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 18-APR-2014 (BVS) */
/* Minor header edits. */
/* - SPICELIB Version 1.0.0, 10-APR-2010 (EDW) */
/* -& */
/* $ Index_Entries */
/* body ID code to string */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICELIB error handling. */
if (return_()) {
return 0;
}
chkin_("BODC2S", (ftnlen)6);
/* Fortran. No type check available for CODE. Bother. */
/* Attempt to translate the input CODE to a name. Use */
/* the private routine ZZBODC2N. */
zzbodc2n_(code, name__, &found, name_len);
if (found) {
/* Success. CODE maps to NAME. Return. */
chkout_("BODC2S", (ftnlen)6);
return 0;
}
/* If execution reaches this level, the SPICE body ID */
/* to name mapping lacks an assignment for CODE. Convert */
/* CODE to a string representation of the integer value. */
intstr_(code, name__, name_len);
chkout_("BODC2S", (ftnlen)6);
return 0;
} /* bodc2s_ */
/* $Procedure ZZBODBLT ( Private --- Retrieve Built-In Body-Code Maps ) */
/* Subroutine */ int zzbodblt_0_(int n__, integer *room, char *names, char *
nornam, integer *codes, integer *nvals, char *device, char *reqst,
ftnlen names_len, ftnlen nornam_len, ftnlen device_len, ftnlen
reqst_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
address a__1[2], a__2[3];
integer i__1, i__2, i__3[2], i__4[3];
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), movec_(char *, integer *, char *, ftnlen,
ftnlen), movei_(integer *, integer *, integer *);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
char zzint[36];
static integer bltcod[563];
static char bltnam[36*563];
extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen);
extern integer lastnb_(char *, ftnlen);
extern /* Subroutine */ int orderi_(integer *, integer *, integer *),
sigerr_(char *, ftnlen), chkout_(char *, ftnlen);
static char bltnor[36*563];
extern /* Subroutine */ int wrline_(char *, char *, ftnlen, ftnlen),
setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen),
cmprss_(char *, integer *, char *, char *, ftnlen, ftnlen, ftnlen)
;
integer zzocod[563];
char zzline[75];
integer zzonam[563];
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
char zzrqst[4];
extern /* Subroutine */ int zzidmap_(integer *, char *, 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. */
/* This is the umbrella routine that contains entry points to */
/* access the built-in body name-code 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 */
/* None. */
/* $ Keywords */
/* BODY */
/* $ 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. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ROOM I ZZBODGET */
/* NAMES O ZZBODGET */
/* NORNAM O ZZBODGET */
/* CODES O ZZBODGET */
/* NVALS O ZZBODGET */
/* DEVICE I ZZBODLST */
/* REQST I ZZBODLST */
/* $ Detailed_Input */
/* See the entry points for a discussion of their arguments. */
/* $ Detailed_Output */
/* See the entry points for a discussion of their arguments. */
/* $ Parameters */
/* See the include file 'zzbodtrn.inc' for the list of parameters */
/* this routine utilizes. */
/* $ Exceptions */
/* 1) The error SPICE(BOGUSENTRY) is signaled if ZZBODBLT is */
/* called directly. */
/* $ Files */
/* None. */
/* $ Particulars */
/* ZZBODBLT should never be called directly, instead access */
/* the entry points: */
/* ZZBODGET Fetch the built-in body name/code list. */
/* ZZBODLST Output the name-ID mapping list. */
/* $ Examples */
/* See ZZBODTRN and its entry points for details. */
/* $ Restrictions */
/* 1) No duplicate entries should appear in the built-in */
/* BLTNAM list. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 2.3.1, 27-FEB-2007 (EDW) */
/* Completed the ZZBODLST decalrations section. */
/* - SPICELIB Version 2.3.0, 17-MAR-2003 (EDW) */
/* Added a call to ZZIDMAP to retrieve the default */
/* mapping list. "zzbodtrn.inc" no longer */
/* contains the default mapping list. */
/* - SPICELIB Version 2.2.0 21-FEB-2003 (BVS) */
/* Changed MER-A and MER-B to MER-1 and MER-2. */
/* - SPICELIB Version 2.1.0 04-DEC-2002 (EDW) */
/* Added new assignments to the default collection: */
/* -226 ROSETTA */
/* 517 CALLIRRHOE */
/* 518 THEMISTO */
/* 519 MAGACLITE */
/* 520 TAYGETE */
/* 521 CHALDENE */
/* 522 HARPALYKE */
/* 523 KALYKE */
/* 524 IOCASTE */
/* 525 ERINOME */
/* 526 ISONOE */
/* 527 PRAXIDIKE */
/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */
/* Initial release. This begins at Version 2.0.0 because */
/* the entry point ZZBODLST was cut out of ZZBODTRN and */
/* placed here at Version 1.0.0. */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */
/* The entries following this one were copied from */
/* the version section of ZZBODTRN. SPICELIB has */
/* been changed to ZZBODTRN for convenience in noting */
/* version information relevant for that module. */
/* This was done to carry the history of body name-code */
/* additions with this new umbrella. */
/* Added to the collection: */
/* -236 MESSENGER */
/* - ZZBODTRN Version 3.2.0, 14-AUG-2002 (EDW) */
/* Added the ZZBODKIK entry point. */
/* Moved the NAIF_BODY_NAME/CODE to subroutine */
/* ZZBODKER. No change in logic. */
/* Added logic to enforce the precedence masking; */
/* logic removes duplicate assignments of ZZBODDEF. */
/* Removed the NAMENOTUNIQUE error block. */
/* - ZZBODTRN Version 3.1.5, 27-NOV-2001 (EDW) */
/* Added to the collection: */
/* -200 CONTOUR */
/* -146 LUNAR-A */
/* -135 DRTS-W */
/* Added the subroutine ZZBODLST as an entry point. */
/* The routine outputs the current name-ID mapping */
/* list to some output device. */
/* - ZZBODTRN Version 3.1.0, 17-OCT-2001 (EDW) */
/* To improve clarity, the BEGXX block initialization now */
/* exists in the include file zzbodtrn.inc. */
/* Removed the comments concerning the 851, 852, ... temporary */
/* codes. */
/* Set the WNAMES assignment to NAIF_BODY_CODE, NAIF_BODY_NAME */
/* as a DATA statement. */
/* Edited headers to match information in naif_ids required */
/* reading. */
/* Edited headers, removed typos and bad grammar, clarified */
/* descriptions. */
/* Added to the collection */
/* -41 MARS EXPRESS, MEX */
/* -44 BEAGLE 2, BEAGLE2 */
/* -70 DEEP IMPACT IMPACTOR SPACECRAFT */
/* -94 MO, MARS OBSERVER */
/* -140 DEEP IMPACT FLYBY SPACECRAFT */
/* -172 SLCOMB, STARLIGHT COMBINER */
/* -205 SLCOLL, STARLIGHT COLLECTOR */
/* -253 MER-A */
/* -254 MER-B */
/* Corrected typo, vehicle -188 should properly be MUSES-C, */
/* previous versions listed the name as MUSES-B. */
/* Removed from collection */
/* -84 MARS SURVEYOR 01 LANDER */
/* -154 EOS-PM1 */
/* -200 PLUTO EXPRESS 1, PEX1 */
/* -202 PLUTO EXPRESS 2, PEX2 */
/* - ZZBODTRN Version 3.0.0, 29-MAR-2000 (WLT) */
/* The ID codes for Cluster 1, 2, 3 and 4 were added. The */
/* ID coded for Pluto Express were removed. The ID codes */
/* for Pluto-Kuiper Express, Pluto-Kuiper Express Simulation */
/* and Contour were added. */
/* - ZZBODTRN Version 2.0.0, 26-JAN-1998 (EDW) */
/* The Galileo probe ID -228 replaces the incorrect ID -344. */
/* DSS stations 5 through 65 added to the collection. */
/* Added to the collection */
/* -107 TROPICAL RAINFALL MEASURING MISSION, TRMM */
/* -154, EOS-PM1 */
/* -142 EOS-AM1 */
/* -151 AXAF */
/* -1 GEOTAIL */
/* -13 POLAR */
/* -21 SOHO */
/* -8 WIND */
/* -25 LUNAR PROSPECTOR, LPM */
/* -116 MARS POLAR LANDER, MPL */
/* -127 MARS CLIMATE ORBITER, MCO */
/* -188 MUSES-C */
/* -97 TOPEX/POSEIDON */
/* -6 PIONEER-6, P6 */
/* -7 PIONEER-7, P7 */
/* -20 PIONEER-8, P8 */
/* -23 PIONEER-10, P10 */
/* -24 PIONEER-11, P11 */
/* -178 NOZOMI, PLANET-B */
/* -79 SPACE INFRARED TELESCOPE FACILITY, SIRTF */
/* -29 STARDUST, SDU */
/* -47 GENESIS */
/* -48 HUBBLE SPACE TELESCOPE, HST */
/* -200 PLUTO EXPRESS 1, PEX1 */
/* -202 PLUTO EXPRESS 2, PEX2 */
/* -164 YOHKOH, SOLAR-A */
/* -165 MAP */
/* -166 IMAGE */
/* -53 MARS SURVEYOR 01 ORBITER */
/* 618 PAN */
/* 716 CALIBAN */
/* 717 SYCORAX */
/* -30 DS-1 (low priority) */
/* -58 HALCA */
/* -150 HUYGEN PROBE, CASP */
/* -55 ULS */
/* Modified ZZBODC2N and ZZBODN2C so the user may load an */
/* external IDs kernel to override or supplement the standard */
/* collection. The kernel must be loaded prior a call to */
/* ZZBODC2N or ZZBODN2C. */
/* - ZZBODTRN Version 1.1.0, 22-MAY-1996 (WLT) */
/* Added the id-code for Comet Hyakutake, Comet Hale-Bopp, */
/* Mars 96, Cassini Simulation, MGS Simulation. */
/* - ZZBODTRN Version 1.0.0, 25-SEP-1995 (BVS) */
/* Renamed umbrella subroutine and entry points to */
/* correspond private routine convention (ZZ...). Added IDs for */
/* tracking stations Goldstone (399001), Canberra (399002), */
/* Madrid (399003), Usuda (399004). */
/* - ZZBODTRN Version 2.2.0, 01-AUG-1995 (HAN) */
/* Added the IDs for Near Earth Asteroid Rendezvous (-93), */
/* Mars Pathfinder (-53), Ulysses (-55), VSOP (-58), */
/* Radioastron (-59), Cassini spacecraft (-82), and Cassini */
/* Huygens probe (-150). */
/* Mars Observer (-94) was replaced with Mars Global */
/* Surveyor (-94). */
/* - ZZBODTRN Version 2.1.0, 15-MAR-1995 (KSZ) (HAN) */
/* Two Shoemaker Levy 9 fragments were added, Q1 and P2 */
/* (IDs 50000022 and 50000023). Two asteroids were added, */
/* Eros and Mathilde (IDs 2000433 and 2000253). The */
/* Saturnian satellite Pan (ID 618) was added. */
/* - ZZBODTRN Version 2.0.0, 03-FEB-1995 (NJB) */
/* The Galileo probe (ID -344) has been added to the permanent */
/* collection. */
/* - ZZBODTRN Version 1.0.0, 29-APR-1994 (MJS) */
/* SPICELIB symbol tables are no longer used. Instead, two order */
/* vectors are used to index the NAMES and CODES arrays. Also, */
/* this version does not support reading body name ID pairs from a */
/* file. */
/* - ZZBODTRN Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - ZZBODTRN Version 2.0.0, 15-JUL-1991 (WLT) */
/* The body id's for the Uranian satellites discovered by Voyager */
/* were modified to conform to those established by the IAU */
/* nomenclature committee. In addition the id's for Gaspra and */
/* Ida were added. */
/* - ZZBODTRN Version 1.0.0, 7-MAR-1991 (WLT) */
/* Some items previously considered errors were removed */
/* and some minor modifications were made to improve the */
/* robustness of the routines. */
/* - ZZBODTRN Version 1.0.0, 28-JUN-1990 (JEM) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Local Variables */
/* Saved Variables */
/* Data Statements */
/* Parameter adjustments */
if (names) {
}
if (nornam) {
}
if (codes) {
}
/* Function Body */
switch(n__) {
case 1: goto L_zzbodget;
case 2: goto L_zzbodlst;
}
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZBODBLT", (ftnlen)8);
sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17);
chkout_("ZZBODBLT", (ftnlen)8);
}
return 0;
/* $Procedure ZZBODGET ( Private --- Body-Code Get Built-In List ) */
L_zzbodget:
/* $ 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. */
/* Retrieve a copy of the built-in body name-code mapping lists. */
/* $ 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 */
/* PRIVATE */
/* BODY */
/* $ Declarations */
/* INTEGER ROOM */
/* CHARACTER*(*) NAMES ( * ) */
/* CHARACTER*(*) NORNAM ( * ) */
/* INTEGER CODES ( * ) */
/* INTEGER NVALS */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ROOM I Space available in NAMES, NORNAM, and CODES. */
/* NAMES O Array of built-in body names. */
/* NORNAM O Array of normalized built-in body names. */
/* CODES O Array of built-in ID codes for NAMES/NORNAM. */
/* NVALS O Length of NAMES, NORNAM, CODES, and ORDNOM arrays. */
/* $ Detailed_Input */
/* ROOM is the maximum number of entries that NAMES, NORNAM, */
/* and CODES may receive. */
/* $ Detailed_Output */
/* NAMES the array of built-in names. This array is parallel */
/* to NORNAM and CODES. */
/* NORNAM the array of normalized built-in body names. This */
/* array is computed from the NAMES array by compressing */
/* groups of spaces into a single space, left-justifying */
/* the name, and uppercasing the letters. */
/* CODES the array of built-in codes associated with NAMES */
/* and NORNAM entries. */
/* NVALS the number of items returned in NAMES, NORNAM, */
/* and CODES. */
/* $ Parameters */
/* NPERM the number of permanent, or built-in, body name-code */
/* mappings. */
/* $ Exceptions */
/* 1) SPICE(BUG) is signaled if ROOM is less than NPERM, the */
/* amount of space required to store the entire list of */
/* body names and codes. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine simply copies it's local buffered version of the */
/* built-in name-code mappings to the output arguments. */
/* $ Examples */
/* See ZZBODTRN for sample usage. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.0, 17-MAR-2003 (EDW) */
/* Added a call to ZZIDMAP to retrieve the default */
/* mapping list. "zzbodtrn.inc" no longer */
/* contains the default mapping list. */
/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */
/* -& */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZBODGET", (ftnlen)8);
}
/* On the first invocation compute the normalized forms of BLTNAM */
/* and store them in BLTNOR. */
if (first) {
/* Retrieve the default mapping list. */
zzidmap_(bltcod, bltnam, (ftnlen)36);
for (i__ = 1; i__ <= 563; ++i__) {
ljust_(bltnam + ((i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 :
s_rnge("bltnam", i__1, "zzbodblt_", (ftnlen)565)) * 36,
bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? i__2 :
s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)565)) * 36, (
ftnlen)36, (ftnlen)36);
ucase_(bltnor + ((i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 :
s_rnge("bltnor", i__1, "zzbodblt_", (ftnlen)566)) * 36,
bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? i__2 :
s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)566)) * 36, (
ftnlen)36, (ftnlen)36);
cmprss_(" ", &c__1, bltnor + ((i__1 = i__ - 1) < 563 && 0 <= i__1
? i__1 : s_rnge("bltnor", i__1, "zzbodblt_", (ftnlen)567))
* 36, bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ?
i__2 : s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)567)) *
36, (ftnlen)1, (ftnlen)36, (ftnlen)36);
}
/* Do not do this again. */
first = FALSE_;
}
/* Copy the contents of BLTNAM, BLTNOR, and BLTCOD to the output */
/* arguments, but only if there is sufficient room. */
if (*room < 563) {
setmsg_("Insufficient room to copy the stored body name-code mapping"
"s to the output arguments. Space required is #, but the cal"
"ler supplied #.", (ftnlen)134);
errint_("#", &c__563, (ftnlen)1);
errint_("#", room, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZBODGET", (ftnlen)8);
return 0;
}
movec_(bltnam, &c__563, names, (ftnlen)36, names_len);
movec_(bltnor, &c__563, nornam, (ftnlen)36, nornam_len);
movei_(bltcod, &c__563, codes);
*nvals = 563;
chkout_("ZZBODGET", (ftnlen)8);
return 0;
/* $Procedure ZZBODLST ( Output permanent collection to some device. ) */
L_zzbodlst:
/* $ Abstract */
/* Output the complete list of built-in body/ID mappings to */
/* some output devide. Thw routine generates 2 lists: one */
/* sorted by ID number, one sorted by name. */
/* $ 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 */
/* BODY */
/* $ Declarations */
/* CHARACTER*(*) DEVICE */
/* CHARACTER*(*) REQST */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* DEVICE I Device name to receive the output. */
/* REQST I Data list name to output. */
/* $ Detailed_Input */
/* DEVICE identifies the device to receive the */
/* body/ID mapping list. WRLINE performs the */
/* output function and so DEVICE may have */
/* the values 'SCREEN' (to generate a screen dump), */
/* 'NULL' (do nothing), or a device name (a */
/* file, or any other name valid in a FORTRAN OPEN */
/* statement). */
/* REQST A case insensitive string indicating the data */
/* set to output. REQST may have the value 'ID', */
/* 'NAME', or 'BOTH'. 'ID' outputs the name/ID mapping */
/* ordered by ID number from least to highest value. */
/* 'NAME' outputs the name/ID mapping ordered by ASCII */
/* sort on the name string. 'BOTH' outputs both */
/* ordered lists. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The entry point outputs ordered lists of the name/ID mappings */
/* defined in ZZBODTRN. */
/* $ Examples */
/* 1. Write both sorted lists to screen. */
/* PROGRAM X */
/* CALL ZZBODLST( 'SCREEN', 'BOTH' ) */
/* END */
/* 2. Write an ID number sorted list to a file, "body.txt". */
/* PROGRAM X */
/* CALL ZZBODLST( 'body.txt', 'ID' ) */
/* END */
/* With SCREEN output of the form: */
/* Total number of name/ID mappings: 414 */
/* ID to name mappings. */
/* -550 | M96 */
/* -550 | MARS 96 */
/* -550 | MARS-96 */
/* -550 | MARS96 */
/* -254 | MER-2 */
/* -253 | MER-1 */
/* .. .. */
/* 50000020 | SHOEMAKER-LEVY 9-B */
/* 50000021 | SHOEMAKER-LEVY 9-A */
/* 50000022 | SHOEMAKER-LEVY 9-Q1 */
/* 50000023 | SHOEMAKER-LEVY 9-P2 */
/* Name to ID mappings. */
/* 1978P1 | 901 */
/* 1979J1 | 515 */
/* .. .. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.1, 27-FEB-2007 (EDW) */
/* Completed the ZZBODLST declarations section. */
/* - SPICELIB Version 2.1.0, 17-MAR-2003 (EDW) */
/* Added a call to ZZIDMAP to retrieve the default */
/* mapping list. "zzbodtrn.inc" no longer */
/* contains the default mapping list. */
/* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */
/* This entry point was moved into ZZBODBLT and some */
/* variable names were changed to refer to variables */
/* in the umbrella. */
/* - SPICELIB Version 1.0.0, 26-NOV-2001 (EDW) */
/* -& */
if (return_()) {
return 0;
} else {
chkin_("ZZBODLST", (ftnlen)8);
}
/* Upper case the ZZRQST value. */
ucase_(reqst, zzrqst, reqst_len, (ftnlen)4);
intstr_(&c__563, zzint, (ftnlen)36);
/* Writing concatenation */
i__3[0] = 34, a__1[0] = "Total number of name/ID mappings: ";
i__3[1] = 36, a__1[1] = zzint;
s_cat(zzline, a__1, i__3, &c__2, (ftnlen)75);
wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75));
/* Retrieve the current set of name/ID mappings */
zzidmap_(bltcod, bltnam, (ftnlen)36);
/* Branch as defined by the value of ZZRQST. 'ID' or 'BOTH'. */
if (eqstr_(zzrqst, "ID", (ftnlen)4, (ftnlen)2) || eqstr_(zzrqst, "BOTH", (
ftnlen)4, (ftnlen)4)) {
orderi_(bltcod, &c__563, zzocod);
wrline_(device, " ", device_len, (ftnlen)1);
wrline_(device, "ID to name mappings.", device_len, (ftnlen)20);
for (i__ = 1; i__ <= 563; ++i__) {
intstr_(&bltcod[(i__2 = zzocod[(i__1 = i__ - 1) < 563 && 0 <=
i__1 ? i__1 : s_rnge("zzocod", i__1, "zzbodblt_", (ftnlen)
812)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltcod",
i__2, "zzbodblt_", (ftnlen)812)], zzint, (ftnlen)36);
/* Writing concatenation */
i__4[0] = 36, a__2[0] = zzint;
i__4[1] = 3, a__2[1] = " | ";
i__4[2] = 36, a__2[2] = bltnam + ((i__2 = zzocod[(i__1 = i__ - 1)
< 563 && 0 <= i__1 ? i__1 : s_rnge("zzocod", i__1, "zzbo"
"dblt_", (ftnlen)814)] - 1) < 563 && 0 <= i__2 ? i__2 :
s_rnge("bltnam", i__2, "zzbodblt_", (ftnlen)814)) * 36;
s_cat(zzline, a__2, i__4, &c__3, (ftnlen)75);
wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75));
}
}
/* ... 'NAME' or 'BOTH'. */
if (eqstr_(zzrqst, "NAME", (ftnlen)4, (ftnlen)4) || eqstr_(zzrqst, "BOTH",
(ftnlen)4, (ftnlen)4)) {
orderc_(bltnam, &c__563, zzonam, (ftnlen)36);
wrline_(device, " ", device_len, (ftnlen)1);
wrline_(device, "Name to ID mappings.", device_len, (ftnlen)20);
for (i__ = 1; i__ <= 563; ++i__) {
intstr_(&bltcod[(i__2 = zzonam[(i__1 = i__ - 1) < 563 && 0 <=
i__1 ? i__1 : s_rnge("zzonam", i__1, "zzbodblt_", (ftnlen)
834)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltcod",
i__2, "zzbodblt_", (ftnlen)834)], zzint, (ftnlen)36);
/* Writing concatenation */
i__4[0] = 36, a__2[0] = bltnam + ((i__2 = zzonam[(i__1 = i__ - 1)
< 563 && 0 <= i__1 ? i__1 : s_rnge("zzonam", i__1, "zzbo"
"dblt_", (ftnlen)836)] - 1) < 563 && 0 <= i__2 ? i__2 :
s_rnge("bltnam", i__2, "zzbodblt_", (ftnlen)836)) * 36;
i__4[1] = 3, a__2[1] = " | ";
i__4[2] = 36, a__2[2] = zzint;
s_cat(zzline, a__2, i__4, &c__3, (ftnlen)75);
wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75));
}
}
chkout_("ZZBODLST", (ftnlen)8);
return 0;
} /* zzbodblt_ */
/* $Procedure BODFND ( Find values from the kernel pool ) */
logical bodfnd_(integer *body, char *item, ftnlen item_len)
{
/* System generated locals */
logical ret_val;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char code[16];
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
logical found;
char dtype[1], varnam[32];
extern /* Subroutine */ int chkout_(char *, ftnlen), dtpool_(char *,
logical *, integer *, char *, ftnlen, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
/* $ Abstract */
/* Determine whether values exist for some item for any body */
/* in the kernel pool. */
/* $ 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 */
/* KERNEL */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ITEM I Item to find ('RADII', 'NUT_AMP_RA', etc.). */
/* $ Detailed_Input */
/* BODY is the ID code of the body for which the item is */
/* requested. Bodies are numbered according to the */
/* standard NAIF numbering scheme. */
/* ITEM is the item to be returned. Together, the body and */
/* item name combine to form a variable name, e.g., */
/* 'BODY599_RADII' */
/* 'BODY4_POLE_RA' */
/* $ Detailed_Output */
/* The result is TRUE if the item is in the kernel pool, */
/* and is FALSE if it is not. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* BODVCD, which returns values from the kernel pool, causes an */
/* error to be signalled whenever the specified item is not found. */
/* In many cases, this is appropriate. However, sometimes the */
/* program may attempt to recover, by providing default values, */
/* prompting for replacements, and so on. */
/* $ Examples */
/* In the following example, default values are substituted for */
/* bodies for which axes are not found. */
/* IF ( BODFND ( TARGET, 'RADII' ) ) THEN */
/* CALL BODVCD ( TARGET, 'RADII', 3, N, RADII ) */
/* ELSE */
/* CALL VPACK ( 100.D0, 100.D0, 100.D0, RADII ) */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Refer to the SPK required reading file for a complete list of */
/* the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.1, 24-OCT-2005 (NJB) */
/* Header update: calls to BODVAR in example code were replaced */
/* with calls to BODVCD. The string 'AXES' and variable AXES */
/* were replaced with the string 'RADII' and variable 'RADII' */
/* throughout the header. */
/* - SPICELIB Version 1.2.0, 15-MAR-2002 (NJB) */
/* Bug fix: routine was updated to work with string-valued */
/* kernel variables. */
/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */
/* If the value of the function RETURN is TRUE upon execution of */
/* this module, this function is assigned a default value of */
/* either 0, 0.0D0, .FALSE., or blank depending on the type of */
/* the function. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* find constants for a body in the kernel pool */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
ret_val = FALSE_;
return ret_val;
} else {
chkin_("BODFND", (ftnlen)6);
}
/* Construct the variable name from BODY and ITEM. */
s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4);
intstr_(body, code, (ftnlen)16);
suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32);
suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32);
suffix_(item, &c__0, varnam, item_len, (ftnlen)32);
/* Search the kernel pool for the item. */
dtpool_(varnam, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
/* Was anything there? */
ret_val = found;
chkout_("BODFND", (ftnlen)6);
return ret_val;
} /* bodfnd_ */
/* $Procedure LIST ( Process a SUBTeX list item ) */
/* Subroutine */ int list_(char *source, integer *n, ftnlen source_len)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char line[132], cseq[12];
integer l, begin;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer index;
extern /* Subroutine */ int tempb_(char *, char *, ftnlen, ftnlen);
integer pgwid, width, iskip;
char token[132];
integer lskip, rskip;
extern /* Subroutine */ int rjust_(char *, char *, ftnlen, ftnlen);
integer remain, indent;
char marker[5];
extern /* Subroutine */ int params_(char *, char *, integer *, ftnlen,
ftnlen), chkout_(char *, ftnlen), tokens_(char *, char *, integer
*, char *, integer *, ftnlen, ftnlen, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
/* $ Abstract */
/* Process a @newlist, @numitem, @symitem, or @paritem control */
/* sequence. */
/* $ 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 */
/* SUBTeX */
/* $ Keywords */
/* SUBTeX */
/* $ Declarations */
/* $ Detailed_Input */
/* SOURCE are the source lines containing a @newlist, @numitem, */
/* @symitem, or @paritem control sequence, followed by */
/* an associated paragraph of text. */
/* N is the number of source lines. */
/* $ Detailed_Output */
/* Processed lines are saved in the temporary buffer. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* SOURCE I Source lines. */
/* N I Number of source lines. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* $ Examples */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* $Include SUBTeX.REFS */
/* $ Author_and_Institution */
/* I.M. Underwood (JPL) */
/* $ Version */
/* Beta Version 1.0.0, 11-JUN-1988 (IMU) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling */
if (return_()) {
return 0;
} else {
chkin_("LIST", (ftnlen)4);
}
/* Retrieve the required parameters. */
params_("GET", "PAGEWIDTH", &width, (ftnlen)3, (ftnlen)9);
params_("GET", "LEFTSKIP", &lskip, (ftnlen)3, (ftnlen)8);
params_("GET", "RIGHTSKIP", &rskip, (ftnlen)3, (ftnlen)9);
params_("GET", "ITEMINDENT", &indent, (ftnlen)3, (ftnlen)10);
params_("GET", "ITEMSKIP", &iskip, (ftnlen)3, (ftnlen)8);
/* The first token should be a recognized control sequence. */
tokens_("NEW", source, n, cseq, &l, (ftnlen)3, source_len, (ftnlen)12);
/* @newlist just resets the list index. That's all. */
if (s_cmp(cseq, "@newlist", (ftnlen)12, (ftnlen)8) == 0) {
params_("SET", "LISTINDEX", &c__1, (ftnlen)3, (ftnlen)9);
chkout_("LIST", (ftnlen)4);
return 0;
}
/* The principal difference between the various items is the */
/* marker that begins the first line. */
if (s_cmp(cseq, "@numitem", (ftnlen)12, (ftnlen)8) == 0) {
params_("GET", "LISTINDEX", &index, (ftnlen)3, (ftnlen)9);
i__1 = index + 1;
params_("SET", "LISTINDEX", &i__1, (ftnlen)3, (ftnlen)9);
intstr_(&index, marker, (ftnlen)5);
suffix_(".", &c__0, marker, (ftnlen)1, (ftnlen)5);
} else if (s_cmp(cseq, "@symitem", (ftnlen)12, (ftnlen)8) == 0) {
s_copy(marker, "--", (ftnlen)5, (ftnlen)2);
} else if (s_cmp(cseq, "@paritem", (ftnlen)12, (ftnlen)8) == 0) {
s_copy(marker, " ", (ftnlen)5, (ftnlen)1);
}
/* The rest of the text is reformatted into a paragraph of width */
/* PAGEWIDTH - LEFTSKIP - RIGHTSKIP - ITEMINDENT - ITEMSKIP */
/* beginning in column */
/* LEFTSKIP + ITEMINDENT + ITEMSKIP + 1 */
/* The first line contains the marker, right-justified to column */
/* LEFTSKIP + ITEMINDENT */
/* Keep grabbing tokens until the run out. Start a new line whenever */
/* the current line becomes full. REMAIN is the number of spaces */
/* remaining in the current line. */
pgwid = width - lskip - rskip - indent - iskip;
begin = lskip + indent + iskip + 1;
remain = pgwid;
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
rjust_(marker, line, (ftnlen)5, lskip + indent);
s_copy(token, " ", (ftnlen)132, (ftnlen)1);
tokens_("NEXT", source, n, token, &l, (ftnlen)4, source_len, pgwid);
while(s_cmp(token, " ", (ftnlen)132, (ftnlen)1) != 0) {
if (l > remain || s_cmp(token, "@newline", (ftnlen)132, (ftnlen)8) ==
0) {
tempb_("ADD", line, (ftnlen)3, (ftnlen)132);
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
remain = pgwid;
s_copy(line + (begin - 1), token, 132 - (begin - 1), (ftnlen)132);
remain = remain - l - 1;
} else if (s_cmp(line + (begin - 1), " ", 132 - (begin - 1), (ftnlen)
1) == 0) {
s_copy(line + (begin - 1), token, 132 - (begin - 1), (ftnlen)132);
remain = remain - l - 1;
} else {
suffix_(token, &c__1, line + (begin - 1), (ftnlen)132, 132 - (
begin - 1));
remain = remain - l - 1;
}
tokens_("NEXT", source, n, token, &l, (ftnlen)4, source_len, pgwid);
}
if (s_cmp(line, " ", (ftnlen)132, (ftnlen)1) != 0) {
tempb_("ADD", line, (ftnlen)3, (ftnlen)132);
}
/* Every list item is followed by a blank line. */
tempb_("ADD", " ", (ftnlen)3, (ftnlen)1);
chkout_("LIST", (ftnlen)4);
return 0;
} /* list_ */
/* $Procedure ERRHAN ( Insert DAF/DAS file name into long error message ) */
/* Subroutine */ int errhan_(char *marker, integer *handle, ftnlen marker_len)
{
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int zzddhnfo_(integer *, char *, integer *,
integer *, integer *, logical *, ftnlen);
char fname[255];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
logical found;
integer intbff, intarc, intamh;
extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen,
ftnlen), intstr_(integer *, char *, ftnlen);
char numstr[32];
/* $ Abstract */
/* Substitute the first occurrence of a marker in the current long */
/* error message with the file name associated with a given */
/* DAF/DAS handle. (Works for DAF only for N0052.) */
/* $ 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 */
/* ERROR */
/* $ Keywords */
/* DAF */
/* DAS */
/* ERROR */
/* STRING */
/* $ Declarations */
/* $ Abstract */
/* Parameter declarations for the DAF/DAS handle manager. */
/* $ 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 */
/* DAF, DAS */
/* $ Keywords */
/* PRIVATE */
/* $ Particulars */
/* This include file contains parameters defining limits and */
/* integer codes that are utilized in the DAF/DAS handle manager */
/* routines. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 1.0.1, 17-JUL-2002 */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 1.0.0, 07-NOV-2001 */
/* -& */
/* Unit and file table size parameters. */
/* FTSIZE is the maximum number of files (DAS and DAF) that a */
/* user may have open simultaneously. */
/* RSVUNT is the number of units protected from being locked */
/* to a particular handle by ZZDDHHLU. */
/* SCRUNT is the number of units protected for use by scratch */
/* files. */
/* UTSIZE is the maximum number of logical units this manager */
/* will utilize at one time. */
/* Access method enumeration. These parameters are used to */
/* identify which access method is associated with a particular */
/* handle. They need to be synchronized with the STRAMH array */
/* defined in ZZDDHGSD in the following fashion: */
/* STRAMH ( READ ) = 'READ' */
/* STRAMH ( WRITE ) = 'WRITE' */
/* STRAMH ( SCRTCH ) = 'SCRATCH' */
/* STRAMH ( NEW ) = 'NEW' */
/* These values are used in the file table variable FTAMH. */
/* Binary file format enumeration. These parameters are used to */
/* identify which binary file format is associated with a */
/* particular handle. They need to be synchronized with the STRBFF */
/* array defined in ZZDDHGSD in the following fashion: */
/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */
/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */
/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */
/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */
/* These values are used in the file table variable FTBFF. */
/* Some random string lengths... more documentation required. */
/* For now this will have to suffice. */
/* Architecture enumeration. These parameters are used to identify */
/* which file architecture is associated with a particular handle. */
/* They need to be synchronized with the STRARC array defined in */
/* ZZDDHGSD in the following fashion: */
/* STRARC ( DAF ) = 'DAF' */
/* STRARC ( DAS ) = 'DAS' */
/* These values will be used in the file table variable FTARC. */
/* For the following environments, record length is measured in */
/* characters (bytes) with eight characters per double precision */
/* number. */
/* Environment: Sun, Sun FORTRAN */
/* Source: Sun Fortran Programmer's Guide */
/* Environment: PC, MS FORTRAN */
/* Source: Microsoft Fortran Optimizing Compiler User's Guide */
/* Environment: Macintosh, Language Systems FORTRAN */
/* Source: Language Systems FORTRAN Reference Manual, */
/* Version 1.2, page 12-7 */
/* Environment: PC/Linux, g77 */
/* Source: Determined by experiment. */
/* Environment: PC, Lahey F77 EM/32 Version 4.0 */
/* Source: Lahey F77 EM/32 Language Reference Manual, */
/* page 144 */
/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
/* Source: FORTRAN/9000 Reference-Series 700 Computers, */
/* page 5-110 */
/* Environment: NeXT Mach OS (Black Hardware), */
/* Absoft Fortran Version 3.2 */
/* Source: NAIF Program */
/* The following parameter defines the size of a string used */
/* to store a filenames on this target platform. */
/* The following parameter controls the size of the character record */
/* buffer used to read data from non-native files. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* MARKER I A substring in the long error message to be */
/* replaced. */
/* HANDLE I DAF/DAS handle associated with a file. */
/* FILEN P Maximum length of filename. */
/* $ Detailed_Input */
/* MARKER is a character string that marks a position in */
/* the long error message where a file name is to be */
/* substituted. Leading and trailing blanks in MARKER */
/* are not significant. */
/* Case IS significant; 'XX' is considered to be */
/* a different marker from 'xx'. */
/* HANDLE is the DAF/DAS handle associated with the file of */
/* interest. HANDLE must be associated with a currently */
/* loade DAF or DAS file. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* FILEN is the maximum file name length that can be */
/* accommodated by this routine. Currently this */
/* parameter is defined in the include file */
/* zzddhman.inc. */
/* $ Exceptions */
/* Error free. */
/* 1) If HANDLE refers to a scratch DAS file, the string inserted */
/* into the long error message is */
/* 'DAS SCRATCH FILE' */
/* 2) If HANDLE is not associated with a loaded DAF or DAS file, */
/* the string inserted into the long error message is: */
/* '<No name found for handle #>' */
/* where the handle number is substituted for the marker '#'. */
/* $ Files */
/* See "Detailed_Input" description of the variable HANDLE. */
/* $ Particulars */
/* This routine provides a convenient and error-free mechanism */
/* for inserting a DAF or DAS file name into an error message, */
/* given the file handle associated with the file of interest. */
/* $ Examples */
/* 1) Create an error message pertaining to an SPK file */
/* designated by HANDLE, then signal an error. */
/* CALL SETMSG ( 'SPK file # contains a type 3 segment ' // */
/* . 'with invalid polynomial degree #. ' // */
/* . 'Segment index in file is #.' ) */
/* CALL ERRHAN ( '#', HANDLE ) */
/* CALL ERRINT ( '#', DEGREE ) */
/* CALL ERRINT ( '#', I ) */
/* CALL SIGERR ( 'SPICE(INVALIDDEGREE)' ) */
/* $ Restrictions */
/* 1) This routine works only for DAF files in the N0052 Toolkit */
/* version. It will for for both DAF and DAS files for later */
/* Toolkit versions. */
/* 2) The supported filename length is limited by the parameter */
/* FILEN. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 04-JAN-2002 (NJB) */
/* -& */
/* $ Index_Entries */
/* insert filename into long error message */
/* -& */
/* Local parameters */
/* Local variables */
/* Get the name of the file designated by the input handle. */
zzddhnfo_(handle, fname, &intarc, &intbff, &intamh, &found, (ftnlen)255);
if (! found) {
intstr_(handle, numstr, (ftnlen)32);
s_copy(fname, "<No name found for handle ", (ftnlen)255, (ftnlen)26);
suffix_(numstr, &c__1, fname, (ftnlen)32, (ftnlen)255);
suffix_(">", &c__0, fname, (ftnlen)1, (ftnlen)255);
}
/* Insert the file name string into the long error message. */
errch_(marker, fname, marker_len, (ftnlen)255);
return 0;
} /* errhan_ */
/* $Procedure BODVCD ( Return d.p. values from the kernel pool ) */
/* Subroutine */ int bodvcd_(integer *bodyid, char *item, integer *maxn,
integer *dim, doublereal *values, ftnlen item_len)
{
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char code[16], type__[1];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
char varnam[32];
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen), sigerr_(char *, ftnlen),
chkout_(char *, ftnlen), dtpool_(char *, logical *, integer *,
char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen,
ftnlen);
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
/* $ Abstract */
/* Fetch from the kernel pool the double precision values */
/* of an item associated with a body, where the body is */
/* specified by an integer ID code. */
/* $ 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 */
/* KERNEL */
/* NAIF_IDS */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODYID I Body ID code. */
/* ITEM I Item for which values are desired. ('RADII', */
/* 'NUT_PREC_ANGLES', etc. ) */
/* MAXN I Maximum number of values that may be returned. */
/* DIM O Number of values returned. */
/* VALUES O Values. */
/* $ Detailed_Input */
/* BODYID is the NAIF integer ID code for a body of interest. */
/* For example, if the body is the earth, the code is */
/* 399. */
/* ITEM is the item to be returned. Together, the NAIF ID */
/* code of the body and the item name combine to form a */
/* kernel variable name, e.g., */
/* 'BODY599_RADII' */
/* 'BODY401_POLE_RA' */
/* The values associated with the kernel variable having */
/* the name constructed as shown are sought. Below */
/* we'll take the shortcut of calling this kernel variable */
/* the "requested kernel variable." */
/* Note that ITEM *is* case-sensitive. This attribute */
/* is inherited from the case-sensitivity of kernel */
/* variable names. */
/* MAXN is the maximum number of values that may be returned. */
/* The output array VALUES must be declared with size at */
/* least MAXN. It's an error to supply an output array */
/* that is too small to hold all of the values associated */
/* with the requested kernel variable. */
/* $ Detailed_Output */
/* DIM is the number of values returned; this is always the */
/* number of values associated with the requested kernel */
/* variable unless an error has been signaled. */
/* VALUES is the array of values associated with the requested */
/* kernel variable. If VALUES is too small to hold all */
/* of the values associated with the kernel variable, the */
/* returned values of DIM and VALUES are undefined. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the requested kernel variable is not found in the kernel */
/* pool, the error SPICE(KERNELVARNOTFOUND) is signaled. */
/* 2) If the requested kernel variable is found but the associated */
/* values aren't numeric, the error SPICE(TYPEMISMATCH) is */
/* signaled. */
/* 3) The output array VALUES must be declared with sufficient size */
/* to contain all of the values associated with the requested */
/* kernel variable. If the dimension of */
/* VALUES indicated by MAXN is too small to contain the */
/* requested values, the error SPICE(ARRAYTOOSMALL) is signaled. */
/* 4) If the input dimension MAXN indicates there is more room */
/* in VALUES than there really is---for example, if MAXN is */
/* 10 but values is declared with dimension 5---and the dimension */
/* of the requested kernel variable is larger than the actual */
/* dimension of VALUES, then this routine may overwrite */
/* memory. The results are unpredictable. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine simplifies looking up PCK kernel variables by */
/* constructing names of requested kernel variables and by */
/* performing error checking. */
/* This routine is intended for use in cases where the maximum */
/* number of values that may be returned is known at compile */
/* time. The caller fetches all of the values associated with */
/* the specified kernel variable via a single call to this */
/* routine. If the number of values to be fetched cannot be */
/* known until run time, the lower-level routine GDPOOL (an */
/* entry point of POOL) should be used instead. GDPOOL supports */
/* fetching arbitrary amounts of data in multiple "chunks." */
/* This routine is intended for use in cases where the requested */
/* kernel variable is expected to be present in the kernel pool. If */
/* the variable is not found or has the wrong data type, this */
/* routine signals an error. In cases where it is appropriate to */
/* indicate absence of an expected kernel variable by returning a */
/* boolean "found flag" with the value .FALSE., again the routine */
/* GDPOOL should be used. */
/* $ Examples */
/* 1) When the kernel variable */
/* BODY399_RADII */
/* is present in the kernel pool---normally because a PCK */
/* defining this variable has been loaded---the call */
/* CALL BODVCD ( 399, 'RADII', 3, DIM, VALUES ) */
/* returns the dimension and values associated with the variable */
/* 'BODY399_RADII', for example, */
/* DIM = 3 */
/* VALUES(1) = 6378.140 */
/* VALUES(2) = 6378.140 */
/* VALUES(3) = 6356.755 */
/* 2) The call */
/* CALL BODVCD ( 399, 'radii', 3, DIM, VALUES ) */
/* usually will cause a SPICE(KERNELVARNOTFOUND) error to be */
/* signaled, because this call will attempt to look up the */
/* values associated with a kernel variable of the name */
/* 'BODY399_radii' */
/* Since kernel variable names are case sensitive, this */
/* name is not considered to match the name */
/* 'BODY399_RADII' */
/* which normally would be present after a text PCK */
/* containing data for all planets and satellites has */
/* been loaded. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 24-OCT-2004 (NJB) (BVS) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* fetch constants for a body from the kernel pool */
/* physical constants for a body */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("BODVCD", (ftnlen)6);
}
/* Construct the variable name from BODY and ITEM. */
s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4);
intstr_(bodyid, code, (ftnlen)16);
suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32);
suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32);
suffix_(item, &c__0, varnam, item_len, (ftnlen)32);
/* Make sure the item is present in the kernel pool. */
dtpool_(varnam, &found, dim, type__, (ftnlen)32, (ftnlen)1);
if (! found) {
setmsg_("The variable # could not be found in the kernel pool.", (
ftnlen)53);
errch_("#", varnam, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("BODVCD", (ftnlen)6);
return 0;
}
/* Make sure the item's data type is numeric. */
if (*(unsigned char *)type__ != 'N') {
setmsg_("The data associated with variable # are not of numeric type."
, (ftnlen)60);
errch_("#", varnam, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(TYPEMISMATCH)", (ftnlen)19);
chkout_("BODVCD", (ftnlen)6);
return 0;
}
/* Make sure there's enough room in the array VALUES to hold */
/* the requested data. */
if (*maxn < *dim) {
setmsg_("The data array associated with variable # has dimension #, "
"which is larger than the available space # in the output arr"
"ay.", (ftnlen)122);
errch_("#", varnam, (ftnlen)1, (ftnlen)32);
errint_("#", dim, (ftnlen)1);
errint_("#", maxn, (ftnlen)1);
sigerr_("SPICE(ARRAYTOOSMALL)", (ftnlen)20);
chkout_("BODVCD", (ftnlen)6);
return 0;
}
/* Grab the values. We know at this point they're present in */
/* the kernel pool, so we don't check the FOUND flag. */
gdpool_(varnam, &c__1, maxn, dim, values, &found, (ftnlen)32);
chkout_("BODVCD", (ftnlen)6);
return 0;
} /* bodvcd_ */
