/* $Procedure ZZASCII ( determine/verify EOL terminators in a text file ) */
/* Subroutine */ int zzascii_(char *file, char *line, logical *check, char *
termin, ftnlen file_len, ftnlen line_len, ftnlen termin_len)
{
/* System generated locals */
olist o__1;
cllist cl__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_len(char *, ftnlen), f_open(olist *), f_clos(cllist *), s_rdue(
cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void);
/* Local variables */
extern /* Subroutine */ int zzplatfm_(char *, char *, ftnlen, ftnlen);
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
extern integer rtrim_(char *, ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
integer maccnt, reclen;
char native[5];
integer number, doscnt;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), getlun_(integer *), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
integer unxcnt;
/* Fortran I/O blocks */
static cilist io___5 = { 1, 0, 1, 0, 1 };
/* $ Abstract */
/* Returns a string indicating the line terminators of an ASCII file */
/* and, if requested, stops execution if the terminator does match */
/* the one that is native to the platform on which the toolkit was */
/* compiled. */
/* $ 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 */
/* FILE TYPE */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* FILE I Name of the text file to scan. */
/* LINE I The work string for file reads. */
/* CHECK I Flag directing to check for mismatched EOL. */
/* TERMIN 0 The deduced terminator ID. */
/* $ Detailed_Input */
/* FILE the name of the ASCII file to scan for a line */
/* terminator */
/* LINE a character string of sufficient length to perform the */
/* line reads from FILE. */
/* CHECK a logical flag that, if set to .TRUE., instructs this */
/* routine to check terminator that has been determined */
/* against the one that is native to the platform, on */
/* which the toolkit was compiled, and to generate error */
/* if it was not the case. If set to .FALSE., instructs */
/* the routine to bypass the check. */
/* $ Detailed_Output */
/* TERMIN the terminator ID extracted from FILE. The possible */
/* values: */
/* 'CR' - carriage return (Mac classic) */
/* 'LF' - line feed (Unix) */
/* 'CR-LF' - carriage return and line feed (DOS) */
/* '?' - unable to determine, possibly */
/* due to an error event */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) A SPICE(STRINGTOOSHORT) error signals if LINE has length less */
/* than 3. */
/* 2) A SPICE(FILEOPENFAILED) error signals if the file of interest */
/* fails to open, i.e. IOSTAT < 0. */
/* 3) A text kernel found to contain non-native line terminators */
/* and abort of the run was requested by causes this routine to */
/* signal the error SPICE(INCOMPATIBLEEOL). */
/* $ Files */
/* None. */
/* $ Particulars */
/* The function scans a string read from a text file to determine */
/* the native platform of the file. The functions response is */
/* unpredictable if it scans a binary file. */
/* $ Examples */
/* To return EOL terminator for a given file: */
/* CHARACTER*(5) TERMIN */
/* CHARACTER*(64) LINE */
/* ... given a file name */
/* ... and a line long enough to hold a text string */
/* from FILE */
/* CALL ZZASCII( FILE, LINE, .FALSE., TERMIN ) */
/* CALL TOSTDO( 'FOUND FILE TERMINATOR '//TERMIN ) */
/* To stop if EOL terminator for a given file, if detected */
/* successfully, is not native to this platform: */
/* CHARACTER*(5) TERMIN */
/* CHARACTER*(64) LINE */
/* ... given a file name */
/* ... and a line long enough to hold a text string */
/* from FILE */
/* CALL ZZASCII( FILE, LINE, .TRUE., TERMIN ) */
/* If the EOL terminator was not native, the call will generate */
/* SPICE(INCOMPATIBLEEOL) error. */
/* $ Restrictions */
/* 1) The terminator detection is not performed if the read from */
/* the file fails because the file is smaller than the allocated */
/* LINE size or for any other reason. */
/* 2) The terminator detection is not possible if the length of the */
/* first text line in the file exceeds the length of the LINE */
/* work space. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* B.V. Semenov (JPL) */
/* $ 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.1, 26-OCT-2006 (EDW) */
/* Expanded error message explanation the */
/* routine outputs when the file-of-interest */
/* includes non-native text line terminators. */
/* - 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.0, 17-FEB-2004 (EDW) (BVS) */
/* -& */
/* $ Index_Entries */
/* determine ascii text file end-of-line type */
/* -& */
/* SPICELIB functions. */
/* Local parameters. */
/* Local variables. */
/* Discovery check-in. Can't determine the terminator in RETURN */
/* mode. */
if (return_()) {
s_copy(termin, "?", termin_len, (ftnlen)1);
return 0;
}
/* Check-in to the error system. */
chkin_("ZZASCII", (ftnlen)7);
/* Retrieve the native line terminator. */
zzplatfm_("TEXT_FORMAT", native, (ftnlen)11, (ftnlen)5);
/* If it is VAX, return immediately with undefined terminator. */
if (eqstr_(native, "VAX", (ftnlen)5, (ftnlen)3)) {
s_copy(termin, "?", termin_len, (ftnlen)1);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* Set the record lenght that will be used to read data from */
/* the file. */
reclen = i_len(line, line_len);
/* Check the length of the work string is sufficient to perform the */
/* operations. Less than 3 is a no-op. */
if (i_len(line, line_len) < 3) {
s_copy(termin, "?", termin_len, (ftnlen)1);
setmsg_("Work string lacks sufficient length to perform operation.", (
ftnlen)57);
sigerr_("SPICE(STRINGTOOSHORT)", (ftnlen)21);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* Find a free logical unit for file access. */
getlun_(&number);
/* Open the file for DIRECT access. */
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = rtrim_(file, file_len);
o__1.ofnm = file;
o__1.orl = reclen;
o__1.osta = "OLD";
o__1.oacc = "DIRECT";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
if (iostat != 0) {
/* The open failed, can't determine the terminator if the routine */
/* can't open the file. */
s_copy(termin, "?", termin_len, (ftnlen)1);
/* Execute a close, J.I.C. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
setmsg_("File open failed for file '$1'. IOSTAT value $2.", (ftnlen)
49);
errch_("$1", file, (ftnlen)2, file_len);
errint_("$2", &iostat, (ftnlen)2);
sigerr_("SPICE(FILEOPENFAIL)", (ftnlen)19);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* Read a line into the LINE variable assigned by the user. */
s_copy(line, " ", line_len, (ftnlen)1);
io___5.ciunit = number;
iostat = s_rdue(&io___5);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, line, line_len);
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
if (iostat != 0) {
/* If something went wrong during this read, a part or the whole */
/* returned line may contain garbage. Instead of examining it and */
/* making wrong determination based on it, set terminator to */
/* undefined and return. */
s_copy(termin, "?", termin_len, (ftnlen)1);
/* Execute a close, J.I.C. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* We have a line of text data. Use ICHAR to scan for carriage */
/* returns and line feeds and count how may of various recognized */
/* line termination sequences are in this line. */
doscnt = 0;
unxcnt = 0;
maccnt = 0;
i__ = 1;
while(i__ < i_len(line, line_len)) {
/* Check for ICHAR values of 10 (LF) and 13 (CR). */
if (*(unsigned char *)&line[i__ - 1] == 10) {
/* Found a UNIX line terminator LF. */
++unxcnt;
} else if (*(unsigned char *)&line[i__ - 1] == 13) {
/* Found CR, increment character counter and check */
/* the next character. */
++i__;
if (*(unsigned char *)&line[i__ - 1] == 10) {
/* Found a DOS line terminator CR+LF. */
++doscnt;
} else {
/* Found a Classic Mac line terminator CR. */
++maccnt;
}
}
++i__;
}
/* Examine the counters. */
if (doscnt > 0 && unxcnt == 0 && maccnt == 0) {
/* Only DOS terminator counter is non-zero. ID the file as DOS. */
s_copy(termin, "CR-LF", termin_len, (ftnlen)5);
} else if (doscnt == 0 && unxcnt > 0 && maccnt == 0) {
/* Only Unix terminator counter is non-zero. ID the file as UNIX. */
s_copy(termin, "LF", termin_len, (ftnlen)2);
} else if (doscnt == 0 && unxcnt == 0 && maccnt > 0) {
/* Only Mac terminator counter is non-zero. ID the file as Mac */
/* Classic. */
s_copy(termin, "CR", termin_len, (ftnlen)2);
} else {
/* We can get here in two cases. First if the line did not */
/* contain any CRs or LFs. Second if the line contained more than */
/* one kind of terminators. In either case the format of the file */
/* is unclear. */
s_copy(termin, "?", termin_len, (ftnlen)1);
}
/* Close the file. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
/* If we were told check the terminator against the native one, do */
/* it. */
if (*check) {
/* If the terminator was identified and does not match the native */
/* one, error out. */
if (! eqstr_(termin, native, termin_len, (ftnlen)5) && ! eqstr_(
termin, "?", termin_len, (ftnlen)1)) {
setmsg_("Text file '$1' contains lines terminated with '$2' whil"
"e the expected terminator for this platform is '$3'. SPI"
"CE cannot process the file in the current form. This pro"
"blem likely occurred because the file was copied in bina"
"ry mode between operating systems where the operating sy"
"stems use different text line terminators. Try convertin"
"g the file to native text form using a utility such as d"
"os2unix or unix2dos.", (ftnlen)411);
errch_("$1", file, (ftnlen)2, file_len);
errch_("$2", termin, (ftnlen)2, termin_len);
errch_("$3", native, (ftnlen)2, (ftnlen)5);
sigerr_("SPICE(INCOMPATIBLEEOL)", (ftnlen)22);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
}
chkout_("ZZASCII", (ftnlen)7);
return 0;
} /* zzascii_ */
/* $Procedure ZZEKCDSC ( Private: EK, return column descriptor ) */
/* Subroutine */ int zzekcdsc_(integer *handle, integer *segdsc, char *column,
integer *coldsc, ftnlen column_len)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer unit, i__;
char cname[32];
integer mbase;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
integer ncols;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
integer dscbas;
extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *,
integer *, integer *, char *, ftnlen);
integer nambas;
extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *,
integer *), dashlu_(integer *, integer *), setmsg_(char *, ftnlen)
, errint_(char *, integer *, ftnlen), errfnm_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(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. */
/* Look up the column descriptor for a column of a given name */
/* in a specified segment. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ 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. */
/* Include Section: EK Column Name Size */
/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */
/* Size of column name, in characters. */
/* End Include Section: EK Column Name Size */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to an EK file. */
/* SEGDSC I Segment descriptor. */
/* COLUMN I Name of column. */
/* COLDSC O Descriptor for specified column. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle for the file containing the */
/* column of interest. The EK may be open for read */
/* or write access. */
/* SEGDSC is the descriptor of the segment containing the */
/* column for which a descriptor is desired. */
/* COLUMN is the name of the column whose descriptor is */
/* desired. Case and white space are not significant. */
/* $ Detailed_Output */
/* COLDSC is the descriptor of the column belonging to the */
/* specified file and segment and having name COLUMN. */
/* See the include file ekcoldsc.inc for details */
/* regarding the structure of EK column descriptors. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input column name does not match any column in the */
/* designated segment, the error SPICE(BUG) is signalled. It */
/* is the caller's responsibility to call this routine with */
/* valid input arguments. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine exists for the sole purpose of centralizing code */
/* used to perform column descriptor look-ups. */
/* $ Examples */
/* See the EKACEx routines. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* Get the segment's integer metadata's base address. */
mbase = segdsc[2];
/* Get the number of columns. */
ncols = segdsc[4];
/* Search linearly through the column descriptors, looking for */
/* a column name match. It's an error if we don't find the input */
/* name. */
found = FALSE_;
i__ = 1;
while(i__ <= ncols && ! found) {
dscbas = mbase + 24 + (i__ - 1) * 11;
/* Get the character base address of the column name from the */
/* current descriptor. */
i__1 = dscbas + 1;
i__2 = dscbas + 11;
dasrdi_(handle, &i__1, &i__2, coldsc);
nambas = coldsc[4];
/* Look up the name and compare. */
i__1 = nambas + 1;
i__2 = nambas + 32;
dasrdc_(handle, &i__1, &i__2, &c__1, &c__32, cname, (ftnlen)32);
if (eqstr_(cname, column, (ftnlen)32, column_len)) {
found = TRUE_;
} else {
++i__;
}
}
if (! found) {
dashlu_(handle, &unit);
chkin_("ZZEKCDSC", (ftnlen)8);
setmsg_("Descriptor for column # was not found. Segment base = #; fi"
"le = #.", (ftnlen)66);
errch_("#", column, (ftnlen)1, column_len);
errint_("#", &mbase, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKCDSC", (ftnlen)8);
return 0;
}
return 0;
} /* zzekcdsc_ */
/* $Procedure ILLUM ( Illumination angles ) */
/* Subroutine */ int illum_(char *target, doublereal *et, char *abcorr, char *
obsrvr, doublereal *spoint, doublereal *phase, doublereal *solar,
doublereal *emissn, ftnlen target_len, ftnlen abcorr_len, ftnlen
obsrvr_len)
{
/* Initialized data */
static logical first = TRUE_;
extern /* Subroutine */ int zzbods2c_(integer *, char *, integer *,
logical *, char *, integer *, logical *, ftnlen, ftnlen);
extern doublereal vsep_(doublereal *, doublereal *);
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *), zzctruin_(integer *);
integer n;
doublereal radii[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
static logical svfnd1, svfnd2;
static integer svctr1[2], svctr2[2];
integer obscde;
doublereal lt;
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
char frname[80];
integer trgcde;
doublereal offobs[3], obsvec[3], tepoch, normal[3];
static integer svtcde;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svobsc;
doublereal offsun[3];
extern /* Subroutine */ int setmsg_(char *, ftnlen);
doublereal sstate[6], sunvec[3], tstate[6];
static char svtarg[36];
extern /* Subroutine */ int surfnm_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
extern logical return_(void);
static char svobsr[36];
extern /* Subroutine */ int vminus_(doublereal *, doublereal *);
doublereal lts;
/* $ Abstract */
/* Deprecated: This routine has been superseded by the SPICELIB */
/* routine ILUMIN. This routine is supported for purposes of */
/* backward compatibility only. */
/* Find the illumination angles at a specified surface point of a */
/* target body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* KERNEL */
/* NAIF_IDS */
/* SPK */
/* TIME */
/* $ Keywords */
/* GEOMETRY */
/* MOSPICE */
/* $ Declarations */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARGET I Name of target body. */
/* ET I Epoch in ephemeris seconds past J2000. */
/* ABCORR I Desired aberration correction. */
/* OBSRVR I Name of observing body. */
/* SPOINT I Body-fixed coordinates of a target surface point. */
/* PHASE O Phase angle at the surface point. */
/* SOLAR O Solar incidence angle at the surface point. */
/* EMISSN O Emission angle at the surface point. */
/* $ Detailed_Input */
/* TARGET is the name of the target body. TARGET is */
/* case-insensitive, and leading and trailing blanks */
/* in TARGET are not significant. Optionally, you may */
/* supply a string containing the integer ID code for */
/* the object. For example both 'MOON' and '301' are */
/* legitimate strings that indicate the moon is the */
/* target body. */
/* ET is the epoch, specified in ephemeris seconds past */
/* J2000, at which the apparent illumination angles at */
/* the specified surface point on the target body, as */
/* seen from the observing body, are to be computed. */
/* ABCORR is the aberration correction to be used in */
/* computing the location and orientation of the */
/* target body and the location of the Sun. Possible */
/* values are: */
/* 'NONE' No aberration correction. */
/* 'LT' Correct the position and */
/* orientation of target body for */
/* light time, and correct the */
/* position of the Sun for light */
/* time. */
/* 'LT+S' Correct the observer-target vector */
/* for light time and stellar */
/* aberration, correct the */
/* orientation of the target body */
/* for light time, and correct the */
/* target-Sun vector for light time */
/* and stellar aberration. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light */
/* time equation, the 'CN' */
/* correction iterates until the */
/* solution converges (three */
/* iterations on all supported */
/* platforms). Whether the 'CN+S' */
/* solution is substantially more */
/* accurate than the 'LT' solution */
/* depends on the geometry of the */
/* participating objects and on the */
/* accuracy of the input data. In */
/* all cases this routine will */
/* execute more slowly when a */
/* converged solution is computed. */
/* See the Particulars section of */
/* SPKEZR for a discussion of */
/* precision of light time */
/* corrections. */
/* Both the state and rotation of */
/* the target body are corrected for */
/* light time. */
/* 'CN+S' Converged Newtonian light time */
/* correction and stellar aberration */
/* correction. */
/* Both the state and rotation of */
/* the target body are corrected for */
/* light time. */
/* OBSRVR is the name of the observing body, typically a */
/* spacecraft, the earth, or a surface point on the */
/* earth. OBSRVR is case-insensitive, and leading */
/* and trailing blanks in OBSRVR are not significant. */
/* Optionally, you may supply a string containing the */
/* integer ID code for the object. For example both */
/* 'EARTH' and '399' are legitimate strings that */
/* indicate the earth is the observer. */
/* OBSRVR may be not be identical to TARGET. */
/* SPOINT is a surface point on the target body, expressed */
/* in rectangular body-fixed (body equator and prime */
/* meridian) coordinates. SPOINT need not be visible */
/* from the observer's location at time ET. */
/* $ Detailed_Output */
/* PHASE is the phase angle at SPOINT, as seen from OBSRVR */
/* at time ET. This is the angle between the */
/* SPOINT-OBSRVR vector and the SPOINT-Sun vector. */
/* Units are radians. The range of PHASE is [0, pi]. */
/* See Particulars below for a detailed discussion of */
/* the definition. */
/* SOLAR is the solar incidence angle at SPOINT, as seen */
/* from OBSRVR at time ET. This is the angle */
/* between the surface normal vector at SPOINT and the */
/* SPOINT-Sun vector. Units are radians. The range */
/* of SOLAR is [0, pi]. See Particulars below for a */
/* detailed discussion of the definition. */
/* EMISSN is the emission angle at SPOINT, as seen from */
/* OBSRVR at time ET. This is the angle between the */
/* surface normal vector at SPOINT and the */
/* SPOINT-observer vector. Units are radians. The */
/* range of EMISSN is [0, pi]. See Particulars below */
/* for a detailed discussion of the definition. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If TARGET and OBSRVR are not distinct, the error */
/* SPICE(BODIESNOTDISTINCT) will be signaled. */
/* 2) If no SPK (ephemeris) data are available for the observer, */
/* target, and Sun at the time specified by ET, the error will */
/* be diagnosed by routines called by this routine. If light */
/* time corrections are used, SPK data for the target body must */
/* be available at the time ET - LT, where LT is the one-way */
/* light time from the target to the observer at ET. */
/* Additionally, SPK data must be available for the Sun at the */
/* time ET - LT - LT2, where LT2 is the light time from the Sun */
/* to the target body at time ET - LT. */
/* 3) If PCK data defining the orientation or shape of the target */
/* body are unavailable, the error will be diagnosed by routines */
/* called by this routine. */
/* 4) If no body-fixed frame is associated with the target body, */
/* the error SPICE(NOFRAME) is signaled. */
/* 5) If name of target or observer cannot be translated to its */
/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */
/* $ Files */
/* No files are input to this routine. However, ILLUM expects */
/* that the appropriate SPK and PCK files have been loaded via */
/* FURNSH. */
/* $ Particulars */
/* The term "illumination angles" refers to following set of */
/* angles: */
/* solar incidence angle Angle between the surface normal at */
/* the specified surface point and the */
/* vector from the surface point to the */
/* Sun. */
/* emission angle Angle between the surface normal at */
/* the specified surface point and the */
/* vector from the surface point to the */
/* observer. */
/* phase angle Angle between the vectors from the */
/* surface point to the observing body's */
/* location and from the surface point */
/* to the Sun. */
/* The diagram below illustrates the geometrical relationships */
/* defining these angles. The labels for the solar incidence, */
/* emission, and phase angles are "s.i.", "e.", and "phase". */
/* * */
/* Sun */
/* surface normal vector */
/* ._ _. */
/* |\ /| Sun vector */
/* \ phase / */
/* \ . . / */
/* . . */
/* \ ___ / */
/* . \/ \/ */
/* _\ s.i./ */
/* . / \ / */
/* . | e. \ / */
/* * <--------------- * surface point on */
/* viewing vector target body */
/* location to viewing */
/* (observer) location */
/* Note that if the target-observer vector, the target normal vector */
/* at the surface point, and the target-sun vector are coplanar, */
/* then phase is the sum of incidence and emission. This is rarely */
/* true; usually */
/* phase angle < solar incidence angle + emission angle */
/* All of the above angles can be computed using light time */
/* corrections, light time and stellar aberration corrections, or */
/* no aberration corrections. The way aberration corrections */
/* are used is described below. */
/* Care must be used in computing light time corrections. The */
/* guiding principle used here is "describe what appears in */
/* an image." We ignore differential light time; the light times */
/* from all points on the target to the observer are presumed to be */
/* equal. */
/* Observer-target body vector */
/* --------------------------- */
/* Let ET be the epoch at which an observation or remote */
/* sensing measurement is made, and let ET - LT ("LT" stands */
/* for "light time") be the epoch at which the photons received */
/* at ET were emitted from the body (we use the term "emitted" */
/* loosely here). */
/* The correct observer-target vector points from the observer's */
/* location at ET to the target body's location at ET - LT. */
/* The target-observer vector points in the opposite direction. */
/* Since light time corrections are not symmetric, the correct */
/* target-observer vector CANNOT be found by computing the light */
/* time corrected position of the observer as seen from the */
/* target body. */
/* Target body's orientation */
/* ------------------------- */
/* Using the definitions of ET and LT above, the target */
/* body's orientation at ET - LT is used. The surface */
/* normal is dependent on the target body's orientation, so */
/* the body's orientation model must be evaluated for the correct */
/* epoch. */
/* Target body -- Sun vector */
/* ------------------------- */
/* All surface features on the target body will appear in */
/* a measurement made at ET as they were at ET-LT. In */
/* particular, lighting on the target body is dependent on */
/* the apparent location of the Sun as seen from the target */
/* body at ET-LT. So, a second light time correction is used */
/* in finding the apparent location of the Sun. */
/* Stellar aberration corrections, when used, are applied as follows: */
/* Observer-target body vector */
/* --------------------------- */
/* In addition to light time correction, stellar aberration is */
/* used in computing the apparent target body position as seen */
/* from the observer's location at time ET. This apparent */
/* position defines the observer-target body vector. */
/* Target body-Sun vector */
/* ---------------------- */
/* The target body-Sun vector is the apparent position of the Sun, */
/* corrected for light time and stellar aberration, as seen from */
/* the target body at time ET-LT. Note that the target body's */
/* position is not affected by the stellar aberration correction */
/* applied in finding its apparent position as seen by the */
/* observer. */
/* Once all of the vectors, as well as the target body's */
/* orientation, have been computed with the proper aberration */
/* corrections, the element of time is eliminated from the */
/* computation. The problem becomes a purely geometrical one, */
/* and is described by the diagram above. */
/* $ Examples */
/* The numerical results shown for this example may differ across */
/* platforms. The results depend on the SPICE kernels used as */
/* input, the compiler and supporting libraries, and the machine */
/* specific arithmetic implementation. */
/* In the following example program, the file */
/* spk_m_031103-040201_030502.bsp */
/* is a binary SPK file containing data for Mars Global Surveyor, */
/* Mars, and the Sun for a time interval bracketing the date */
/* 2004 JAN 1 12:00:00 UTC. */
/* pck00007.tpc is a planetary constants kernel file containing */
/* radii and rotation model constants. naif0007.tls is a */
/* leapseconds kernel. */
/* Find the phase, solar incidence, and emission angles at the */
/* sub-solar and sub-spacecraft points on Mars as seen from the */
/* Mars Global Surveyor spacecraft at a specified UTC time. */
/* Use light time and stellar aberration corrections. */
/* PROGRAM ANGLES */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION DPR */
/* C */
/* C Local parameters */
/* C */
/* INTEGER NAMLEN */
/* PARAMETER ( NAMLEN = 32 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 25 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(NAMLEN) OBSRVR */
/* CHARACTER*(NAMLEN) TARGET */
/* CHARACTER*(TIMLEN) UTC */
/* DOUBLE PRECISION ALT */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION SSCEMI */
/* DOUBLE PRECISION SSCPHS */
/* DOUBLE PRECISION SSCSOL */
/* DOUBLE PRECISION SSLEMI */
/* DOUBLE PRECISION SSLPHS */
/* DOUBLE PRECISION SSLSOL */
/* DOUBLE PRECISION SSOLPT ( 3 ) */
/* DOUBLE PRECISION SSCPT ( 3 ) */
/* C */
/* C Load kernel files. */
/* C */
/* CALL FURNSH ( 'naif0007.tls' ) */
/* CALL FURNSH ( 'pck00007.tpc' ) */
/* CALL FURNSH ( 'spk_m_031103-040201_030502.bsp' ) */
/* C */
/* C Convert our UTC time to ephemeris seconds past J2000. */
/* C */
/* UTC = '2004 JAN 1 12:00:00' */
/* CALL UTC2ET ( UTC, ET ) */
/* C */
/* C Assign observer and target names. The acronym MGS */
/* C indicates Mars Global Surveyor. See NAIF_IDS for a */
/* C list of names recognized by SPICE. */
/* C */
/* TARGET = 'Mars' */
/* OBSRVR = 'MGS' */
/* C */
/* C Find the sub-solar point on the Earth as seen from */
/* C the MGS spacecraft at ET. Use the "surface intercept" */
/* C style of sub-point definition. This makes it easy */
/* C to verify the solar incidence angle. */
/* C */
/* CALL SUBSOL ( 'Near point', TARGET, ET, */
/* . 'LT+S', OBSRVR, SSOLPT ) */
/* C */
/* C Now find the sub-spacecraft point. Use the */
/* C "nearest point" definition of the sub-point */
/* C here---this makes it easy to verify the emission angle. */
/* C */
/* CALL SUBPT ( 'Near point', TARGET, ET, */
/* . 'LT+S', OBSRVR, SSCPT, ALT ) */
/* C */
/* C Find the phase, solar incidence, and emission */
/* C angles at the sub-solar point on the Earth as seen */
/* C from Mars Observer at time ET. */
/* C */
/* CALL ILLUM ( TARGET, ET, 'LT+S', OBSRVR, */
/* . SSOLPT, SSLPHS, SSLSOL, SSLEMI ) */
/* C */
/* C Do the same for the sub-spacecraft point. */
/* C */
/* CALL ILLUM ( TARGET, ET, 'LT+S', OBSRVR, */
/* . SSCPT, SSCPHS, SSCSOL, SSCEMI ) */
/* C */
/* C Convert the angles to degrees and write them out. */
/* C */
/* SSLPHS = DPR() * SSLPHS */
/* SSLSOL = DPR() * SSLSOL */
/* SSLEMI = DPR() * SSLEMI */
/* SSCPHS = DPR() * SSCPHS */
/* SSCSOL = DPR() * SSCSOL */
/* SSCEMI = DPR() * SSCEMI */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'UTC epoch is ', UTC */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Illumination angles at the sub-solar point:' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Phase angle (deg.): ', SSLPHS */
/* WRITE (*,*) 'Solar incidence angle (deg.): ', SSLSOL */
/* WRITE (*,*) 'Emission angle (deg.): ', SSLEMI */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'The solar incidence angle should be 0.' */
/* WRITE (*,*) 'The emission and phase angles should be equal.' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Illumination angles at the sub-s/c point:' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Phase angle (deg.): ', SSCPHS */
/* WRITE (*,*) 'Solar incidence angle (deg.): ', SSCSOL */
/* WRITE (*,*) 'Emission angle (deg.): ', SSCEMI */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'The emission angle should be 0.' */
/* WRITE (*,*) 'The solar incidence and phase angles should '// */
/* . 'be equal.' */
/* END */
/* When this program is executed, the output will be: */
/* UTC epoch is 2004 JAN 1 12:00:00 */
/* Illumination angles at the sub-solar point: */
/* Phase angle (deg.): 150.210714 */
/* Solar incidence angle (deg.): 6.3735213E-15 */
/* Emission angle (deg.): 150.210714 */
/* The solar incidence angle should be 0. */
/* The emission and phase angles should be equal. */
/* Illumination angles at the sub-s/c point: */
/* Phase angle (deg.): 123.398202 */
/* Solar incidence angle (deg.): 123.398202 */
/* Emission angle (deg.): 6.36110936E-15 */
/* The emission angle should be 0. */
/* The solar incidence and phase angles should be equal. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* B.V. Semenov (JPL) */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.3.0, 04-JUL-2014 (NJB) (BVS) */
/* Discussion of light time corrections was updated. Assertions */
/* that converged light time corrections are unlikely to be */
/* useful were removed. */
/* Last update was 19-SEP-2013 (BVS) */
/* Updated to save the input body names and ZZBODTRN state */
/* counters and to do name-ID conversions only if the counters */
/* have changed. */
/* - SPICELIB Version 1.2.2, 18-MAY-2010 (BVS) */
/* Index lines now state that this routine is deprecated. */
/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */
/* Abstract now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSUB calls. Replaced call to BODVAR with call to BODVCD. */
/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */
/* Updated to support representations of integers in the input */
/* arguments TARGET and OBSRVR. */
/* - SPICELIB Version 1.0.2, 27-JUL-2003 (NJB) (CHA) */
/* Various header corrections were made. The example program */
/* was upgraded to use real kernels, and the program's output is */
/* shown. */
/* - SPICELIB Version 1.0.1, 10-JUL-2002 (NJB) */
/* Updated Index_Entries header section. */
/* - SPICELIB Version 1.0.0, 21-MAR-1999 (NJB) */
/* Adapted from the MGSSPICE version dated 10-MAR-1992. */
/* -& */
/* $ Index_Entries */
/* DEPRECATED illumination angles */
/* DEPRECATED lighting angles */
/* DEPRECATED phase angle */
/* DEPRECATED solar incidence angle */
/* DEPRECATED emission angle */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSUB calls. Replaced call to BODVAR with call to BODVCD. */
/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */
/* Updated to support representations of integers in the */
/* input arguments TARGET and OBSRVR: calls to BODN2C */
/* were replaced by calls to BODS2C. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Saved body name length. */
/* Local variables */
/* Saved name/ID item declarations. */
/* Saved name/ID items. */
/* Initial values. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ILLUM", (ftnlen)5);
}
/* Initialization. */
if (first) {
/* Initialize counters. */
zzctruin_(svctr1);
zzctruin_(svctr2);
first = FALSE_;
}
/* Obtain integer codes for the target and observer. */
zzbods2c_(svctr1, svtarg, &svtcde, &svfnd1, target, &trgcde, &found, (
ftnlen)36, target_len);
if (! found) {
setmsg_("The target, '#', is not a recognized name for an ephemeris "
"object. The cause of this problem may be that you need an up"
"dated version of the SPICE Toolkit. ", (ftnlen)155);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("ILLUM", (ftnlen)5);
return 0;
}
zzbods2c_(svctr2, svobsr, &svobsc, &svfnd2, obsrvr, &obscde, &found, (
ftnlen)36, obsrvr_len);
if (! found) {
setmsg_("The observer, '#', is not a recognized name for an ephemeri"
"s object. The cause of this problem may be that you need an "
"updated version of the SPICE Toolkit. ", (ftnlen)157);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("ILLUM", (ftnlen)5);
return 0;
}
/* The observer and target must be distinct. */
if (trgcde == obscde) {
setmsg_("Target is #; observer is #.", (ftnlen)27);
errch_("#", target, (ftnlen)1, target_len);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
chkout_("ILLUM", (ftnlen)5);
return 0;
}
/* Find the name of the body-fixed frame associated with the */
/* target body. We'll want the state of the target relative to */
/* the observer in this body-fixed frame. */
cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
if (! found) {
setmsg_("No body-fixed frame is associated with target body #; a fra"
"me kernel must be loaded to make this association. Consult "
"the FRAMES Required Reading for details.", (ftnlen)159);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("ILLUM", (ftnlen)5);
return 0;
}
/* Find the body-fixed state of the target as seen from the observer */
/* at ET. The appropriate aberration corrections will be used in */
/* evaluating this state. */
spkez_(&trgcde, et, frname, abcorr, &obscde, tstate, <, (ftnlen)80,
abcorr_len);
/* Determine the epoch to be used in computing the target-Sun vector. */
if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) {
tepoch = *et;
} else {
tepoch = *et - lt;
}
/* Find the body-fixed state of the Sun as seen from the target at */
/* TEPOCH. */
spkez_(&c__10, &tepoch, frname, abcorr, &trgcde, sstate, <s, (ftnlen)80,
abcorr_len);
/* Grab the position portions of the states (the first three */
/* elements of each state). Negate the observer-target vector, */
/* since the vector required for the illumination angle */
/* computation is the target-observer vector. The vectors we've */
/* found point from the target body center to the observer and */
/* Sun, and already take light time corrections into account. */
vminus_(tstate, obsvec);
vequ_(sstate, sunvec);
/* Now we'll modify target-observer and target-Sun vectors to */
/* take into account the offset between the target center and the */
/* surface point of interest; we want the vectors to point from */
/* the surface point to the observer and Sun respectively. */
vsub_(obsvec, spoint, offobs);
vsub_(sunvec, spoint, offsun);
/* Find the surface normal at SPOINT. We'll need the radii of the */
/* target body. */
bodvcd_(&trgcde, "RADII", &c__3, &n, radii, (ftnlen)5);
surfnm_(radii, &radii[1], &radii[2], spoint, normal);
/* Find the illumination angles. VSEP will give us angular */
/* separation in radians. */
*phase = vsep_(offsun, offobs);
*solar = vsep_(normal, offsun);
*emissn = vsep_(normal, offobs);
chkout_("ILLUM", (ftnlen)5);
return 0;
} /* illum_ */
/* $Procedure ET2STR ( Convert ET to String for FRMDIFF Output ) */
/* Subroutine */ int et2str_(doublereal *et, char *timfmt, integer *sclkid,
char *string, ftnlen timfmt_len, ftnlen string_len)
{
extern /* Subroutine */ int sce2c_(integer *, doublereal *, doublereal *),
sce2s_(integer *, doublereal *, char *, ftnlen), chkin_(char *,
ftnlen);
doublereal sclkd, ticks;
extern /* Subroutine */ int dpstr_(doublereal *, integer *, char *,
ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int sc01s2d_(integer *, char *, doublereal *,
ftnlen);
extern logical return_(void);
extern /* Subroutine */ int timout_(doublereal *, char *, char *, ftnlen,
ftnlen), chkout_(char *, ftnlen);
/* $ Abstract */
/* Converts ET to a string for FRMDIFF output. */
/* $ 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 */
/* None. */
/* $ Declarations */
/* $ Abstract */
/* Include Section: FRMDIFF Global Parameters */
/* $ 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 */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - Version 1.0.0, 09-DEC-2008 (BVS). */
/* -& */
/* Program name and version. */
/* Command line keys. */
/* Command line key values. */
/* Max and min number orientations that the program can handle. */
/* Default number orientations. */
/* Maximum number of IDs in a CK or a binary PCK file */
/* Line size parameters. */
/* Version, help, usage and header display parameters. */
/* DAF descriptor size and component counts. */
/* Cell lower boundary. */
/* Maximum allowed number of coverage windows. */
/* Smallest allowed step. */
/* Fraction of step to be used as pad at the end of intervals. */
/* End of FRMDIFF parameters. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I ET time */
/* TIMFMT I Output format (per FRMDIFF spec) */
/* SCLKIF I SCLK ID */
/* STRING O Output time string */
/* $ Detailed_Input */
/* TBD. */
/* $ Detailed_Output */
/* TBD. */
/* $ Parameters */
/* None */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* TBD. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - Version 1.0.0, 30-AUG-2008 (BVS) */
/* Initial version. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ET2STR", (ftnlen)6);
}
/* Convert ET to string depending on specified type. */
if (eqstr_(timfmt, "et", timfmt_len, (ftnlen)2)) {
/* Output string should contain ET seconds. Use DPSTR. */
dpstr_(et, &c__14, string, string_len);
if (*(unsigned char *)string == ' ') {
*(unsigned char *)string = '+';
}
} else if (eqstr_(timfmt, "ticks", timfmt_len, (ftnlen)5)) {
/* Output string should contain SCLK ticks. Use SCE2C and */
/* DPSTR. */
sce2c_(sclkid, et, &ticks);
dpstr_(&ticks, &c__14, string, string_len);
} else if (eqstr_(timfmt, "sclk", timfmt_len, (ftnlen)4)) {
/* Output string should contain SCLK string. Use SCE2S. */
sce2s_(sclkid, et, string, string_len);
} else if (eqstr_(timfmt, "sclkd", timfmt_len, (ftnlen)5)) {
/* Output string should contain decimal SCLK. Convert ET to SCLK */
/* string, then string to decimal form, and package decimal form */
/* back into a string :). */
sce2s_(sclkid, et, string, string_len);
sc01s2d_(sclkid, string, &sclkd, string_len);
dpstr_(&sclkd, &c__14, string, string_len);
} else {
/* Output string should be set by TIMOUT using provided TIMFMT. */
timout_(et, timfmt, string, timfmt_len, string_len);
}
/* All done. */
chkout_("ET2STR", (ftnlen)6);
return 0;
} /* et2str_ */
/* $Procedure DASIOD ( DAS, Fortran I/O, double precision ) */
/* Subroutine */ int dasiod_(char *action, integer *unit, integer *recno,
doublereal *record, ftnlen action_len)
{
/* Builtin functions */
integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void),
s_wdue(cilist *), e_wdue(void);
/* Local variables */
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
/* Fortran I/O blocks */
static cilist io___2 = { 1, 0, 1, 0, 0 };
static cilist io___3 = { 1, 0, 0, 0, 0 };
/* $ Abstract */
/* Perform Fortran reads and writes of double precision records. */
/* $ 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 */
/* DAS */
/* $ Keywords */
/* DAS */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ACTION I Action to take (read or write). */
/* UNIT I Fortran unit connected to DAS file. */
/* RECNO I Number of record to read or write. */
/* RECORD I-O DAS double precision record. */
/* $ Detailed_Input */
/* ACTION is a character string specifying whether to read */
/* from or write to the specified DAS file. Possible */
/* values are: */
/* 'READ' */
/* 'WRITE' */
/* Case and leading or trailing blanks are not */
/* significant. */
/* UNIT is the Fortran unit number connected to the DAS */
/* file that is to be read or written. Given the */
/* handle of the DAS file, the unit number can be */
/* obtained using DASHLU. */
/* RECNO is the Fortran record number of the record to be */
/* read or written. */
/* RECORD is a double precision array whose contents are to */
/* be written to record RECNO, if ACTION is WRITE. */
/* $ Detailed_Output */
/* RECORD is a double precision array whose contents are to */
/* be set equal to those of record RECNO, if ACTION */
/* is READ. */
/* $ Parameters */
/* NWD is the number of elements in a DAS double precision */
/* record. */
/* $ Exceptions */
/* 1) If the value of ACTION is not recognized, the error */
/* SPICE(UNRECOGNIZEDACTION) is signalled. */
/* 2) If a Fortran read error occurs, the error */
/* SPICE(DASFILEREADFAILED) is signalled. */
/* 3) If a Fortran write error occurs, the error */
/* SPICE(DASFILEWRITEFAILED) is signalled. */
/* $ Files */
/* See the description of the argument UNIT in $Detailed_Input. */
/* $ Particulars */
/* Normally, routines outside of SPICELIB will not need to call this */
/* routine directly. Writes to DAS files should be performed using */
/* the DASADx and DASUDx routines; reads should be performed using */
/* the DASRDx routines. */
/* This routines centralizes I/O and the concommitant error handling */
/* for DAS character records. */
/* Although most DAS routines use file handles to indentify DAS */
/* files, this routine uses Fortran logical units for this purpose. */
/* Using unit numbers allows the DASIOx routines to be called from */
/* any DAS routine, including entry points of DASFM. (DASFM */
/* contains as entry points the routines DASHLU and DASLUH, which */
/* map between handles and unit numbers.) */
/* $ Examples */
/* 1) Read and print to the screen double precision records */
/* number 10 through 20 from the DAS file designated by HANDLE. */
/* DOUBLE PRECISION RECORD ( NWD ) */
/* . */
/* . */
/* . */
/* CALL DASHLU ( HANDLE, UNIT ) */
/* CALL DASHFN ( HANDLE, NAME ) */
/* DO I = 1, 20 */
/* CALL DASIOD ( 'READ', UNIT, 10, RECORD ) */
/* LABEL = 'Contents of the # record in DAS file #: ' */
/* CALL REPMOT ( LABEL, '#', I, 'L', LABEL ) */
/* CALL REPMC ( LABEL, '#', NAME, LABEL ) */
/* WRITE (*,*) LABEL */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) RECORD */
/* END DO */
/* 2) Write the contents of the array RECORD to record number */
/* 10 in the DAS file designated by HANDLE. */
/* DOUBLE PRECISION RECORD ( NWD ) */
/* . */
/* . */
/* . */
/* CALL DASHLU ( HANDLE, UNIT ) */
/* CALL DASIOD ( 'WRITE', UNIT, 10, RECORD ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* perform Fortran reads of double precision records */
/* perform Fortran writes of double precision records */
/* perform low-level I/O for DAS routines */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
if (return_()) {
return 0;
}
if (eqstr_(action, "READ", action_len, (ftnlen)4)) {
/* We're supposed to read the file. */
io___2.ciunit = *unit;
io___2.cirec = *recno;
iostat = s_rdue(&io___2);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof(
doublereal));
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
if (iostat != 0) {
chkin_("DASIOD", (ftnlen)6);
setmsg_("Could not read DAS double precision record. File = # Re"
"cord number = #. IOSTAT = #.", (ftnlen)83);
errfnm_("#", unit, (ftnlen)1);
errint_("#", recno, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASFILEREADFAILED)", (ftnlen)24);
chkout_("DASIOD", (ftnlen)6);
return 0;
}
} else if (eqstr_(action, "WRITE", action_len, (ftnlen)5)) {
/* We're supposed to write to the file. */
io___3.ciunit = *unit;
io___3.cirec = *recno;
iostat = s_wdue(&io___3);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof(
doublereal));
if (iostat != 0) {
goto L100002;
}
iostat = e_wdue();
L100002:
if (iostat != 0) {
chkin_("DASIOD", (ftnlen)6);
setmsg_("Could not write DAS double precision record. File = # R"
"ecord number = #. IOSTAT = #.", (ftnlen)84);
errfnm_("#", unit, (ftnlen)1);
errint_("#", recno, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25);
chkout_("DASIOD", (ftnlen)6);
return 0;
}
} else {
/* The requested action is a little too weird. */
chkin_("DASIOD", (ftnlen)6);
setmsg_("Action was #; should be READ or WRITE", (ftnlen)37);
errch_("#", action, (ftnlen)1, action_len);
sigerr_("SPICE(UNRECOGNIZEDACTION)", (ftnlen)25);
chkout_("DASIOD", (ftnlen)6);
return 0;
}
return 0;
} /* dasiod_ */
/* $Procedure ZZSPKZP0 ( S/P Kernel, easy position ) */
/* Subroutine */ int zzspkzp0_(integer *targ, doublereal *et, char *ref, char
*abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen
ref_len, ftnlen abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1;
/* Local variables */
static integer fj2000;
extern /* Subroutine */ int zzrefch0_(integer *, integer *, doublereal *,
doublereal *), zzspkpa0_(integer *, doublereal *, char *,
doublereal *, char *, doublereal *, doublereal *, ftnlen, ftnlen);
static doublereal temp[3], sobs[6];
extern /* Subroutine */ int zzspkgp0_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), zzspksb0_(integer
*, doublereal *, char *, doublereal *, ftnlen);
static integer type__;
static logical xmit;
static integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern logical eqchr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
static logical found;
extern integer ltrim_(char *, ftnlen);
static doublereal xform[9] /* was [3][3] */;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
static doublereal postn[3];
extern logical failed_(void);
static integer center;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_(
integer *, integer *, integer *, integer *, logical *);
static doublereal ltcent;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
static integer reqfrm, typeid;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen);
extern logical return_(void);
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
/* $ 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. */
/* Return the position of a target body relative to an observing */
/* body, optionally corrected for light time (planetary aberration) */
/* and stellar aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* NAIF_IDS */
/* FRAMES */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ 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 */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body NAIF ID code. */
/* ET I Observer epoch. */
/* REF I Reference frame of output position vector. */
/* ABCORR I Aberration correction flag. */
/* OBS I Observing body NAIF ID code. */
/* PTARG O Position of target. */
/* LT O One way light time between observer and target. */
/* $ Detailed_Input */
/* TARG is the NAIF ID code for a target body. The target */
/* and observer define a position vector which points */
/* from the observer to the target. */
/* ET is the ephemeris time, expressed as seconds past */
/* J2000 TDB, at which the position of the target body */
/* relative to the observer is to be computed. ET */
/* refers to time at the observer's location. */
/* REF is the name of the reference frame relative to which */
/* the output position vector should be expressed. This */
/* may be any frame supported by the SPICE system, */
/* including built-in frames (documented in the Frames */
/* Required Reading) and frames defined by a loaded */
/* frame kernel (FK). */
/* When REF designates a non-inertial frame, the */
/* orientation of the frame is evaluated at an epoch */
/* dependent on the selected aberration correction. See */
/* the description of the output position vector PTARG */
/* for details. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the position of the target body to account for */
/* one-way light time and stellar aberration. See the */
/* discussion in the Particulars section for */
/* recommendations on how to choose aberration */
/* corrections. */
/* ABCORR may be any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric position of the target body */
/* relative to the observer. */
/* The following values of ABCORR apply to the */
/* "reception" case in which photons depart from the */
/* target's location at the light-time corrected epoch */
/* ET-LT and *arrive* at the observer's location at ET: */
/* 'LT' Correct for one-way light time (also */
/* called "planetary aberration") using a */
/* Newtonian formulation. This correction */
/* yields the position of the target at */
/* the moment it emitted photons arriving */
/* at the observer at ET. */
/* The light time correction uses an */
/* iterative solution of the light time */
/* equation (see Particulars for details). */
/* The solution invoked by the 'LT' option */
/* uses one iteration. */
/* 'LT+S' Correct for one-way light time and */
/* stellar aberration using a Newtonian */
/* formulation. This option modifies the */
/* position obtained with the 'LT' option */
/* to account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The result is the apparent */
/* position of the target---the position */
/* as seen by the observer. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light time */
/* equation, the 'CN' correction iterates */
/* until the solution converges (three */
/* iterations on all supported platforms). */
/* The 'CN' correction typically does not */
/* substantially improve accuracy because */
/* the errors made by ignoring */
/* relativistic effects may be larger than */
/* the improvement afforded by obtaining */
/* convergence of the light time solution. */
/* The 'CN' correction computation also */
/* requires a significantly greater number */
/* of CPU cycles than does the */
/* one-iteration light time correction. */
/* 'CN+S' Converged Newtonian light time */
/* and stellar aberration corrections. */
/* The following values of ABCORR apply to the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at ET and arrive at the */
/* target's location at the light-time corrected epoch */
/* ET+LT: */
/* 'XLT' "Transmission" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. This correction yields the */
/* position of the target at the moment it */
/* receives photons emitted from the */
/* observer's location at ET. */
/* 'XLT+S' "Transmission" case: correct for */
/* one-way light time and stellar */
/* aberration using a Newtonian */
/* formulation This option modifies the */
/* position obtained with the 'XLT' option */
/* to account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The position component of */
/* the computed target position indicates */
/* the direction that photons emitted from */
/* the observer's location must be "aimed" */
/* to hit the target. */
/* 'XCN' "Transmission" case: converged */
/* Newtonian light time correction. */
/* 'XCN+S' "Transmission" case: converged */
/* Newtonian light time and stellar */
/* aberration corrections. */
/* Neither special nor general relativistic effects are */
/* accounted for in the aberration corrections applied */
/* by this routine. */
/* Case and blanks are not significant in the string */
/* ABCORR. */
/* OBS is the NAIF ID code for the observing body. */
/* $ Detailed_Output */
/* PTARG is a Cartesian 3-vector representing the position of */
/* the target body relative to the specified observer. */
/* PTARG is corrected for the specified aberrations, and */
/* is expressed with respect to the reference frame */
/* specified by REF. The three components of PTARG */
/* represent the x-, y- and z-components of the target's */
/* position. */
/* PTARG points from the observer's location at ET to */
/* the aberration-corrected location of the target. */
/* Note that the sense of this position vector is */
/* independent of the direction of radiation travel */
/* implied by the aberration correction. */
/* Units are always km. */
/* Non-inertial frames are treated as follows: letting */
/* LTCENT be the one-way light time between the observer */
/* and the central body associated with the frame, the */
/* orientation of the frame is evaluated at ET-LTCENT, */
/* ET+LTCENT, or ET depending on whether the requested */
/* aberration correction is, respectively, for received */
/* radiation, transmitted radiation, or is omitted. */
/* LTCENT is computed using the method indicated by */
/* ABCORR. */
/* LT is the one-way light time between the observer and */
/* target in seconds. If the target position is */
/* corrected for aberrations, then LT is the one-way */
/* light time between the observer and the light time */
/* corrected target location. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If name of target or observer cannot be translated to its */
/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */
/* 2) If the reference frame REF is not a recognized reference */
/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */
/* 3) If the loaded kernels provide insufficient data to */
/* compute the requested position vector, the deficiency will */
/* be diagnosed by a routine in the call tree of this routine. */
/* 4) If an error occurs while reading an SPK or other kernel file, */
/* the error will be diagnosed by a routine in the call tree */
/* of this routine. */
/* $ Files */
/* This routine computes positions using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. See the routine FURNSH and the SPK */
/* and KERNEL Required Reading for further information on loading */
/* (and unloading) kernels. */
/* If the output position PTARG is to be expressed relative to a */
/* non-inertial frame, or if any of the ephemeris data used to */
/* compute PTARG are expressed relative to a non-inertial frame in */
/* the SPK files providing those data, additional kernels may be */
/* needed to enable the reference frame transformations required to */
/* compute the position. Normally these additional kernels are PCK */
/* files or frame kernels. Any such kernels must already be loaded */
/* at the time this routine is called. */
/* $ Particulars */
/* This routine is part of the user interface to the SPICE ephemeris */
/* system. It allows you to retrieve position information for any */
/* ephemeris object relative to any other in a reference frame that */
/* is convenient for further computations. */
/* Aberration corrections */
/* ====================== */
/* In space science or engineering applications one frequently */
/* wishes to know where to point a remote sensing instrument, such */
/* as an optical camera or radio antenna, in order to observe or */
/* otherwise receive radiation from a target. This pointing problem */
/* is complicated by the finite speed of light: one needs to point */
/* to where the target appears to be as opposed to where it actually */
/* is at the epoch of observation. We use the adjectives */
/* "geometric," "uncorrected," or "true" to refer to an actual */
/* position or state of a target at a specified epoch. When a */
/* geometric position or state vector is modified to reflect how it */
/* appears to an observer, we describe that vector by any of the */
/* terms "apparent," "corrected," "aberration corrected," or "light */
/* time and stellar aberration corrected." The SPICE Toolkit can */
/* correct for two phenomena affecting the apparent location of an */
/* object: one-way light time (also called "planetary aberration") */
/* and stellar aberration. */
/* One-way light time */
/* ------------------ */
/* Correcting for one-way light time is done by computing, given an */
/* observer and observation epoch, where a target was when the */
/* observed photons departed the target's location. The vector from */
/* the observer to this computed target location is called a "light */
/* time corrected" vector. The light time correction depends on the */
/* motion of the target relative to the solar system barycenter, but */
/* it is independent of the velocity of the observer relative to the */
/* solar system barycenter. Relativistic effects such as light */
/* bending and gravitational delay are not accounted for in the */
/* light time correction performed by this routine. */
/* Stellar aberration */
/* ------------------ */
/* The velocity of the observer also affects the apparent location */
/* of a target: photons arriving at the observer are subject to a */
/* "raindrop effect" whereby their velocity relative to the observer */
/* is, using a Newtonian approximation, the photons' velocity */
/* relative to the solar system barycenter minus the velocity of the */
/* observer relative to the solar system barycenter. This effect is */
/* called "stellar aberration." Stellar aberration is independent */
/* of the velocity of the target. The stellar aberration formula */
/* used by this routine does not include (the much smaller) */
/* relativistic effects. */
/* Stellar aberration corrections are applied after light time */
/* corrections: the light time corrected target position vector is */
/* used as an input to the stellar aberration correction. */
/* When light time and stellar aberration corrections are both */
/* applied to a geometric position vector, the resulting position */
/* vector indicates where the target "appears to be" from the */
/* observer's location. */
/* As opposed to computing the apparent position of a target, one */
/* may wish to compute the pointing direction required for */
/* transmission of photons to the target. This also requires */
/* correction of the geometric target position for the effects of */
/* light time and stellar aberration, but in this case the */
/* corrections are computed for radiation traveling *from* the */
/* observer to the target. */
/* The "transmission" light time correction yields the target's */
/* location as it will be when photons emitted from the observer's */
/* location at ET arrive at the target. The transmission stellar */
/* aberration correction is the inverse of the traditional stellar */
/* aberration correction: it indicates the direction in which */
/* radiation should be emitted so that, using a Newtonian */
/* approximation, the sum of the velocity of the radiation relative */
/* to the observer and of the observer's velocity, relative to the */
/* solar system barycenter, yields a velocity vector that points in */
/* the direction of the light time corrected position of the target. */
/* One may object to using the term "observer" in the transmission */
/* case, in which radiation is emitted from the observer's location. */
/* The terminology was retained for consistency with earlier */
/* documentation. */
/* Below, we indicate the aberration corrections to use for some */
/* common applications: */
/* 1) Find the apparent direction of a target for a remote-sensing */
/* observation. */
/* Use 'LT+S': apply both light time and stellar */
/* aberration corrections. */
/* Note that using light time corrections alone ('LT') is */
/* generally not a good way to obtain an approximation to an */
/* apparent target vector: since light time and stellar */
/* aberration corrections often partially cancel each other, */
/* it may be more accurate to use no correction at all than to */
/* use light time alone. */
/* 2) Find the corrected pointing direction to radiate a signal */
/* to a target. This computation is often applicable for */
/* implementing communications sessions. */
/* Use 'XLT+S': apply both light time and stellar */
/* aberration corrections for transmission. */
/* 3) Compute the apparent position of a target body relative */
/* to a star or other distant object. */
/* Use 'LT' or 'LT+S' as needed to match the correction */
/* applied to the position of the distant object. For */
/* example, if a star position is obtained from a catalog, */
/* the position vector may not be corrected for stellar */
/* aberration. In this case, to find the angular */
/* separation of the star and the limb of a planet, the */
/* vector from the observer to the planet should be */
/* corrected for light time but not stellar aberration. */
/* 4) Obtain an uncorrected position vector derived directly from */
/* data in an SPK file. */
/* Use 'NONE'. */
/* 5) Use a geometric position vector as a low-accuracy estimate */
/* of the apparent position for an application where execution */
/* speed is critical. */
/* Use 'NONE'. */
/* 6) While this routine cannot perform the relativistic */
/* aberration corrections required to compute positions */
/* with the highest possible accuracy, it can supply the */
/* geometric positions required as inputs to these */
/* computations. */
/* Use 'NONE', then apply high-accuracy aberration */
/* corrections (not available in the SPICE Toolkit). */
/* Below, we discuss in more detail how the aberration corrections */
/* applied by this routine are computed. */
/* Geometric case */
/* ============== */
/* ZZSPKZP0 begins by computing the geometric position T(ET) of */
/* the target body relative to the solar system barycenter (SSB). */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the geometric position of the target body relative to the */
/* observer. The one-way light time, LT, is given by */
/* | T(ET) - O(ET) | */
/* LT = ------------------- */
/* c */
/* The geometric relationship between the observer, target, and */
/* solar system barycenter is as shown: */
/* SSB ---> O(ET) */
/* | / */
/* | / */
/* | / */
/* | / T(ET) - O(ET) */
/* V V */
/* T(ET) */
/* The returned position vector is */
/* T(ET) - O(ET) */
/* Reception case */
/* ============== */
/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */
/* for ABCORR, ZZSPKZP0 computes the position of the target body */
/* at epoch ET-LT, where LT is the one-way light time. Let T(t) */
/* and O(t) represent the positions of the target and observer */
/* relative to the solar system barycenter at time t; then LT is */
/* the solution of the light-time equation */
/* | T(ET-LT) - O(ET) | */
/* LT = ------------------------ (1) */
/* c */
/* The ratio */
/* | T(ET) - O(ET) | */
/* --------------------- (2) */
/* c */
/* is used as a first approximation to LT; inserting (2) into the */
/* right hand side of the light-time equation (1) yields the */
/* "one-iteration" estimate of the one-way light time ("LT"). */
/* Repeating the process until the estimates of LT converge */
/* yields the "converged Newtonian" light time estimate ("CN"). */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the position of the target body relative to the observer: */
/* T(ET-LT) - O(ET). */
/* SSB ---> O(ET) */
/* | \ | */
/* | \ | */
/* | \ | T(ET-LT) - O(ET) */
/* | \ | */
/* V V V */
/* T(ET) T(ET-LT) */
/* The light time corrected position vector is */
/* T(ET-LT) - O(ET) */
/* If correction for stellar aberration is requested, the target */
/* position is rotated toward the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as follows: */
/* Let r be the light time corrected vector from the observer */
/* to the object, and v be the velocity of the observer with */
/* respect to the solar system barycenter. Let w be the angle */
/* between them. The aberration angle phi is given by */
/* sin(phi) = v sin(w) / c */
/* Let h be the vector given by the cross product */
/* h = r X v */
/* Rotate r by phi radians about h to obtain the apparent */
/* position of the object. */
/* Transmission case */
/* ================== */
/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */
/* selected, ZZSPKZP0 computes the position of the target body T */
/* at epoch ET+LT, where LT is the one-way light time. LT is the */
/* solution of the light-time equation */
/* | T(ET+LT) - O(ET) | */
/* LT = ------------------------ (3) */
/* c */
/* Subtracting the geometric position of the observer, O(ET), */
/* gives the position of the target body relative to the */
/* observer: T(ET-LT) - O(ET). */
/* SSB --> O(ET) */
/* / | * */
/* / | * T(ET+LT) - O(ET) */
/* / |* */
/* / *| */
/* V V V */
/* T(ET+LT) T(ET) */
/* The light-time corrected position vector is */
/* T(ET+LT) - O(ET) */
/* If correction for stellar aberration is requested, the target */
/* position is rotated away from the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as in the reception case, but the sign of the */
/* rotation angle is negated. */
/* Precision of light time corrections */
/* =================================== */
/* Corrections using one iteration of the light time solution */
/* ---------------------------------------------------------- */
/* When the requested aberration correction is 'LT', 'LT+S', */
/* 'XLT', or 'XLT+S', only one iteration is performed in the */
/* algorithm used to compute LT. */
/* The relative error in this computation */
/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */
/* is at most */
/* (V/C)**2 */
/* ---------- */
/* 1 - (V/C) */
/* which is well approximated by (V/C)**2, where V is the */
/* velocity of the target relative to an inertial frame and C is */
/* the speed of light. */
/* For nearly all objects in the solar system V is less than 60 */
/* km/sec. The value of C is 300000 km/sec. Thus the one */
/* iteration solution for LT has a potential relative error of */
/* not more than 4*10**-8. This is a potential light time error */
/* of approximately 2*10**-5 seconds per astronomical unit of */
/* distance separating the observer and target. Given the bound */
/* on V cited above: */
/* As long as the observer and target are */
/* separated by less than 50 astronomical units, */
/* the error in the light time returned using */
/* the one-iteration light time corrections */
/* is less than 1 millisecond. */
/* Converged corrections */
/* --------------------- */
/* When the requested aberration correction is 'CN', 'CN+S', */
/* 'XCN', or 'XCN+S', three iterations are performed in the */
/* computation of LT. The relative error present in this */
/* solution is at most */
/* (V/C)**4 */
/* ---------- */
/* 1 - (V/C) */
/* which is well approximated by (V/C)**4. Mathematically the */
/* precision of this computation is better than a nanosecond for */
/* any pair of objects in the solar system. */
/* However, to model the actual light time between target and */
/* observer one must take into account effects due to general */
/* relativity. These may be as high as a few hundredths of a */
/* millisecond for some objects. */
/* When one considers the extra time required to compute the */
/* converged Newtonian light time (the state of the target */
/* relative to the solar system barycenter is looked up three */
/* times instead of once) together with the real gain in */
/* accuracy, it seems unlikely that you will want to request */
/* either the "CN" or "CN+S" light time corrections. However, */
/* these corrections can be useful for testing situations where */
/* high precision (as opposed to accuracy) is required. */
/* Relativistic Corrections */
/* ========================= */
/* This routine does not attempt to perform either general or */
/* special relativistic corrections in computing the various */
/* aberration corrections. For many applications relativistic */
/* corrections are not worth the expense of added computation */
/* cycles. If however, your application requires these additional */
/* corrections we suggest you consult the astronomical almanac (page */
/* B36) for a discussion of how to carry out these corrections. */
/* $ Examples */
/* 1) Load a planetary ephemeris SPK, then look up a series of */
/* geometric positions of the moon relative to the earth, */
/* referenced to the J2000 frame. */
/* IMPLICIT NONE */
/* C */
/* C Local constants */
/* C */
/* CHARACTER*(*) FRAME */
/* PARAMETER ( FRAME = 'J2000' ) */
/* CHARACTER*(*) ABCORR */
/* PARAMETER ( ABCORR = 'NONE' ) */
/* C */
/* C The name of the SPK file shown here is fictitious; */
/* C you must supply the name of an SPK file available */
/* C on your own computer system. */
/* C */
/* CHARACTER*(*) SPK */
/* PARAMETER ( SPK = 'planet.bsp' ) */
/* C */
/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */
/* C */
/* DOUBLE PRECISION ET0 */
/* PARAMETER ( ET0 = 0.0D0 ) */
/* C */
/* C Use a time step of 1 hour; look up 100 positions. */
/* C */
/* DOUBLE PRECISION STEP */
/* PARAMETER ( STEP = 3600.0D0 ) */
/* INTEGER MAXITR */
/* PARAMETER ( MAXITR = 100 ) */
/* C */
/* C The NAIF IDs of the earth and moon are 399 and 301 */
/* C respectively. */
/* C */
/* INTEGER OBSRVR */
/* PARAMETER ( OBSRVR = 399 ) */
/* INTEGER TARGET */
/* PARAMETER ( TARGET = 301 ) */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION POS ( 3 ) */
/* INTEGER I */
/* C */
/* C Load the SPK file. */
/* C */
/* CALL FURNSH ( SPK ) */
/* C */
/* C Step through a series of epochs, looking up a */
/* C position vector at each one. */
/* C */
/* DO I = 1, MAXITR */
/* ET = ET0 + (I-1)*STEP */
/* CALL ZZSPKZP0 ( TARGET, ET, FRAME, ABCORR, OBSRVR, */
/* . POS, LT ) */
/* WRITE (*,*) 'ET = ', ET */
/* WRITE (*,*) 'J2000 x-position (km): ', POS(1) */
/* WRITE (*,*) 'J2000 y-position (km): ', POS(2) */
/* WRITE (*,*) 'J2000 z-position (km): ', POS(3) */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) SPICE Private routine. */
/* $ Literature_References */
/* SPK Required Reading. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* B.V. Semenov (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */
/* Based on SPICELIB Version 3.1.0, 05-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* using body names get position relative to an observer */
/* get position relative observer corrected for aberrations */
/* read ephemeris data */
/* read trajectory data */
/* -& */
/* $ Revisions */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZSPKZP0", (ftnlen)8);
}
/* Get the frame id for J2000 on the first call to this routine. */
if (first) {
first = FALSE_;
namfrm_("J2000", &fj2000, (ftnlen)5);
}
/* Decide whether the aberration correction is for received or */
/* transmitted radiation. */
i__ = ltrim_(abcorr, abcorr_len);
xmit = eqchr_(abcorr + (i__ - 1), "X", (ftnlen)1, (ftnlen)1);
/* If we only want geometric positions, then compute just that. */
/* Otherwise, compute the state of the observer relative to */
/* the SSB. Then feed that position into ZZSPKPA0 to compute the */
/* apparent position of the target body relative to the observer */
/* with the requested aberration corrections. */
if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) {
zzspkgp0_(targ, et, ref, obs, ptarg, lt, ref_len);
} else {
/* Get the auxiliary information about the requested output */
/* frame. */
namfrm_(ref, &reqfrm, ref_len);
if (reqfrm == 0) {
setmsg_("The requested output frame '#' is not recognized by the"
" reference frame subsystem. Please check that the appro"
"priate kernels have been loaded and that you have correc"
"tly entered the name of the output frame. ", (ftnlen)209);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
frinfo_(&reqfrm, ¢er, &type__, &typeid, &found);
/* If we are dealing with an inertial frame, we can simply */
/* call ZZSPKSB0, ZZSPKPA0 and return. */
if (type__ == 1) {
zzspksb0_(obs, et, ref, sobs, ref_len);
zzspkpa0_(targ, et, ref, sobs, abcorr, ptarg, lt, ref_len,
abcorr_len);
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
/* Still here? */
/* We are dealing with a non-inertial frame. But we need to */
/* do light time and stellar aberration in an inertial frame. */
/* Get the "apparent" position of TARG in the intermediary */
/* inertial reference frame J2000. */
/* We also need the light time to the center of the frame. */
zzspksb0_(obs, et, "J2000", sobs, (ftnlen)5);
zzspkpa0_(targ, et, "J2000", sobs, abcorr, postn, lt, (ftnlen)5,
abcorr_len);
if (failed_()) {
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
if (center == *obs) {
ltcent = 0.;
} else if (center == *targ) {
ltcent = *lt;
} else {
zzspkpa0_(¢er, et, "J2000", sobs, abcorr, temp, <cent, (
ftnlen)5, abcorr_len);
}
/* If something went wrong (like we couldn't get the position of */
/* the center relative to the observer) now it is time to quit. */
if (failed_()) {
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
/* If the aberration corrections are for transmission, negate */
/* the light time, since we wish to compute the orientation */
/* of the non-inertial frame at an epoch later than ET by */
/* the one-way light time. */
if (xmit) {
ltcent = -ltcent;
}
/* Get the rotation from J2000 to the requested frame */
/* and convert the position. */
d__1 = *et - ltcent;
zzrefch0_(&fj2000, &reqfrm, &d__1, xform);
if (failed_()) {
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
mxv_(xform, postn, ptarg);
}
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
} /* zzspkzp0_ */
/* $Procedure ZZGFSSOB ( GF, state of sub-observer point ) */
/* Subroutine */ int zzgfssob_(char *method, integer *trgid, doublereal *et,
char *fixref, char *abcorr, integer *obsid, doublereal *radii,
doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen
abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer prvobs = 0;
static integer prvtrg = 0;
static char svobs[36] = " ";
static char svtarg[36] = " ";
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
doublereal dalt[2];
logical near__, geom;
extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_(
doublereal *, doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
logical xmit;
extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *,
integer *, doublereal *);
doublereal upos[3];
extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal
*, doublereal *, doublereal *, doublereal *), zzcorsxf_(logical *,
doublereal *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen);
doublereal t;
extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
doublereal savel[3];
logical found;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vsubg_(doublereal *, doublereal *, integer *, doublereal *);
doublereal stemp[6];
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal xform[36] /* was [6][6] */;
logical uselt;
extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen);
doublereal ssbtg0[6];
extern logical failed_(void);
doublereal sa[3];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal lt;
integer frcode;
extern doublereal clight_(void);
extern logical return_(void);
doublereal corxfi[36] /* was [6][6] */, corxfm[36] /* was [6][6]
*/, fxosta[6], fxpsta[6], fxpvel[3], fxtsta[6], obspnt[6], obssta[
12] /* was [6][2] */, obstrg[6], acc[3], pntsta[6], raysta[6],
sastat[6], spoint[3], srfvec[3], ssbobs[6], ssbtrg[6], trgepc;
integer center, clssid, frclss;
logical attblk[6], usestl;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
logical fnd;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *,
integer *, integer *, integer *, logical *), errint_(char *,
integer *, ftnlen), spkgeo_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), vminug_(
doublereal *, integer *, doublereal *), dnearp_(doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, logical *), surfpv_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, logical *)
, subpnt_(char *, char *, doublereal *, char *, char *, char *,
doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen,
ftnlen, ftnlen), spkssb_(integer *, doublereal *, char *,
doublereal *, ftnlen);
doublereal dlt;
extern /* Subroutine */ int sxform_(char *, char *, doublereal *,
doublereal *, ftnlen, ftnlen), qderiv_(integer *, doublereal *,
doublereal *, doublereal *, doublereal *), invstm_(doublereal *,
doublereal *);
/* $ 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. */
/* Return the state of a sub-observer point used to define */
/* coordinates referenced in a GF search. */
/* $ 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 */
/* GF */
/* SPK */
/* TIME */
/* NAIF_IDS */
/* FRAMES */
/* $ Keywords */
/* GEOMETRY */
/* PRIVATE */
/* SEARCH */
/* $ Declarations */
/* $ Abstract */
/* This file contains public, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) 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. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.E. Elson (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.3.0, 01-OCT-2011 (NJB) */
/* Added NWILUM parameter. */
/* - SPICELIB Version 1.2.0, 14-SEP-2010 (EDW) */
/* Added NWPA parameter. */
/* - SPICELIB Version 1.1.0, 08-SEP-2009 (EDW) */
/* Added NWRR parameter. */
/* Added NWUDS parameter. */
/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */
/* -& */
/* Root finding parameters: */
/* CNVTOL is the default convergence tolerance used by the */
/* high-level GF search API routines. This tolerance is */
/* used to terminate searches for binary state transitions: */
/* when the time at which a transition occurs is bracketed */
/* by two times that differ by no more than CNVTOL, the */
/* transition time is considered to have been found. */
/* Units are TDB seconds. */
/* NWMAX is the maximum number of windows allowed for user-defined */
/* workspace array. */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */
/* Currently no more than twelve windows are required; the three */
/* extra windows are spares. */
/* Callers of GFEVNT can include this file and use the parameter */
/* NWMAX to declare the second dimension of the workspace array */
/* if necessary. */
/* Callers of GFIDST should declare their workspace window */
/* count using NWDIST. */
/* Callers of GFSEP should declare their workspace window */
/* count using NWSEP. */
/* Callers of GFRR should declare their workspace window */
/* count using NWRR. */
/* Callers of GFUDS should declare their workspace window */
/* count using NWUDS. */
/* Callers of GFPA should declare their workspace window */
/* count using NWPA. */
/* Callers of GFILUM should declare their workspace window */
/* count using NWILUM. */
/* ADDWIN is a parameter used to expand each interval of the search */
/* (confinement) window by a small amount at both ends in order to */
/* accommodate searches using equality constraints. The loaded */
/* kernel files must accommodate these expanded time intervals. */
/* FRMNLN is a string length for frame names. */
/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */
/* FOVTLN -- maximum length for FOV string. */
/* Specify the character strings that are allowed in the */
/* specification of field of view shapes. */
/* Character strings that are allowed in the */
/* specification of occultation types: */
/* Occultation target shape specifications: */
/* Specify the number of supported occultation types and occultation */
/* type string length: */
/* Instrument field-of-view (FOV) parameters */
/* Maximum number of FOV boundary vectors: */
/* FOV shape parameters: */
/* circle */
/* ellipse */
/* polygon */
/* rectangle */
/* End of file gf.inc. */
/* $ Abstract */
/* SPICE private include file intended solely for the support of */
/* SPICE routines. Users should not include this routine in their */
/* source code due to the volatile nature of this file. */
/* This file contains private, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) 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. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */
/* -& */
/* The set of supported coordinate systems */
/* System Coordinates */
/* ---------- ----------- */
/* Rectangular X, Y, Z */
/* Latitudinal Radius, Longitude, Latitude */
/* Spherical Radius, Colatitude, Longitude */
/* RA/Dec Range, Right Ascension, Declination */
/* Cylindrical Radius, Longitude, Z */
/* Geodetic Longitude, Latitude, Altitude */
/* Planetographic Longitude, Latitude, Altitude */
/* Below we declare parameters for naming coordinate systems. */
/* User inputs naming coordinate systems must match these */
/* when compared using EQSTR. That is, user inputs must */
/* match after being left justified, converted to upper case, */
/* and having all embedded blanks removed. */
/* Below we declare names for coordinates. Again, user */
/* inputs naming coordinates must match these when */
/* compared using EQSTR. */
/* Note that the RA parameter value below matches */
/* 'RIGHT ASCENSION' */
/* when extra blanks are compressed out of the above value. */
/* Parameters specifying types of vector definitions */
/* used for GF coordinate searches: */
/* All string parameter values are left justified, upper */
/* case, with extra blanks compressed out. */
/* POSDEF indicates the vector is defined by the */
/* position of a target relative to an observer. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the sub-observer point on */
/* that body, for a given observer and target. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the surface intercept point on */
/* that body, for a given observer, ray, and target. */
/* Number of workspace windows used by ZZGFREL: */
/* Number of additional workspace windows used by ZZGFLONG: */
/* Index of "existence window" used by ZZGFCSLV: */
/* Progress report parameters: */
/* MXBEGM, */
/* MXENDM are, respectively, the maximum lengths of the progress */
/* report message prefix and suffix. */
/* Note: the sum of these lengths, plus the length of the */
/* "percent complete" substring, should not be long enough */
/* to cause wrap-around on any platform's terminal window. */
/* Total progress report message length upper bound: */
/* End of file zzgf.inc. */
/* $ Abstract */
/* Include file zzabcorr.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 the structure of an aberration */
/* correction attribute block. */
/* $ 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 */
/* An aberration correction attribute block is an array of logical */
/* flags indicating the attributes of the aberration correction */
/* specified by an aberration correction string. The attributes */
/* are: */
/* - Is the correction "geometric"? */
/* - Is light time correction indicated? */
/* - Is stellar aberration correction indicated? */
/* - Is the light time correction of the "converged */
/* Newtonian" variety? */
/* - Is the correction for the transmission case? */
/* - Is the correction relativistic? */
/* The parameters defining the structure of the block are as */
/* follows: */
/* NABCOR Number of aberration correction choices. */
/* ABATSZ Number of elements in the aberration correction */
/* block. */
/* GEOIDX Index in block of geometric correction flag. */
/* LTIDX Index of light time flag. */
/* STLIDX Index of stellar aberration flag. */
/* CNVIDX Index of converged Newtonian flag. */
/* XMTIDX Index of transmission flag. */
/* RELIDX Index of relativistic flag. */
/* The following parameter is not required to define the block */
/* structure, but it is convenient to include it here: */
/* CORLEN The maximum string length required by any aberration */
/* correction string */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* Number of aberration correction choices: */
/* Aberration correction attribute block size */
/* (number of aberration correction attributes): */
/* Indices of attributes within an aberration correction */
/* attribute block: */
/* Maximum length of an aberration correction string: */
/* End of include file zzabcorr.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TRGID I Target ID code. */
/* ET I Computation epoch. */
/* FIXREF I Reference frame name. */
/* ABCORR I Aberration correction. */
/* OBSID I Observer ID code. */
/* RADII I Target radii. */
/* STATE O State used to define coordinates. */
/* $ Detailed_Input */
/* METHOD is a short string providing parameters defining */
/* the computation method to be used. Any value */
/* supported by SUBPNT may be used. */
/* TRGID is the NAIF ID code of the target object. */
/* *This routine assumes that the target is modeled */
/* as a tri-axial ellipsoid.* */
/* ET is the time, expressed as ephemeris seconds past J2000 */
/* TDB, at which the specified state is to be computed. */
/* FIXREF is the name of the reference frame relative to which */
/* the state of interest is specified. */
/* FIXREF must be centered on the target body. */
/* Case, leading and trailing blanks are not significant */
/* in the string FIXREF. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the state of the target body to account for one-way */
/* light time and stellar aberration. The orientation */
/* of the target body will also be corrected for one-way */
/* light time when light time corrections are requested. */
/* Supported aberration correction options for */
/* observation (case where radiation is received by */
/* observer at ET) are: */
/* NONE No correction. */
/* LT Light time only. */
/* LT+S Light time and stellar aberration. */
/* CN Converged Newtonian (CN) light time. */
/* CN+S CN light time and stellar aberration. */
/* Supported aberration correction options for */
/* transmission (case where radiation is emitted from */
/* observer at ET) are: */
/* XLT Light time only. */
/* XLT+S Light time and stellar aberration. */
/* XCN Converged Newtonian (CN) light time. */
/* XCN+S CN light time and stellar aberration. */
/* For detailed information, see the geometry finder */
/* required reading, gf.req. Also see the header of */
/* SPKEZR, which contains a detailed discussion of */
/* aberration corrections. */
/* Case, leading and trailing blanks are not significant */
/* in the string ABCORR. */
/* OBSID is the NAIF ID code of the observer. */
/* RADII is an array containing three radii defining */
/* a reference ellipsoid for the target body. */
/* $ Detailed_Output */
/* STATE is the state of the sub-observer point at ET. */
/* The first three components of STATE contain the */
/* sub-observer point itself; the last three */
/* components contain the derivative with respect to */
/* time of the position. The state is expressed */
/* relative to the body-fixed frame designated by */
/* FIXREF. */
/* Units are km and km/s. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the aberration correction ABCORR is not recognized, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 2) If the frame FIXREF is not recognized by the frames */
/* subsystem, the error will be diagnosed by routines in the */
/* call tree of this routine. */
/* 3) FIXREF must be centered on the target body; if it isn't, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 4) Any error that occurs while look up the state of the target */
/* or observer will be diagnosed by routines in the call tree of */
/* this routine. */
/* 5) Any error that occurs while look up the orientation of */
/* the target will be diagnosed by routines in the call tree of */
/* this routine. */
/* 6) If the input method is not recognized, the error */
/* SPICE(NOTSUPPORTED) will be signaled. */
/* $ Files */
/* Appropriate kernels must be loaded by the calling program before */
/* this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for target and observer must be */
/* loaded. If aberration corrections are used, the states of */
/* target and observer relative to the solar system barycenter */
/* must be calculable from the available ephemeris data. */
/* Typically ephemeris data are made available by loading one */
/* or more SPK files via FURNSH. */
/* - PCK data: if the target body shape is modeled as an */
/* ellipsoid, triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: rotation data for the target body must be */
/* loaded. These may be provided in a text or binary PCK file. */
/* - Frame data: if a frame definition is required to convert the */
/* observer and target states to the body-fixed frame of the */
/* target, that definition must be available in the kernel */
/* pool. Typically the definition is supplied by loading a */
/* frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine isolates the computation of the sub-observer state */
/* (that is, the sub-observer point and its derivative with respect */
/* to time). */
/* This routine is used by the GF coordinate utility routines in */
/* order to solve for time windows on which specified mathematical */
/* conditions involving coordinates are satisfied. The role of */
/* this routine is to provide Cartesian state vectors enabling */
/* the GF coordinate utilities to determine the signs of the */
/* derivatives with respect to time of coordinates of interest. */
/* $ Examples */
/* See ZZGFCOST. */
/* $ Restrictions */
/* 1) This routine is restricted to use with ellipsoidal target */
/* shape models. */
/* 2) The computations performed by this routine are intended */
/* to be compatible with those performed by the SPICE */
/* routine SUBPNT. If that routine changes, this routine */
/* may need to be updated. */
/* 3) This routine presumes that error checking of inputs */
/* has, where possible, already been performed by the */
/* GF coordinate utility initialization routine. */
/* 4) The interface and functionality of this set of routines may */
/* change without notice. These routines should be called only */
/* by SPICELIB routines. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */
/* Upgraded to support targets and observers having */
/* no names associated with their ID codes. */
/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* sub-observer state */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFSSOB", (ftnlen)8);
if (first || *trgid != prvtrg) {
bodc2s_(trgid, svtarg, (ftnlen)36);
prvtrg = *trgid;
}
if (first || *obsid != prvobs) {
bodc2s_(obsid, svobs, (ftnlen)36);
prvobs = *obsid;
}
first = FALSE_;
/* Parse the aberration correction specifier. */
zzprscor_(abcorr, attblk, abcorr_len);
geom = attblk[0];
uselt = attblk[1];
usestl = attblk[2];
xmit = attblk[4];
/* Decide whether the sub-observer point is computed using */
/* the "near point" or "surface intercept" method. Only */
/* ellipsoids may be used a shape models for this computation. */
if (eqstr_(method, "Near point: ellipsoid", method_len, (ftnlen)21)) {
near__ = TRUE_;
} else if (eqstr_(method, "Intercept: ellipsoid", method_len, (ftnlen)20))
{
near__ = FALSE_;
} else {
setmsg_("Sub-observer point computation method # is not supported by"
" this routine.", (ftnlen)73);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (geom) {
/* This is the geometric case. */
/* We need to check the body-fixed reference frame here. */
namfrm_(fixref, &frcode, fixref_len);
frinfo_(&frcode, ¢er, &frclss, &clssid, &fnd);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (! fnd) {
setmsg_("Input reference frame # was not recognized.", (ftnlen)43)
;
errch_("#", fixref, (ftnlen)1, fixref_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (center != *trgid) {
setmsg_("Input reference frame # is centered on body # instead o"
"f body #.", (ftnlen)64);
errch_("#", fixref, (ftnlen)1, fixref_len);
errint_("#", ¢er, (ftnlen)1);
errint_("#", trgid, (ftnlen)1);
sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Get the state of the target with respect to the observer, */
/* expressed relative to the target body-fixed frame. We don't */
/* need to propagate states to the solar system barycenter in */
/* this case. */
spkgeo_(trgid, et, fixref, obsid, fxtsta, <, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the state of the observer with respect to the target */
/* in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the sub-observer */
/* point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &found)
;
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. DNEARP re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface */
/* intercept point." The ray direction is simply */
/* the negative of the observer's position relative */
/* to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to */
/* be unable to compute an intercept state, it *is* */
/* an error in this case, since the ray points toward */
/* the center of the target. */
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. SURFPV re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
} else if (uselt) {
/* Light time and possibly stellar aberration corrections are */
/* applied. */
/* Most our work consists of getting ready to call either of the */
/* SPICELIB routines DNEARP or SURFPV. In order to make this */
/* call, we'll need the velocity of the observer relative to the */
/* target body's center in the target body-fixed frame. We must */
/* evaluate the rotation state of the target at the correct */
/* epoch, and account for the rate of change of light time, if */
/* light time corrections are used. The algorithm we use depends */
/* on the algorithm used in SUBPNT, since we're computing the */
/* derivative with respect to time of the solution found by that */
/* routine. */
/* In this algorithm, we must take into account the fact that */
/* SUBPNT performs light time and stellar aberration corrections */
/* for the sub-observer point, not for the center of the target */
/* body. */
/* If light time and stellar aberration corrections are used, */
/* - Find the aberration corrected sub-observer point and the */
/* light time-corrected epoch TRGEPC associated with the */
/* sub-observer point. */
/* - Use TRGEPC to find the position of the target relative to */
/* the solar system barycenter. */
/* - Use TRGEPC to find the orientation of the target relative */
/* to the J2000 reference frame. */
/* - Find the light-time corrected position of the */
/* sub-observer point; use this to compute the stellar */
/* aberration offset that applies to the sub-observer point, */
/* as well as the velocity of this offset. */
/* - Find the corrected state of the target center as seen */
/* from the observer, where the corrections are those */
/* applicable to the sub-observer point. */
/* - Negate the corrected target center state to obtain the */
/* state of the observer relative to the target. */
/* - Express the state of the observer relative to the target */
/* in the target body fixed frame at TRGEPC. */
/* Below, we'll use the convention that vectors expressed */
/* relative to the body-fixed frame have names of the form */
/* FX* */
/* Note that SUBPNT will signal an error if FIXREF is not */
/* actually centered on the target body. */
subpnt_(method, svtarg, et, fixref, abcorr, svobs, spoint, &trgepc,
srfvec, method_len, (ftnlen)36, fixref_len, abcorr_len, (
ftnlen)36);
/* Get J2000-relative states of observer and target with respect */
/* to the solar system barycenter at their respective epochs of */
/* participation. */
spkssb_(obsid, et, "J2000", ssbobs, (ftnlen)5);
spkssb_(trgid, &trgepc, "J2000", ssbtg0, (ftnlen)5);
/* Get the uncorrected J2000 to body-fixed to state */
/* transformation at TRGEPC. */
sxform_("J2000", fixref, &trgepc, xform, (ftnlen)5, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Initialize the state of the sub-observer point in the */
/* body-fixed frame. At this point we don't know the */
/* point's velocity; set it to zero. */
moved_(spoint, &c__3, fxpsta);
cleard_(&c__3, &fxpsta[3]);
if (usestl) {
/* We're going to need the acceleration of the observer */
/* relative to the SSB. Compute this now. */
for (i__ = 1; i__ <= 2; ++i__) {
/* The epoch is ET -/+ TDELTA. */
t = *et + ((i__ << 1) - 3) * 1.;
spkssb_(obsid, &t, "J2000", &obssta[(i__1 = i__ * 6 - 6) < 12
&& 0 <= i__1 ? i__1 : s_rnge("obssta", i__1, "zzgfss"
"ob_", (ftnlen)652)], (ftnlen)5);
}
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the observer's acceleration using a quadratic */
/* approximation. */
qderiv_(&c__3, &obssta[3], &obssta[9], &c_b40, acc);
}
/* The rest of the algorithm is iterative. On the first */
/* iteration, we don't have a good estimate of the velocity */
/* of the sub-observer point relative to the body-fixed */
/* frame. Since we're using this velocity as an input */
/* to the aberration velocity computations, we */
/* expect that treating this velocity as zero on the first */
/* pass yields a reasonable estimate. On the second pass, */
/* we'll use the velocity derived on the first pass. */
cleard_(&c__3, fxpvel);
/* We'll also estimate the rate of change of light time */
/* as zero on the first pass. */
dlt = 0.;
for (i__ = 1; i__ <= 2; ++i__) {
/* Correct the target's velocity for the rate of */
/* change of light time. */
if (xmit) {
scale = dlt + 1.;
} else {
scale = 1. - dlt;
}
/* Scale the velocity portion of the target state to */
/* correct the velocity for the rate of change of light */
/* time. */
moved_(ssbtg0, &c__3, ssbtrg);
vscl_(&scale, &ssbtg0[3], &ssbtrg[3]);
/* Get the state of the target with respect to the observer. */
vsubg_(ssbtrg, ssbobs, &c__6, obstrg);
/* Correct the J2000 to body-fixed state transformation matrix */
/* for the rate of change of light time. */
zzcorsxf_(&xmit, &dlt, xform, corxfm);
/* Invert CORXFM to obtain the corrected */
/* body-fixed to J2000 state transformation. */
invstm_(corxfm, corxfi);
/* Convert the sub-observer point state to the J2000 frame. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
/* Find the J2000-relative state of the sub-observer */
/* point with respect to the target. */
vaddg_(obstrg, pntsta, &c__6, obspnt);
if (usestl) {
/* Now compute the stellar aberration correction */
/* applicable to OBSPNT. We need the velocity of */
/* this correction as well. */
zzstelab_(&xmit, acc, &ssbobs[3], obspnt, sa, savel);
moved_(sa, &c__3, sastat);
moved_(savel, &c__3, &sastat[3]);
/* Adding the stellar aberration state to the target center */
/* state gives us the state of the target center with */
/* respect to the observer, corrected for the aberrations */
/* applicable to the sub-observer point. */
vaddg_(obstrg, sastat, &c__6, stemp);
} else {
moved_(obstrg, &c__6, stemp);
}
/* Convert STEMP to the body-fixed reference frame. */
mxvg_(corxfm, stemp, &c__6, &c__6, fxtsta);
/* At long last, compute the state of the observer */
/* with respect to the target in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the */
/* sub-observer point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &
found);
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. "
"DNEARP returned \"not found.\"", (ftnlen)123);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface intercept */
/* point." The ray direction is simply the negative of the */
/* observer's position relative to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to be */
/* unable to compute an intercept state, it *is* an error */
/* in this case, since the ray points toward the center of */
/* the target. */
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. S"
"URFPV returned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
/* At this point we can update the surface point */
/* velocity and light time derivative estimates. */
/* In order to compute the light time rate, we'll */
/* need the J2000-relative velocity of the sub-observer */
/* point with respect to the observer. First convert */
/* the sub-observer state to the J2000 frame, then */
/* add the result to the state of the target center */
/* with respect to the observer. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
vaddg_(obstrg, pntsta, &c__6, obspnt);
/* Now that we have an improved estimate of the */
/* sub-observer state, we can estimate the rate of */
/* change of light time as */
/* range rate */
/* ---------- */
/* c */
/* If we're correcting for stellar aberration, *ideally* we */
/* should remove that correction now, since the light time */
/* rate is based on light time between the observer and the */
/* light-time corrected sub-observer point. But the error made */
/* by including stellar aberration is too small to make it */
/* worthwhile to make this adjustment. */
vhat_(obspnt, upos);
dlt = vdot_(&obspnt[3], upos) / clight_();
/* With FXPVEL and DLT updated, we'll repeat our */
/* computations. */
}
} else {
/* We should never get here. */
setmsg_("Aberration correction # was not recognized.", (ftnlen)43);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Copy the computed state to the output argument STATE. */
moved_(fxpsta, &c__6, state);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
} /* zzgfssob_ */
/* $Procedure SUBSOL ( Sub-solar point ) */
/* Subroutine */ int subsol_(char *method, char *target, doublereal *et, char
*abcorr, char *obsrvr, doublereal *spoint, ftnlen method_len, ftnlen
target_len, ftnlen abcorr_len, ftnlen obsrvr_len)
{
/* Initialized data */
static doublereal origin[3] = { 0.,0.,0. };
doublereal radii[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), ltime_(doublereal *, integer *, char *, integer
*, doublereal *, doublereal *, ftnlen);
logical found;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal sunlt;
extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
integer obscde;
doublereal lt;
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
integer nradii;
char frname[80];
integer trgcde;
doublereal ettarg;
extern /* Subroutine */ int nearpt_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int spkpos_(char *, doublereal *, char *, char *,
char *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen,
ftnlen), surfpt_(doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, logical *);
doublereal alt, pos[3];
/* $ Abstract */
/* Deprecated: This routine has been superseded by the SPICELIB */
/* routine SUBSLR. This routine is supported for purposes of */
/* backward compatibility only. */
/* Determine the coordinates of the sub-solar point on a target */
/* body as seen by a specified observer at a specified epoch, */
/* optionally corrected for planetary (light time) and stellar */
/* aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* FRAMES */
/* PCK */
/* SPK */
/* TIME */
/* $ Keywords */
/* GEOMETRY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TARGET I Name of target body. */
/* ET I Epoch in ephemeris seconds past J2000 TDB. */
/* ABCORR I Aberration correction. */
/* OBSRVR I Name of observing body. */
/* SPOINT O Sub-solar point on the target body. */
/* $ Detailed_Input */
/* METHOD is a short string specifying the computation method */
/* to be used. The choices are: */
/* 'Near point' The sub-solar point is defined */
/* as the nearest point on the */
/* target to the sun. */
/* 'Intercept' The sub-observer point is */
/* defined as the target surface */
/* intercept of the line */
/* containing the target's center */
/* and the sun's center. */
/* In both cases, the intercept computation treats the */
/* surface of the target body as a triaxial ellipsoid. */
/* The ellipsoid's radii must be available in the kernel */
/* pool. */
/* Neither case nor white space are significant in */
/* METHOD. For example, the string ' NEARPOINT' is */
/* valid. */
/* TARGET is the name of the target body. TARGET is */
/* case-insensitive, and leading and trailing blanks in */
/* TARGET are not significant. Optionally, you may */
/* supply a string containing the integer ID code for */
/* the object. For example both 'MOON' and '301' are */
/* legitimate strings that indicate the moon is the */
/* target body. */
/* This routine assumes that the target body is modeled */
/* by a tri-axial ellipsoid, and that a PCK file */
/* containing its radii has been loaded into the kernel */
/* pool via FURNSH. */
/* ET is the epoch in ephemeris seconds past J2000 at which */
/* the sub-solar point on the target body is to be */
/* computed. */
/* ABCORR indicates the aberration corrections to be applied */
/* when computing the observer-target state. ABCORR */
/* may be any of the following. */
/* 'NONE' Apply no correction. Return the */
/* geometric sub-solar point on the target */
/* body. */
/* 'LT' Correct for planetary (light time) */
/* aberration. Both the state and rotation */
/* of the target body are corrected for one */
/* way light time from target to observer. */
/* The state of the sun relative to the */
/* target is corrected for one way light */
/* from the sun to the target; this state */
/* is evaluated at the epoch obtained by */
/* retarding ET by the one way light time */
/* from target to observer. */
/* 'LT+S' Correct for planetary (light time) and */
/* stellar aberrations. Light time */
/* corrections are the same as in the 'LT' */
/* case above. The target state is */
/* additionally corrected for stellar */
/* aberration as seen by the observer, and */
/* the sun state is corrected for stellar */
/* aberration as seen from the target. */
/* 'CN' Converged Newtonian light time */
/* corrections. This is the same as LT */
/* corrections but with further iterations */
/* to a converged Newtonian light time */
/* solution. Given that relativistic */
/* effects may be as large as the higher */
/* accuracy achieved by this computation, */
/* this is correction is seldom worth the */
/* additional computations required unless */
/* the user incorporates additional */
/* relativistic corrections. Light */
/* time corrections are applied as in the */
/* 'LT' case. */
/* 'CN+S' Converged Newtonian light time */
/* corrections and stellar aberration. */
/* Light time and stellar aberration */
/* corrections are applied as in the */
/* 'LT+S' case. */
/* OBSRVR is the name of the observing body, typically a */
/* spacecraft, the earth, or a surface point on the */
/* earth. OBSRVR is case-insensitive, and leading and */
/* trailing blanks in OBSRVR are not significant. */
/* Optionally, you may supply a string containing the */
/* integer ID code for the object. For example both */
/* 'EARTH' and '399' are legitimate strings that indicate */
/* the earth is the observer. */
/* $ Detailed_Output */
/* SPOINT is the sub-solar point on the target body at ET */
/* expressed relative to the body-fixed frame of the */
/* target body. */
/* The sub-solar point is defined either as the point on */
/* the target body that is closest to the sun, or the */
/* target surface intercept of the line containing the */
/* target's center and the sun's center; the input */
/* argument METHOD selects the definition to be used. */
/* The body-fixed frame, which is time-dependent, is */
/* evaluated at ET if ABCORR is 'NONE'; otherwise the */
/* frame is evaluated at ET-LT, where LT is the one way */
/* light time from target to observer. */
/* The state of the target body is corrected for */
/* aberration as specified by ABCORR; the corrected */
/* state is used in the geometric computation. As */
/* indicated above, the rotation of the target is */
/* retarded by one way light time if ABCORR specifies */
/* that light time correction is to be done. */
/* The state of the sun as seen from the observing */
/* body is also corrected for aberration as specified */
/* by ABCORR. The corrections, when selected, are */
/* applied at the epoch ET-LT, where LT is the one way */
/* light time from target to observer. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* If any of the listed errors occur, the output arguments are */
/* left unchanged. */
/* 1) If the input argument METHOD is not recognized, the error */
/* SPICE(DUBIOUSMETHOD) is signaled. */
/* 2) If either of the input body names TARGET or OBSRVR cannot be */
/* mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */
/* is signaled. */
/* 3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */
/* error SPICE(BODIESNOTDISTINCT) is signaled. */
/* 4) If frame definition data enabling the evaluation of the state */
/* of the target relative to the observer in target body-fixed */
/* coordinates have not been loaded prior to calling SUBSOL, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 5) If the specified aberration correction is not recognized, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 6) If insufficient ephemeris data have been loaded prior to */
/* calling SUBSOL, the error will be diagnosed and signaled by a */
/* routine in the call tree of this routine. */
/* 7) If the triaxial radii of the target body have not been loaded */
/* into the kernel pool prior to calling SUBSOL, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* 8) The target must be an extended body: if any of the radii of */
/* the target body are non-positive, the error will be diagnosed */
/* and signaled by routines in the call tree of this routine. */
/* 9) If PCK data supplying a rotation model for the target body */
/* have not been loaded prior to calling SUBSOL, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* Appropriate SPK, PCK, and frame data must be available to */
/* the calling program before this routine is called. Typically */
/* the data are made available by loading kernels; however the */
/* data may be supplied via subroutine interfaces if applicable. */
/* The following data are required: */
/* - SPK data: ephemeris data for sun, target, and observer must */
/* be loaded. If aberration corrections are used, the states of */
/* sun, target, and observer relative to the solar system */
/* barycenter must be calculable from the available ephemeris */
/* data. Ephemeris data are made available by loading */
/* one or more SPK files via FURNSH. */
/* - PCK data: triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: a rotation model for the target body must */
/* be loaded. This may be provided in a text or binary PCK */
/* file which is loaded via FURNSH. */
/* - Frame data: if a frame definition is required to convert */
/* the sun, observer, and target states to the body-fixed frame */
/* of the target, that definition must be available in the */
/* kernel pool. Typically the definition is supplied by loading */
/* a frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* SUBSOL computes the sub-solar point on a target body, as seen by */
/* a specified observer. */
/* There are two different popular ways to define the sub-solar */
/* point: "nearest point on target to the sun" or "target surface */
/* intercept of line containing target and sun." These coincide */
/* when the target is spherical and generally are distinct otherwise. */
/* When comparing sub-point computations with results from sources */
/* other than SPICE, it's essential to make sure the same geometric */
/* definitions are used. */
/* $ Examples */
/* In the following example program, the file MGS.BSP is a */
/* hypothetical binary SPK ephemeris file containing data for the */
/* Mars Global Surveyor orbiter. The SPK file de405s.bsp contains */
/* data for the planet barycenters as well as the Earth, Moon, and */
/* Sun for the time period including the date 1997 Dec 31 12:000 */
/* UTC. MGS0000A.TPC is a planetary constants kernel file */
/* containing radii and rotation model constants. MGS00001.TLS is */
/* a leapseconds file. (File names shown here that are specific */
/* to MGS are not names of actual files.) */
/* IMPLICIT NONE */
/* CHARACTER*25 METHOD ( 2 ) */
/* INTEGER I */
/* DOUBLE PRECISION DPR */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LAT */
/* DOUBLE PRECISION LON */
/* DOUBLE PRECISION RADIUS */
/* DOUBLE PRECISION SPOINT ( 3 ) */
/* DATA METHOD / 'Intercept', 'Near point' / */
/* C */
/* C Load kernel files. */
/* C */
/* CALL FURNSH ( 'MGS00001.TLS' ) */
/* CALL FURNSH ( 'MGS0000A.TPC' ) */
/* CALL FURNSH ( 'de405s.bsp' ) */
/* CALL FURNSH ( 'MGS.BSP' ) */
/* C */
/* C Convert the UTC request time to ET (seconds past */
/* C J2000, TDB). */
/* C */
/* CALL STR2ET ( '1997 Dec 31 12:00:00', ET ) */
/* C */
/* C Compute sub-spacecraft point using light time and stellar */
/* C aberration corrections. Use the "target surface intercept" */
/* C definition of sub-spacecraft point on the first loop */
/* C iteration, and use the "near point" definition on the */
/* C second. */
/* C */
/* DO I = 1, 2 */
/* CALL SUBSOL ( METHOD(I), */
/* . 'MARS', ET, 'LT+S', 'MGS', SPOINT ) */
/* C */
/* C Convert rectangular coordinates to planetocentric */
/* C latitude and longitude. Convert radians to degrees. */
/* C */
/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */
/* LON = LON * DPR () */
/* LAT = LAT * DPR () */
/* C */
/* C Write the results. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Computation method: ', METHOD(I) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) ' Radius (km) = ', RADIUS */
/* WRITE (*,*) ' Planetocentric Latitude (deg) = ', LAT */
/* WRITE (*,*) ' Planetocentric Longitude (deg) = ', LON */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* The appropriate kernel data must have been loaded before this */
/* routine is called. See the Files section above. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* J.E. McLean (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.3, 18-MAY-2010 (BVS) */
/* Index line now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */
/* Typo correction in Required_Reading, changed */
/* FRAME to FRAMES. */
/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */
/* Abstract now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */
/* Call to BODVAR was replaced with call to BODVCD. */
/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */
/* Updated to support representations of integers in the input */
/* arguments TARGET and OBSRVR. Deleted references in header to */
/* kernel-specific loaders. Made miscellaneous minor corrections */
/* to header comments. */
/* - SPICELIB Version 1.0.2, 12-DEC-2002 (NJB) */
/* Corrected and updated code example in header. */
/* - SPICELIB Version 1.0.1, 1-NOV-1999 (WLT) */
/* Declared routine LTIME to be external. */
/* - SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED sub-solar point */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */
/* Updated to support representations of integers in the */
/* input arguments TARGET and OBSRVR: calls to BODN2C */
/* were replaced by calls to BODS2C. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SUBSOL", (ftnlen)6);
}
/* Obtain integer codes for the target and observer. */
bods2c_(target, &trgcde, &found, target_len);
if (! found) {
setmsg_("The target, '#', is not a recognized name for an ephemeris "
"object. The cause of this problem may be that you need an up"
"dated version of the SPICE Toolkit. ", (ftnlen)155);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
bods2c_(obsrvr, &obscde, &found, obsrvr_len);
if (! found) {
setmsg_("The observer, '#', is not a recognized name for an ephemeri"
"s object. The cause of this problem may be that you need an "
"updated version of the SPICE Toolkit. ", (ftnlen)157);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
/* Check the input body codes. If they are equal, signal */
/* an error. */
if (obscde == trgcde) {
setmsg_("In computing the sub-observer point, the observing body and"
" target body are the same. Both are #.", (ftnlen)97);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
/* Get the radii of the target body from the kernel pool. */
bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5);
/* Find the name of the body-fixed frame associated with the */
/* target body. We'll want the state of the target relative to */
/* the observer in this body-fixed frame. */
cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
if (! found) {
setmsg_("No body-fixed frame is associated with target body #; a fra"
"me kernel must be loaded to make this association. Consult "
"the FRAMES Required Reading for details.", (ftnlen)159);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
/* If we're using aberration corrections, we'll need the */
/* one way light time from the target to the observer. Otherwise, */
/* we set the time time to zero. */
if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) {
lt = 0.;
ettarg = *et;
} else {
ltime_(et, &obscde, "<-", &trgcde, &ettarg, <, (ftnlen)2);
}
/* Determine the position of the sun in target body-fixed */
/* coordinates. */
/* Call SPKEZ to compute the position of the sun as seen from the */
/* target body and the light time between them SUNLT. This state is */
/* evaluated at the target epoch ETTARG. We request that the */
/* coordinates of the target-sun position vector POS be returned */
/* relative to the body fixed reference frame associated with the */
/* target body, using aberration corrections specified by the input */
/* argument ABCORR. */
spkpos_("SUN", &ettarg, frname, abcorr, target, pos, &sunlt, (ftnlen)3, (
ftnlen)80, abcorr_len, target_len);
/* Find the sub-solar point using the specified geometric definition. */
if (eqstr_(method, "Near point", method_len, (ftnlen)10)) {
/* Locate the nearest point to the sun on the target. */
nearpt_(pos, radii, &radii[1], &radii[2], spoint, &alt);
} else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) {
surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found);
/* Since the line in question passes through the center of the */
/* target, there will always be a surface intercept. So we should */
/* never have FOUND = .FALSE. */
if (! found) {
setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex "
"of ray is at target center. This indicates a bug. Please"
" contact NAIF.", (ftnlen)125);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
} else {
setmsg_("The computation method # was not recognized. Allowed values"
" are \"Near point\" and \"Intercept.\"", (ftnlen)93);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20);
chkout_("SUBSOL", (ftnlen)6);
return 0;
}
chkout_("SUBSOL", (ftnlen)6);
return 0;
} /* subsol_ */
/* $Procedure SUBPT ( Sub-observer point ) */
/* Subroutine */ int subpt_(char *method, char *target, doublereal *et, char *
abcorr, char *obsrvr, doublereal *spoint, doublereal *alt, ftnlen
method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len)
{
/* Initialized data */
static doublereal origin[3] = { 0.,0.,0. };
doublereal radii[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
extern doublereal vdist_(doublereal *, doublereal *);
extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
integer obscde;
doublereal lt;
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
integer nradii;
char frname[80];
integer trgcde;
extern /* Subroutine */ int nearpt_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
doublereal tstate[6];
extern logical return_(void);
extern /* Subroutine */ int vminus_(doublereal *, doublereal *), surfpt_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, logical *);
doublereal pos[3];
/* $ Abstract */
/* Deprecated: This routine has been superseded by the SPICELIB */
/* routine SUBPNT. This routine is supported for purposes of */
/* backward compatibility only. */
/* Compute the rectangular coordinates of the sub-observer point on */
/* a target body at a particular epoch, optionally corrected for */
/* planetary (light time) and stellar aberration. Return these */
/* coordinates expressed in the body-fixed frame associated with the */
/* target body. Also, return the observer's altitude above the */
/* target body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* FRAMES */
/* PCK */
/* SPK */
/* TIME */
/* $ Keywords */
/* GEOMETRY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TARGET I Name of target body. */
/* ET I Epoch in ephemeris seconds past J2000 TDB. */
/* ABCORR I Aberration correction. */
/* OBSRVR I Name of observing body. */
/* SPOINT O Sub-observer point on the target body. */
/* ALT O Altitude of the observer above the target body. */
/* $ Detailed_Input */
/* METHOD is a short string specifying the computation method */
/* to be used. The choices are: */
/* 'Near point' The sub-observer point is */
/* defined as the nearest point on */
/* the target relative to the */
/* observer. */
/* 'Intercept' The sub-observer point is */
/* defined as the target surface */
/* intercept of the line */
/* containing the observer and the */
/* target's center. */
/* In both cases, the intercept computation treats the */
/* surface of the target body as a triaxial ellipsoid. */
/* The ellipsoid's radii must be available in the kernel */
/* pool. */
/* Neither case nor white space are significant in */
/* METHOD. For example, the string ' NEARPOINT' is */
/* valid. */
/* TARGET is the name of a target body. Optionally, you may */
/* supply the integer ID code for the object as */
/* an integer string. For example both 'MOON' and */
/* '301' are legitimate strings that indicate the */
/* moon is the target body. This routine assumes */
/* that this body is modeled by a tri-axial ellipsoid, */
/* and that a PCK file containing its radii has been */
/* loaded into the kernel pool via FURNSH. */
/* ET is the epoch in ephemeris seconds past J2000 at which */
/* the sub-observer point on the target body is to be */
/* computed. */
/* ABCORR indicates the aberration corrections to be applied */
/* when computing the observer-target state. ABCORR */
/* may be any of the following. */
/* 'NONE' Apply no correction. Return the */
/* geometric sub-observer point on the */
/* target body. */
/* 'LT' Correct for planetary (light time) */
/* aberration. Both the state and rotation */
/* of the target body are corrected for */
/* light time. */
/* 'LT+S' Correct for planetary (light time) and */
/* stellar aberrations. Both the state and */
/* rotation of the target body are */
/* corrected for light time. */
/* 'CN' Converged Newtonian light time */
/* corrections. This is the same as LT */
/* corrections but with further iterations */
/* to a converged Newtonian light time */
/* solution. Given that relativistic */
/* effects may be as large as the higher */
/* accuracy achieved by this computation, */
/* this is correction is seldom worth the */
/* additional computations required unless */
/* the user incorporates additional */
/* relativistic corrections. Both the */
/* state and rotation of the target body */
/* are corrected for light time. */
/* 'CN+S' Converged Newtonian light time */
/* corrections and stellar aberration. */
/* Both the state and rotation of the */
/* target body are corrected for light */
/* time. */
/* OBSRVR is the name of the observing body. This is typically */
/* a spacecraft, the earth, or a surface point on the */
/* earth. Optionally, you may supply the ID code of */
/* the object as an integer string. For example, both */
/* 'EARTH' and '399' are legitimate strings to supply */
/* to indicate the observer is Earth. */
/* $ Detailed_Output */
/* SPOINT is the sub-observer point on the target body at ET */
/* expressed relative to the body-fixed frame of the */
/* target body. */
/* The sub-observer point is defined either as the point */
/* on the target body that is closest to the observer, */
/* or the target surface intercept of the line from the */
/* observer to the target's center; the input argument */
/* METHOD selects the definition to be used. */
/* The body-fixed frame, which is time-dependent, is */
/* evaluated at ET if ABCORR is 'NONE'; otherwise the */
/* frame is evaluated at ET-LT, where LT is the one-way */
/* light time from target to observer. */
/* The state of the target body is corrected for */
/* aberration as specified by ABCORR; the corrected */
/* state is used in the geometric computation. As */
/* indicated above, the rotation of the target is */
/* retarded by one-way light time if ABCORR specifies */
/* that light time correction is to be done. */
/* ALT is the "altitude" of the observer above the target */
/* body. When METHOD specifies a "near point" */
/* computation, ALT is truly altitude in the standard */
/* geometric sense: the length of a segment dropped from */
/* the observer to the target's surface, such that the */
/* segment is perpendicular to the surface at the */
/* contact point SPOINT. */
/* When METHOD specifies an "intercept" computation, ALT */
/* is still the length of the segment from the observer */
/* to the surface point SPOINT, but this segment in */
/* general is not perpendicular to the surface. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* If any of the listed errors occur, the output arguments are */
/* left unchanged. */
/* 1) If the input argument METHOD is not recognized, the error */
/* SPICE(DUBIOUSMETHOD) is signaled. */
/* 2) If either of the input body names TARGET or OBSRVR cannot be */
/* mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */
/* is signaled. */
/* 3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */
/* error SPICE(BODIESNOTDISTINCT) is signaled. */
/* 4) If frame definition data enabling the evaluation of the state */
/* of the target relative to the observer in target body-fixed */
/* coordinates have not been loaded prior to calling SUBPT, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 5) If the specified aberration correction is not recognized, the */
/* error will be diagnosed and signaled by a routine in the call */
/* tree of this routine. */
/* 6) If insufficient ephemeris data have been loaded prior to */
/* calling SUBPT, the error will be diagnosed and signaled by a */
/* routine in the call tree of this routine. */
/* 7) If the triaxial radii of the target body have not been loaded */
/* into the kernel pool prior to calling SUBPT, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* 8) The target must be an extended body: if any of the radii of */
/* the target body are non-positive, the error will be diagnosed */
/* and signaled by routines in the call tree of this routine. */
/* 9) If PCK data supplying a rotation model for the target body */
/* have not been loaded prior to calling SUBPT, the error will be */
/* diagnosed and signaled by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* Appropriate SPK, PCK, and frame kernels must be loaded */
/* prior by the calling program before this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for target and observer must be */
/* loaded. If aberration corrections are used, the states of */
/* target and observer relative to the solar system barycenter */
/* must be calculable from the available ephemeris data. */
/* Typically ephemeris data are made available by loading one */
/* or more SPK files via FURNSH. */
/* - PCK data: triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: rotation data for the target body must */
/* be loaded. These may be provided in a text or binary PCK */
/* file. Either type of file may be loaded via FURNSH. */
/* - Frame data: if a frame definition is required to convert */
/* the observer and target states to the body-fixed frame of */
/* the target, that definition must be available in the kernel */
/* pool. Typically the definition is supplied by loading a */
/* frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* SUBPT computes the sub-observer point on a target body. */
/* (The sub-observer point is commonly called the sub-spacecraft */
/* point when the observer is a spacecraft.) SUBPT also */
/* determines the altitude of the observer above the target body. */
/* There are two different popular ways to define the sub-observer */
/* point: "nearest point on target to observer" or "target surface */
/* intercept of line containing observer and target." These */
/* coincide when the target is spherical and generally are distinct */
/* otherwise. */
/* When comparing sub-point computations with results from sources */
/* other than SPICE, it's essential to make sure the same geometric */
/* definitions are used. */
/* $ Examples */
/* The numerical results shown for this example may differ across */
/* platforms. The results depend on the SPICE kernels used as */
/* input, the compiler and supporting libraries, and the machine */
/* specific arithmetic implementation. */
/* In the following example program, the file */
/* spk_m_031103-040201_030502.bsp */
/* is a binary SPK file containing data for Mars Global Surveyor, */
/* Mars, and the Sun for a time interval bracketing the date */
/* 2004 JAN 1 12:00:00 UTC. */
/* pck00007.tpc is a planetary constants kernel file containing */
/* radii and rotation model constants. naif0007.tls is a */
/* leapseconds kernel. */
/* Find the sub-observer point of the Mars Global Surveyor (MGS) */
/* spacecraft on Mars for a specified time. Perform the computation */
/* twice, using both the "intercept" and "near point" options. */
/* IMPLICIT NONE */
/* CHARACTER*25 METHOD ( 2 ) */
/* INTEGER I */
/* DOUBLE PRECISION ALT */
/* DOUBLE PRECISION DPR */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LAT */
/* DOUBLE PRECISION LON */
/* DOUBLE PRECISION RADIUS */
/* DOUBLE PRECISION SPOINT ( 3 ) */
/* DATA METHOD / 'Intercept', 'Near point' / */
/* C */
/* C Load kernel files. */
/* C */
/* CALL FURNSH ( 'naif0007.tls' ) */
/* CALL FURNSH ( 'pck00007.tpc' ) */
/* CALL FURNSH ( 'spk_m_031103-040201_030502.bsp' ) */
/* C */
/* C Convert the UTC request time to ET (seconds past */
/* C J2000, TDB). */
/* C */
/* CALL STR2ET ( '2004 JAN 1 12:00:00', ET ) */
/* C */
/* C Compute sub-spacecraft point using light time and stellar */
/* C aberration corrections. Use the "target surface intercept" */
/* C definition of sub-spacecraft point on the first loop */
/* C iteration, and use the "near point" definition on the */
/* C second. */
/* C */
/* DO I = 1, 2 */
/* CALL SUBPT ( METHOD(I), */
/* . 'MARS', ET, 'LT+S', */
/* . 'MGS', SPOINT, ALT ) */
/* C */
/* C Convert rectangular coordinates to planetocentric */
/* C latitude and longitude. Convert radians to degrees. */
/* C */
/* CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */
/* LON = LON * DPR () */
/* LAT = LAT * DPR () */
/* C */
/* C Write the results. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Computation method: ', METHOD(I) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) ' Radius (km) = ', RADIUS */
/* WRITE (*,*) ' Planetocentric Latitude (deg) = ', LAT */
/* WRITE (*,*) ' Planetocentric Longitude (deg) = ', LON */
/* WRITE (*,*) ' Altitude (km) = ', ALT */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* When this program is executed, the output will be: */
/* Computation method: Intercept */
/* Radius (km) = 3387.97077 */
/* Planetocentric Latitude (deg) = -39.7022724 */
/* Planetocentric Longitude (deg) = -159.226663 */
/* Altitude (km) = 373.173506 */
/* Computation method: Near point */
/* Radius (km) = 3387.9845 */
/* Planetocentric Latitude (deg) = -39.6659329 */
/* Planetocentric Longitude (deg) = -159.226663 */
/* Altitude (km) = 373.166636 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* N.J. Bachman (JPL) */
/* J.E. McLean (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.3, 18-MAY-2010 (BVS) */
/* Index line now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */
/* Typo correction in Required_Reading, changed */
/* FRAME to FRAMES. */
/* - SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */
/* Abstract now states that this routine is deprecated. */
/* - SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */
/* Replaced call to BODVAR with call to BODVCD. */
/* - SPICELIB Version 1.1.0, 21-JUL-2004 (EDW) */
/* Changed BODN2C call to BODS2C giving the routine */
/* the capability to accept string representations of */
/* interger IDs for TARGET and OBSRVR. */
/* - SPICELIB Version 1.0.1, 27-JUL-2003 (NJB) (CHA) */
/* Various header corrections were made. The example program */
/* was upgraded to use real kernels, and the program's output is */
/* shown. */
/* - SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED sub-observer point */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SUBPT", (ftnlen)5);
}
/* Obtain integer codes for the target and observer. */
/* Target... */
bods2c_(target, &trgcde, &found, target_len);
if (! found) {
setmsg_("The target, '#', is not a recognized name for an ephemeris "
"object. The cause of this problem may be that you need an up"
"dated version of the SPICE Toolkit. ", (ftnlen)155);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* ...observer. */
bods2c_(obsrvr, &obscde, &found, obsrvr_len);
if (! found) {
setmsg_("The observer, '#', is not a recognized name for an ephemeri"
"s object. The cause of this problem may be that you need an "
"updated version of the SPICE Toolkit. ", (ftnlen)157);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* Check the input body codes. If they are equal, signal */
/* an error. */
if (obscde == trgcde) {
setmsg_("In computing the sub-observer point, the observing body and"
" target body are the same. Both are #.", (ftnlen)97);
errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* Get the radii of the target body from the kernel pool. */
bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5);
/* Find the name of the body-fixed frame associated with the */
/* target body. We'll want the state of the target relative to */
/* the observer in this body-fixed frame. */
cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
if (! found) {
setmsg_("No body-fixed frame is associated with target body #; a fra"
"me kernel must be loaded to make this association. Consult "
"the FRAMES Required Reading for details.", (ftnlen)159);
errch_("#", target, (ftnlen)1, target_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* Determine the position of the observer in target */
/* body-fixed coordinates. */
/* - Call SPKEZR to compute the position of the target */
/* body as seen from the observing body and the light time */
/* (LT) between them. SPKEZR returns a state which is */
/* the position and velocity, but we'll only use the position */
/* which is the first three elements. We request that the */
/* coordinates of POS be returned relative to the body fixed */
/* reference frame associated with the target body, using */
/* aberration corrections specified by the input argument */
/* ABCORR. */
/* - Call VMINUS to negate the direction of the vector (POS) */
/* so it will be the position of the observer as seen from */
/* the target body in target body fixed coordinates. */
/* Note that this result is not the same as the result of */
/* calling SPKEZR with the target and observer switched. We */
/* computed the vector FROM the observer TO the target in */
/* order to get the proper light time and stellar aberration */
/* corrections (if requested). Now we need the inverse of */
/* that corrected vector in order to compute the sub-point. */
spkez_(&trgcde, et, frname, abcorr, &obscde, tstate, <, (ftnlen)80,
abcorr_len);
/* Negate the target's state to obtain the position of the observer */
/* relative to the target. */
vminus_(tstate, pos);
/* Find the sub-point and "altitude" (distance from observer to */
/* sub-point) using the specified geometric definition. */
if (eqstr_(method, "Near point", method_len, (ftnlen)10)) {
/* Locate the nearest point to the observer on the target. */
nearpt_(pos, radii, &radii[1], &radii[2], spoint, alt);
} else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) {
surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found);
/* Since the line in question passes through the center of the */
/* target, there will always be a surface intercept. So we should */
/* never have FOUND = .FALSE. */
if (! found) {
setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex "
"of ray is at target center. This indicates a bug. Please"
" contact NAIF.", (ftnlen)125);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
/* SURFPT doesn't compute altitude, so do it here. */
*alt = vdist_(pos, spoint);
} else {
setmsg_("The computation method # was not recognized. Allowed values"
" are \"Near point\" and \"Intercept.\"", (ftnlen)93);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20);
chkout_("SUBPT", (ftnlen)5);
return 0;
}
chkout_("SUBPT", (ftnlen)5);
return 0;
} /* subpt_ */
/* $Procedure CKCOV ( CK coverage ) */
/* Subroutine */ int ckcov_(char *ck, integer *idcode, logical *needav, char *
level, doublereal *tol, char *timsys, doublereal *cover, ftnlen
ck_len, ftnlen level_len, ftnlen timsys_len)
{
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
char arch[80];
logical avok;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int dafgs_(doublereal *);
integer clkid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
doublereal dctol[2];
logical istdb, found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer dtype;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *);
doublereal et;
integer handle, segbeg;
extern /* Subroutine */ int dafcls_(integer *), ckmeta_(integer *, char *,
integer *, ftnlen);
integer segend;
extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen,
ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen);
logical seglvl;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), wninsd_(doublereal *, doublereal *, doublereal *),
errint_(char *, integer *, ftnlen);
char kertyp[80];
extern logical return_(void);
extern /* Subroutine */ int zzckcv01_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv02_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv03_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv04_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv05_(integer *, integer *, integer *,
integer *, doublereal *, doublereal *, char *, doublereal *,
ftnlen);
/* $ Abstract */
/* Find the coverage window for a specified object in a specified CK */
/* file. */
/* $ 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 */
/* CELLS */
/* DAF */
/* CK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* POINTING */
/* TIME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CK I Name of CK file. */
/* IDCODE I ID code of object. */
/* NEEDAV I Flag indicating whether angular velocity is needed. */
/* LEVEL I Coverage level: 'SEGMENT' OR 'INTERVAL'. */
/* TOL I Tolerance in ticks. */
/* TIMSYS I Time system used to represent coverage. */
/* COVER I/O Window giving coverage for IDCODE. */
/* $ Detailed_Input */
/* CK is the name of a C-kernel. */
/* IDCODE is the integer ID code of an object, normally */
/* a spacecraft structure or instrument, for which */
/* pointing data are expected to exist in the */
/* specified CK file. */
/* NEEDAV is a logical variable indicating whether only */
/* segments having angular velocity are to be */
/* considered when determining coverage. When */
/* NEEDAV is .TRUE., segments without angular */
/* velocity don't contribute to the coverage */
/* window; when NEEDAV is .FALSE., all segments for */
/* IDCODE may contribute to the coverage window. */
/* LEVEL is the level (granularity) at which the coverage */
/* is examined. Allowed values and corresponding */
/* meanings are: */
/* 'SEGMENT' The output coverage window */
/* contains intervals defined by the */
/* start and stop times of segments */
/* for the object designated by */
/* IDCODE. */
/* 'INTERVAL' The output coverage window */
/* contains interpolation intervals */
/* of segments for the object */
/* designated by IDCODE. For type 1 */
/* segments, which don't have */
/* interpolation intervals, each */
/* epoch associated with a pointing */
/* instance is treated as a singleton */
/* interval; these intervals are */
/* added to the coverage window. */
/* All interpolation intervals are */
/* considered to lie within the */
/* segment bounds for the purpose of */
/* this summary: if an interpolation */
/* interval extends beyond the */
/* segment coverage interval, only */
/* its intersection with the segment */
/* coverage interval is considered to */
/* contribute to the total coverage. */
/* TOL is a tolerance value expressed in ticks of the */
/* spacecraft clock associated with IDCODE. Before */
/* each interval is inserted into the coverage */
/* window, the interval is intersected with the */
/* segment coverage interval, then if the */
/* intersection is non-empty, it is expanded by TOL: */
/* the left endpoint of the intersection interval is */
/* reduced by TOL and the right endpoint is increased */
/* by TOL. Adjusted interval endpoints, when */
/* expressed as encoded SCLK, never are less than */
/* zero ticks. Any intervals that overlap as a */
/* result of the expansion are merged. */
/* The coverage window returned when TOL > 0 */
/* indicates the coverage provided by the file to the */
/* CK readers CKGPAV and CKGP when that value of TOL */
/* is passed to them as an input. */
/* TIMSYS is a string indicating the time system used */
/* in the output coverage window. TIMSYS may */
/* have the values: */
/* 'SCLK' Elements of COVER are expressed in */
/* encoded SCLK ("ticks"), where the */
/* clock is associated with the object */
/* designated by IDCODE. */
/* 'TDB' Elements of COVER are expressed as */
/* seconds past J2000 TDB. */
/* COVER is an initialized SPICELIB window data structure. */
/* COVER optionally may contain coverage data on */
/* input; on output, the data already present in */
/* COVER will be combined with coverage found for the */
/* object designated by IDCODE in the file CK. */
/* If COVER contains no data on input, its size and */
/* cardinality still must be initialized. */
/* $ Detailed_Output */
/* COVER is a SPICELIB window data structure which */
/* represents the merged coverage for IDCODE. When */
/* the coverage level is 'INTERVAL', this is the set */
/* of time intervals for which data for IDCODE are */
/* present in the file CK, merged with the set of */
/* time intervals present in COVER on input. The */
/* merged coverage is represented as the union of one */
/* or more disjoint time intervals. The window COVER */
/* contains the pairs of endpoints of these */
/* intervals. */
/* When the coverage level is 'SEGMENT', COVER is */
/* computed in a manner similar to that described */
/* above, but the coverage intervals used in the */
/* computation are those of segments rather than */
/* interpolation intervals within segments. */
/* When TOL is > 0, the intervals comprising the */
/* coverage window for IDCODE are expanded by TOL and */
/* any intervals overlapping as a result are merged. */
/* The resulting window is returned in COVER. The */
/* expanded window in no case extends beyond the */
/* segment bounds in either direction by more than */
/* TOL. */
/* The interval endpoints contained in COVER are */
/* encoded spacecraft clock times if TIMSYS is */
/* 'SCLK'; otherwise the times are converted from */
/* encoded spacecraft clock to seconds past J2000 */
/* TDB. */
/* See the Examples section below for a complete */
/* example program showing how to retrieve the */
/* endpoints from COVER. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file has transfer format, the error */
/* SPICE(INVALIDFORMAT) is signaled. */
/* 2) If the input file is not a transfer file but has architecture */
/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */
/* 3) If the input file is a binary DAF file of type other than */
/* CK, the error SPICE(BADFILETYPE) is signaled. */
/* 4) If the CK file cannot be opened or read, the error will */
/* be diagnosed by routines called by this routine. The output */
/* window will not be modified. */
/* 5) If the size of the output WINDOW argument COVER is */
/* insufficient to contain the actual number of intervals in the */
/* coverage window for IDCODE, the error will be diagnosed by */
/* routines called by this routine. */
/* 6) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
/* signaled. */
/* 7) If LEVEL is not recognized, the error SPICE(INVALIDOPTION) */
/* is signaled. */
/* 8) If TIMSYS is not recognized, the error SPICE(NOTSUPPORTED) */
/* is signaled. */
/* 9) If a time conversion error occurs, the error will be */
/* diagnosed by a routine in the call tree of this routine. */
/* 10) If the output time system is TDB, the CK subsystem must be */
/* able to map IDCODE to the ID code of the associated */
/* spacecraft clock. If this mapping cannot be performed, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* This routine reads a C-kernel. */
/* If the output time system is 'TDB', then a leapseconds kernel */
/* and an SCLK kernel for the spacecraft clock associated with */
/* IDCODE must be loaded before this routine is called. */
/* If the ID code of the clock associated with IDCODE is not */
/* equal to */
/* IDCODE / 1000 */
/* then the kernel variable */
/* CK_<IDCODE>_SCLK */
/* must be present in the kernel pool to identify the clock */
/* associated with IDCODE. This variable must contain the ID code */
/* to be used for conversion between SCLK and TDB. Normally this */
/* variable is provided in a text kernel loaded via FURNSH. */
/* $ Particulars */
/* This routine provides an API via which applications can determine */
/* the coverage a specified CK file provides for a specified */
/* object. */
/* $ Examples */
/* 1) Display the interval-level coverage for each object in a */
/* specified CK file. Use tolerance of zero ticks. Do not */
/* request angular velocity. Express the results in the TDB time */
/* system. */
/* Find the set of objects in the file. Loop over the contents */
/* of the ID code set: find the coverage for each item in the */
/* set and display the coverage. */
/* PROGRAM CKCVR */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* INTEGER CARDI */
/* C */
/* C Local parameters */
/* C */
/* C */
/* C Declare the coverage window. Make enough room */
/* C for MAXIV intervals. */
/* C */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXIV */
/* PARAMETER ( MAXIV = 100000 ) */
/* INTEGER WINSIZ */
/* PARAMETER ( WINSIZ = 2 * MAXIV ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* INTEGER MAXOBJ */
/* PARAMETER ( MAXOBJ = 1000 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) CK */
/* CHARACTER*(FILSIZ) LSK */
/* CHARACTER*(FILSIZ) SCLK */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */
/* DOUBLE PRECISION E */
/* INTEGER I */
/* INTEGER IDS ( LBCELL : MAXOBJ ) */
/* INTEGER J */
/* INTEGER NIV */
/* C */
/* C Load a leapseconds kernel and SCLK kernel for output */
/* C time conversion. Note that we assume a single spacecraft */
/* C clock is associated with all of the objects in the CK. */
/* C */
/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */
/* CALL FURNSH ( LSK ) */
/* CALL PROMPT ( 'Name of SCLK kernel > ', SCLK ) */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Get name of CK file. */
/* C */
/* CALL PROMPT ( 'Name of CK file > ', CK ) */
/* C */
/* C Initialize the set IDS. */
/* C */
/* CALL SSIZEI ( MAXOBJ, IDS ) */
/* C */
/* C Initialize the window COVER. */
/* C */
/* CALL SSIZED ( WINSIZ, COVER ) */
/* C */
/* C Find the set of objects in the CK file. */
/* C */
/* CALL CKOBJ ( CK, IDS ) */
/* C */
/* C We want to display the coverage for each object. Loop */
/* C over the contents of the ID code set, find the coverage */
/* C for each item in the set, and display the coverage. */
/* C */
/* DO I = 1, CARDI( IDS ) */
/* C */
/* C Find the coverage window for the current */
/* C object. Empty the coverage window each time */
/* C so we don't include data for the previous object. */
/* C */
/* CALL SCARDD ( 0, COVER ) */
/* CALL CKCOV ( CK, IDS(I), .FALSE., */
/* . 'INTERVAL', 0.D0, 'TDB', COVER ) */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) '========================================' */
/* WRITE (*,*) 'Coverage for object ', IDS(I) */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO J = 1, NIV */
/* C */
/* C Get the endpoints of the Jth interval. */
/* C */
/* CALL WNFETD ( COVER, J, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', J */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* WRITE (*,*) '========================================' */
/* END DO */
/* END */
/* 2) Find the segment-level coverage for the object designated by */
/* IDCODE provided by the set of CK files loaded via a */
/* metakernel. (The metakernel must also specify leapseconds and */
/* SCLK kernels.) Use tolerance of zero ticks. Do not request */
/* angular velocity. Express the results in the TDB time system. */
/* PROGRAM CKMET */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER MAXCOV */
/* PARAMETER ( MAXCOV = 100000 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) FILE */
/* CHARACTER*(LNSIZE) IDCH */
/* CHARACTER*(FILSIZ) META */
/* CHARACTER*(FILSIZ) SOURCE */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(LNSIZE) TYPE */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */
/* DOUBLE PRECISION E */
/* INTEGER COUNT */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER IDCODE */
/* INTEGER NIV */
/* LOGICAL FOUND */
/* C */
/* C Prompt for the metakernel name; load the metakernel. */
/* C The metakernel lists the CK files whose coverage */
/* C for IDCODE we'd like to determine. The metakernel */
/* C must also specify a leapseconds kernel and an SCLK */
/* C kernel for the clock associated with IDCODE. */
/* C */
/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */
/* CALL FURNSH ( META ) */
/* C */
/* C Get the ID code of interest. */
/* C */
/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */
/* CALL PRSINT ( IDCH, IDCODE ) */
/* C */
/* C Initialize the coverage window. */
/* C */
/* CALL SSIZED ( MAXCOV, COVER ) */
/* C */
/* C Find out how many kernels are loaded. Loop over the */
/* C kernels: for each loaded CK file, add its coverage */
/* C for IDCODE, if any, to the coverage window. */
/* C */
/* CALL KTOTAL ( 'CK', COUNT ) */
/* DO I = 1, COUNT */
/* CALL KDATA ( I, 'CK', FILE, TYPE, */
/* . SOURCE, HANDLE, FOUND ) */
/* CALL CKCOV ( FILE, IDCODE, .FALSE., */
/* . 'SEGMENT', 0.0, 'TDB', COVER ) */
/* END DO */
/* C */
/* C Display results. */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Coverage for object ', IDCODE */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO I = 1, NIV */
/* C */
/* C Get the endpoints of the Ith interval. */
/* C */
/* CALL WNFETD ( COVER, I, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', I */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) When this routine is used to accumulate coverage for IDCODE */
/* provided by multiple CK files, the inputs NEEDAV, LEVEL, TOL, */
/* and TIMSYS must have the same values for all files in order */
/* for the result to be meaningful. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */
/* Corrected bug in first program in header Examples section: */
/* program now empties the coverage window prior to collecting */
/* data for the current object. Updated examples to use WNCARD */
/* rather than CARDD. */
/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* get coverage window for ck object */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKCOV", (ftnlen)5);
/* Check tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative; actual value was #.", (
ftnlen)51);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Use a logical flag to indicate whether this is a segment-level */
/* coverage description. */
seglvl = eqstr_(level, "SEGMENT", level_len, (ftnlen)7);
/* Check coverage level keyword. */
if (! (seglvl || eqstr_(level, "INTERVAL", level_len, (ftnlen)8))) {
setmsg_("Allowed values of LEVEL are # and #; actual value was #.", (
ftnlen)56);
errch_("#", "SEGMENT", (ftnlen)1, (ftnlen)7);
errch_("#", "INTERVAL", (ftnlen)1, (ftnlen)8);
errch_("#", level, (ftnlen)1, level_len);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* See whether GETFAT thinks we've got a CK file. */
getfat_(ck, arch, kertyp, ck_len, (ftnlen)80, (ftnlen)80);
if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. If the input file i"
"s an CK file in transfer format, run TOBIN on the file to co"
"nvert it to binary format.", (ftnlen)205);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. Binary CK files hav"
"e DAF architecture. If you expected the file to be a binary"
" CK file, the problem may be due to the file being an old no"
"n-native file lacking binary file format information. It's a"
"lso possible the file has been corrupted.", (ftnlen)340);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(kertyp, "CK", (ftnlen)80, (ftnlen)2) != 0) {
setmsg_("Input file # has file type #. The file must be a binary CK "
"file to be readable by this routine. If you expected the fil"
"e to be a binary CK file, the problem may be due to the file"
" being an old non-native file lacking binary file format inf"
"ormation. It's also possible the file has been corrupted.", (
ftnlen)296);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", kertyp, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Set a logical flag indicating whether the time systm is SCLK. */
istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3);
/* Check time system. */
if (! istdb) {
if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) {
setmsg_("Time system spec TIMSYS was #; allowed values are SCLK "
"and TDB.", (ftnlen)63);
errch_("#", timsys, (ftnlen)1, timsys_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* If the output time system is TDB, find the clock ID associated */
/* with IDCODE. */
if (istdb) {
ckmeta_(idcode, "SCLK", &clkid, (ftnlen)4);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* Open the file for reading. */
dafopr_(ck, &handle, ck_len);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* We will examine each segment descriptor in the file, and */
/* we'll update our coverage bounds according to the data found */
/* in these descriptors. */
/* If TOL > 0, we'll apply TOL after we've found the coverage */
/* for the zero-tolerance case. */
/* If the time system is TDB, we'll convert the times to TDB */
/* at the end of this routine. */
/* Start a forward search. */
dafbfs_(&handle);
/* Find the next DAF array. */
daffna_(&found);
while(found) {
/* Note: we check FAILED() at the bottom of this loop; this */
/* routine returns if FAILED() returns .TRUE. at that point. */
/* Fetch and unpack the segment descriptor. */
dafgs_(descr);
dafus_(descr, &c__2, &c__6, dc, ic);
/* Let AVOK indicate whether the segment satisfies the */
/* angular velocity restriction. */
avok = ic[3] == 1 || ! (*needav);
if (ic[0] == *idcode && avok) {
/* This segment is for the body of interest. If angular */
/* velocity is needed, this segment has it. */
if (seglvl) {
/* This is a segment-level summary. */
/* Insert the coverage bounds into the coverage window. */
/* Adjust the interval using the tolerance. */
/* Computing MAX */
d__1 = dc[0] - *tol;
dctol[0] = max(d__1,0.);
dctol[1] = dc[1] + *tol;
/* Convert the time to TDB if necessary. */
if (istdb) {
/* Convert the time bounds to TDB before inserting */
/* into the window. */
for (i__ = 1; i__ <= 2; ++i__) {
sct2e_(&clkid, &dctol[(i__1 = i__ - 1) < 2 && 0 <=
i__1 ? i__1 : s_rnge("dctol", i__1, "ckcov_",
(ftnlen)868)], &et);
dctol[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("dctol", i__1, "ckcov_", (ftnlen)869)]
= et;
}
}
if (dctol[0] <= dctol[1]) {
wninsd_(dctol, &dctol[1], cover);
}
} else {
/* We're looking for an interval-level coverage window. */
/* This information must be retrieved in a */
/* data-type-dependent fashion. The coverage routines */
/* we'll call will, if necessary, adjust intervals by TOL */
/* and convert interval times to TDB. */
dtype = ic[2];
segbeg = ic[4];
segend = ic[5];
if (dtype == 1) {
zzckcv01_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 2) {
zzckcv02_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 3) {
zzckcv03_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 4) {
zzckcv04_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 5) {
/* Note: this calling sequence is exceptional; the */
/* segment bounds are an input. */
zzckcv05_(&handle, &segbeg, &segend, &clkid, dc, tol,
timsys, cover, timsys_len);
} else {
setmsg_("Supported CK data types are 1, 2, 3, 4, 5. Dat"
"a type of segment: #. This problem may indicate "
"that you need to update your SPICE Toolkit.", (
ftnlen)138);
errint_("#", &dtype, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
}
daffna_(&found);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* COVER now represents the coverage of the entire file at the */
/* granularity indicated by LEVEL, combined with the coverage */
/* contained in COVER on input. */
/* Release the file. */
dafcls_(&handle);
chkout_("CKCOV", (ftnlen)5);
return 0;
} /* ckcov_ */
/* $Procedure M2WMCH ( Match a word against a META/2 class ) */
logical m2wmch_(char *string, integer *wordb, integer *worde, char *class__,
ftnlen string_len, ftnlen class_len)
{
/* System generated locals */
integer i__1, i__2;
logical ret_val;
/* Builtin functions */
integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern logical zztokns_(char *, char *, ftnlen, ftnlen);
static char base[32];
extern /* Subroutine */ int convrt_3__(doublereal *, char *, char *,
doublereal *, integer *, ftnlen, ftnlen);
static logical temp;
static integer pntr;
static doublereal xout;
extern logical m2day_(char *, ftnlen), m2mon_(char *, ftnlen), m2int_(
char *, ftnlen);
static integer i__, l;
static doublereal v, x, y;
static char error[160];
extern logical eqstr_(char *, char *, ftnlen, ftnlen), m2name_(char *,
ftnlen), m2alph_(char *, ftnlen), m2engl_(char *, ftnlen),
m2epoc_(char *, ftnlen), m2body_(char *, ftnlen), m2time_(char *,
ftnlen), m2year_(char *, ftnlen), m2numb_(char *, ftnlen);
extern /* Subroutine */ int m2save_(char *, integer *, integer *, ftnlen),
m2ntem_(char *, char *, integer *, integer *, doublereal *,
doublereal *, ftnlen, ftnlen), m2tran_(char *, integer *, integer
*, char *, logical *, logical *, ftnlen, ftnlen);
extern logical m2unit_(char *, ftnlen);
static integer nb, ne, lbrace, wb, we, rbrace;
static logical namfnd;
extern logical matchm_(char *, char *, char *, char *, char *, char *,
ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer
*, ftnlen, ftnlen);
static logical tmplog;
static integer status, beg, end;
static logical key;
static doublereal xin;
/* $ Abstract */
/* Determine whether or not the WORD is a member of a META/2 */
/* class. */
/* $ 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 */
/* META/2 a language specification language. */
/* $ Keywords */
/* PARSING */
/* UTILITY */
/* WORD */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* STRING I A string containing words. */
/* WORDB I The beginning of a word. */
/* WORDE I The ending of the same word. */
/* CLASS I A META/2 specification keyword or META-KEY */
/* The function is returned as .TRUE. if WORD is a member of CLASS. */
/* $ Detailed_Input */
/* STRING is any character string. It is expected to be composed */
/* of words. */
/* WORDB is the beginning of some word in STRING. */
/* WORDE is the ending of the same word of STRING. */
/* The word of interest is STRING(WORDB:WORDE). */
/* CLASS is one of the recognized classes of words in META/2 or */
/* a META-KEY. CLASS is expected to be right justified. */
/* This class may be modified by a restriction template. */
/* The possible classes are: */
/* @word @number */
/* @alpha @int */
/* @name @body */
/* @english @unit */
/* @epoc */
/* @day */
/* @time */
/* @month */
/* @year */
/* @calendar */
/* Of these, the following can be modified by a */
/* restriction template. */
/* @word @number */
/* @alpha @int */
/* @name @unit */
/* @english */
/* @month */
/* If CLASS is not one of these words ( possibly qualified */
/* by a restriction template ) it is assumed to be a */
/* specification keyword. */
/* $ Detailed_Output */
/* M2WMCH is returned as .TRUE. if */
/* 1.) CLASS is a META-KEY and STRINB(WORDB:WORDE) falls into */
/* the category specified by this META-KEY */
/* or */
/* 2.) CLASS is determined to be a specification keyword and */
/* STRING(WORDB:WORDE) is equal to this keyword. */
/* Otherwise, it is returned as .FALSE. */
/* $ Error_Handling */
/* None. */
/* $ Input_Files */
/* None. */
/* $ Output_Files */
/* None. */
/* $ Particulars */
/* This is a utility routine for use by META/2. It determines */
/* whether or not a word from a candidate sentence matches */
/* a desired class. */
/* $ Examples */
/* The following table gives a sample of the results that */
/* are returned by this function. */
/* WORD CLASS M2WMCH */
/* --------- --------- ------ */
/* SEPARATION OBJECT F */
/* SEPARATION @english T */
/* SEPARATION @english(T*) F */
/* SEPARATION @english(T*|S*) T */
/* 12:15:15 @number F */
/* 12:15:15 @time T */
/* 44:12:18 @time F */
/* PIG @english T */
/* PIG @int T */
/* 12.182 NUMBER F */
/* 12.182 @number T */
/* 12.182 @int F */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - META/2 Configured Version 3.1.0, 07-NOV-2005 (BVS) */
/* Fixed the way ZZTOKNS is called. */
/* - META/2 Configured Version 3.0.0, 23-MAR-2000 (WLT) */
/* Extended the routine so that it can now check the keyword */
/* @unit and @unit(unitspec). */
/* - META/2 Configured Version 2.0.0, 9-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 9, 1994 */
/* - META/2 Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of META/2 */
/* software as of May 3, 1994 */
/* Version B1.0.0, 31-MAR-1988 (WLT) (IMU) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* There are some obvious things we can handle right now. */
/* Note that if we input a substring that is completely outside */
/* the range (1, LEN(STRING)), then WB will be greater than WE. */
/* Otherwize we will have trimmed the substring to lie within */
/* the bounds of the string. */
wb = max(*wordb,1);
/* Computing MIN */
i__1 = *worde, i__2 = i_len(string, string_len);
we = min(i__1,i__2);
if (wb > we) {
ret_val = FALSE_;
return ret_val;
}
/* Get the first and last characters of CLASS */
/* These are EXPECTED to be the first and last characters of */
/* CLASS. */
beg = 1;
l = i_len(class__, class_len);
lbrace = '[';
rbrace = ']';
/* Next see if there is a name attached to which we will write the */
/* results of successful matches. */
namfnd = FALSE_;
end = l;
/* If the length is not at least 4 or the last character is not */
/* a right brace, there is no name associated with this word. */
if (*(unsigned char *)&class__[l - 1] == rbrace && l >= 4) {
/* Ok. We have a chance at getting a name. Look for */
/* a left brace and if found set the name and class end. */
i__ = 2;
while(i__ < l - 1) {
if (*(unsigned char *)&class__[i__ - 1] == lbrace) {
nb = i__ + 1;
ne = l - 1;
end = i__ - 1;
i__ = l;
namfnd = TRUE_;
}
++i__;
}
}
/* See if CLASS represents a specification keyword or a META-KEY. */
m2tran_(class__, &beg, &end, base, &key, &temp, class_len, (ftnlen)32);
/* If we have a specification keyword, the input WORD must match */
/* exactly. */
if (key) {
ret_val = eqstr_(class__, string + (wb - 1), end, we - (wb - 1));
/* See if we are trying to match a numeric string. */
} else if (s_cmp(base, "@int", (ftnlen)32, (ftnlen)4) == 0 || s_cmp(base,
"@number", (ftnlen)32, (ftnlen)7) == 0) {
if (s_cmp(base, "@int", (ftnlen)32, (ftnlen)4) == 0) {
ret_val = m2int_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@number", (ftnlen)32, (ftnlen)7) == 0) {
ret_val = m2numb_(string + (wb - 1), we - (wb - 1));
}
if (ret_val && temp) {
/* Parse the number and see if it is in bounds. */
m2ntem_(class__, base, &beg, &end, &x, &y, class_len, (ftnlen)32);
nparsd_(string + (wb - 1), &v, error, &pntr, we - (wb - 1), (
ftnlen)160);
ret_val = v <= y && v >= x;
}
if (ret_val && namfnd) {
m2save_(class__ + (nb - 1), &wb, &we, ne - (nb - 1));
}
return ret_val;
} else if (s_cmp(base, "@unit", (ftnlen)32, (ftnlen)5) == 0) {
ret_val = m2unit_(string + (wb - 1), we - (wb - 1));
if (ret_val && temp) {
xin = 1.;
i__1 = beg;
convrt_3__(&xin, string + (wb - 1), class__ + i__1, &xout, &
status, we - (wb - 1), end - 1 - i__1);
ret_val = status == 0;
}
if (ret_val && namfnd) {
m2save_(class__ + (nb - 1), &wb, &we, ne - (nb - 1));
}
return ret_val;
} else if (s_cmp(base, "@name", (ftnlen)32, (ftnlen)5) == 0) {
ret_val = m2name_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@body", (ftnlen)32, (ftnlen)5) == 0) {
ret_val = m2body_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@english", (ftnlen)32, (ftnlen)8) == 0) {
ret_val = m2engl_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@alpha", (ftnlen)32, (ftnlen)6) == 0) {
ret_val = m2alph_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@time", (ftnlen)32, (ftnlen)5) == 0) {
ret_val = m2time_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@epoch", (ftnlen)32, (ftnlen)6) == 0) {
ret_val = m2epoc_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@day", (ftnlen)32, (ftnlen)4) == 0) {
ret_val = m2day_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@year", (ftnlen)32, (ftnlen)5) == 0) {
ret_val = m2year_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@month", (ftnlen)32, (ftnlen)6) == 0) {
ret_val = m2mon_(string + (wb - 1), we - (wb - 1));
} else if (s_cmp(base, "@calendar", (ftnlen)32, (ftnlen)9) == 0) {
tmplog = zztokns_(string + (wb - 1), error, we - (wb - 1), (ftnlen)
160);
ret_val = s_cmp(error, " ", (ftnlen)160, (ftnlen)1) == 0;
} else if (s_cmp(base, "@word", (ftnlen)32, (ftnlen)5) == 0) {
ret_val = TRUE_;
}
if (ret_val && temp) {
i__1 = beg;
ret_val = matchm_(string + (wb - 1), class__ + i__1, "*", "%", "~",
"|", we - (wb - 1), end - 1 - i__1, (ftnlen)1, (ftnlen)1, (
ftnlen)1, (ftnlen)1);
}
if (ret_val && namfnd) {
m2save_(class__ + (nb - 1), &wb, &we, ne - (nb - 1));
}
return ret_val;
} /* m2wmch_ */
/* $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 ZZCKCV02 ( Private --- C-kernel segment coverage, type 02 ) */
/* Subroutine */ int zzckcv02_(integer *handle, integer *arrbeg, integer *
arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *
schedl, ftnlen timsys_len)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer nrec;
doublereal last[100];
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer i__, begat;
doublereal begin;
integer endat;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical istdb;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal first[100];
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal et, finish;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), wninsd_(doublereal *,
doublereal *, doublereal *);
integer arrsiz;
extern logical return_(void);
integer get, got;
/* $ 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. */
/* Determine the "window" of coverage of a type 02 C-kernel segment. */
/* $ 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 */
/* CK */
/* DAF */
/* $ Keywords */
/* CK */
/* UTILITY */
/* PRIVATE */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of a C-kernel open for read access */
/* ARRBEG I Beginning DAF address */
/* ARREND I Ending DAF address */
/* SCLKID I ID of SCLK associated with segment. */
/* TOL I Tolerance in ticks. */
/* TIMSYS I Time system used to represent coverage. */
/* SCHEDL I/O An initialized window/schedule of interval */
/* $ Detailed_Input */
/* HANDLE is the handle of some DAF that is open for reading. */
/* ARRBEG is the beginning address of a type 02 segment */
/* ARREND is the ending address of a type 02 segment. */
/* SCLKID is the ID code of the spacecraft clock associated with */
/* the object for which the segment contains pointing. */
/* This is the ID code used by the SCLK conversion */
/* routines. */
/* TOL is a tolerance value expressed in ticks of the */
/* spacecraft clock associated with the segment. Before */
/* each interval is inserted into the coverage window, */
/* the intervals are expanded by TOL: the left endpoint */
/* of each interval is reduced by TOL and the right */
/* endpoint is increased by TOL. Any intervals that */
/* overlap as a result of the expansion are merged. */
/* The coverage window returned when TOL > 0 indicates */
/* the coverage provided by the file to the CK readers */
/* CKGPAV and CKGP when that value of TOL is passed to */
/* them as an input. */
/* TIMSYS is a string indicating the time system used in the */
/* output coverage window. TIMSYS may have the values: */
/* 'SCLK' Elements of SCHEDL are expressed in */
/* encoded SCLK ("ticks"), where the clock */
/* is associated with the object designated */
/* by IDCODE. */
/* 'TDB' Elements of SCHEDL are expressed as */
/* seconds past J2000 TDB. */
/* TIMSYS must be consistent with the system used for */
/* the contents of SCHEDL on input, if any. */
/* SCHEDL is a schedule (window) of intervals, to which the */
/* intervals of coverage for this segment will be added. */
/* $ Detailed_Output */
/* SCHEDL the input schedule updated to include the intervals */
/* of coverage for this segment. */
/* $ Parameters */
/* None. */
/* $ Files */
/* This routine reads the contents of the file associated with */
/* HANDLE to locate coverage intervals. */
/* $ Exceptions */
/* 1) Routines in the call tree of this routine may signal errors */
/* if insufficient room in SCHEDL exists or other error */
/* conditions relating to file access arise. */
/* 2) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
/* signaled. */
/* 3) If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */
/* is signaled. */
/* 4) If a time conversion error occurs, the error will be */
/* diagnosed by a routine in the call tree of this routine */
/* $ Particulars */
/* This is a utility routine that determines the intervals */
/* of coverage for a type 02 C-kernel segment. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-JAN-2005 (NJB) (FST) (WLT) (BVS) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZCKCV02", (ftnlen)8);
}
/* Check tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative; actual value was #.", (
ftnlen)51);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("ZZCKCV02", (ftnlen)8);
return 0;
}
/* Set a logical flag indicating whether the time systm is SCLK. */
istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3);
/* Check time system. */
if (! istdb) {
if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) {
setmsg_("Time system spec TIMSYS was #; allowed values are SCLK "
"and TDB.", (ftnlen)63);
errch_("#", timsys, (ftnlen)1, timsys_len);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("ZZCKCV02", (ftnlen)8);
return 0;
}
}
/* Determine the size of the array and the number of records */
/* in it. */
arrsiz = *arrend - *arrbeg + 1;
d__1 = ((doublereal) arrsiz * 100. + 1.) / 1001.;
nrec = i_dnnt(&d__1);
/* The variable GOT tells us how many time endpoints we've */
/* gotten so far. */
got = 0;
while(got < nrec) {
/* Computing MIN */
i__1 = 100, i__2 = nrec - got;
get = min(i__1,i__2);
begat = *arrbeg + (nrec << 3) + got;
endat = *arrbeg + (nrec << 3) + nrec + got;
/* Retrieve the list next list of windows. */
i__1 = begat + get - 1;
dafgda_(handle, &begat, &i__1, first);
i__1 = endat + get - 1;
dafgda_(handle, &endat, &i__1, last);
/* Insert the coverage intervals into the schedule. */
i__1 = get;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Adjust the interval using the tolerance. */
begin = first[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge(
"first", i__2, "zzckcv02_", (ftnlen)295)];
finish = last[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge(
"last", i__2, "zzckcv02_", (ftnlen)296)];
if (*tol > 0.) {
/* Computing MAX */
d__1 = begin - *tol;
begin = max(d__1,0.);
finish += *tol;
}
/* Convert the time to TDB if necessary. */
if (istdb) {
sct2e_(sclkid, &begin, &et);
begin = et;
sct2e_(sclkid, &finish, &et);
finish = et;
}
wninsd_(&begin, &finish, schedl);
}
got += get;
}
chkout_("ZZCKCV02", (ftnlen)8);
return 0;
} /* zzckcv02_ */
