/* $Procedure CKW04A ( CK type 04: Add data to a segment ) */
/* Subroutine */ int ckw04a_(integer *handle, integer *npkts, integer *pktsiz,
doublereal *pktdat, doublereal *sclkdp)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer k;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer dispm, kk;
extern /* Subroutine */ int errhan_(char *, integer *, ftnlen);
integer displm;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer numcft[7];
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int sgwvpk_(integer *, integer *, integer *,
doublereal *, integer *, doublereal *), zzck4i2d_(integer *,
integer *, doublereal *, doublereal *);
/* $ Abstract */
/* Add data to a type 4 CK segment currently being written to */
/* the file associated with HANDLE. See also CKW04B and CKW04E. */
/* $ 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.REQ */
/* DAF.REQ */
/* GS.REQ */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Abstract */
/* Declarations of the CK data type specific and general CK low */
/* level routine 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. */
/* $ Required_Reading */
/* CK.REQ */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* 1) If new CK types are added, the size of the record passed */
/* between CKRxx and CKExx must be registered as separate */
/* parameter. If this size will be greater than current value */
/* of the CKMRSZ parameter (which specifies the maximum record */
/* size for the record buffer used inside CKPFS) then it should */
/* be assigned to CKMRSZ as a new value. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* CK Required Reading. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
/* Updated to support CK type 5. */
/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
/* -& */
/* Number of quaternion components and number of quaternion and */
/* angular rate components together. */
/* CK Type 1 parameters: */
/* CK1DTP CK data type 1 ID; */
/* CK1RSZ maximum size of a record passed between CKR01 */
/* and CKE01. */
/* CK Type 2 parameters: */
/* CK2DTP CK data type 2 ID; */
/* CK2RSZ maximum size of a record passed between CKR02 */
/* and CKE02. */
/* CK Type 3 parameters: */
/* CK3DTP CK data type 3 ID; */
/* CK3RSZ maximum size of a record passed between CKR03 */
/* and CKE03. */
/* CK Type 4 parameters: */
/* CK4DTP CK data type 4 ID; */
/* CK4PCD parameter defining integer to DP packing schema that */
/* is applied when seven number integer array containing */
/* polynomial degrees for quaternion and angular rate */
/* components packed into a single DP number stored in */
/* actual CK records in a file; the value of must not be */
/* changed or compatibility with existing type 4 CK files */
/* will be lost. */
/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
/* records; the value of this parameter must never exceed */
/* value of the CK4PCD; */
/* CK4SFT number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 4 */
/* CK record that passed between routines CKR04 and CKE04; */
/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
/* and CKE04; CK4RSZ is computed as follows: */
/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
/* CK Type 5 parameters: */
/* CK5DTP CK data type 5 ID; */
/* CK5MXD maximum polynomial degree allowed in type 5 */
/* records. */
/* CK5MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 5 */
/* CK record that passed between routines CKR05 and CKE05; */
/* CK5MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck05.inc */
/* for a description of the subtypes. */
/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
/* and CKE05; CK5RSZ is computed as follows: */
/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
/* Maximum record size that can be handled by CKPFS. This value */
/* must be set to the maximum of all CKxRSZ parameters (currently */
/* CK4RSZ.) */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* HANDLE I The handle of an DAF file opened for writing. */
/* NPKTS I Number of data packets to write to a segment. */
/* PKTSIZ I The numbers of values in the data packets */
/* PKTDAT I The data packets. */
/* SCLKDP I The SCLK times associated with the data packets. */
/* $ Detailed_Input */
/* HANDLE is the file handle of a CK file in which a CK type 4 */
/* segment is currently being written. */
/* NPKTS is the number of data packets to write to a segment. */
/* PKTSIZ is the number of values in all data packets. */
/* PKTDAT is the data packets. The data packets in this array */
/* must be organized as described in the $ Particulars */
/* section of the header. */
/* SCLKDP contains the initial SCLK times corresponding to the */
/* Chebyshev coefficients in PKTSIZ. The I'th time is */
/* start time of the I'th packet coverage interval. */
/* The times must form a strictly increasing sequence. */
/* $ Detailed_Output */
/* None. Data is stored in a segment in the DAF file */
/* associated with HANDLE. */
/* $ Parameters */
/* See 'ckparam.inc'. */
/* $ Exceptions */
/* 1) If the number of coefficient sets and epochs is not positive, */
/* the error SPICE(INVALIDARGUMENT) will be signalled. */
/* 2) If size of any input packet is greater that maximum allowed */
/* type 4 CK record size minus one, the error */
/* SPICE(INVALIDARGUMENT) will be signalled. */
/* $ Files */
/* See HANDLE in the $ Detailed_Input section. */
/* $ Particulars */
/* This routine adds data to a type 4 CK segment that is currently */
/* being written to the associated with HANDLE. The segment must */
/* have been started by a call to the routine CKW04B, the routine */
/* which begins a type 4 CK segment. */
/* This routine is one of a set of three routines for creating and */
/* adding data to type 4 CK segments. These routines are: */
/* CKW04B: Begin a type 4 CK segment. This routine must be */
/* called before any data may be added to a type 4 */
/* segment. */
/* CKW04A: Add data to a type 4 CK segment. This routine may be */
/* called any number of times after a call to CKW04B to */
/* add type 4 records to the CK segment that was */
/* started. */
/* CKW04E: End a type 4 CK segment. This routine is called to */
/* make the type 4 segment a permanent addition to the */
/* DAF file. Once this routine is called, no further type */
/* 4 records may be added to the segment. A new segment */
/* must be started. */
/* A type 4 CK segment consists of coefficient sets for variable */
/* order Chebyshev polynomials over consecutive time intervals of a */
/* variable length. The gaps between intervals are allowed. The */
/* Chebyshev polynomials represent individual SPICE-style quaternion */
/* components q0, q1, q2 and q3 and individual angular velocities */
/* AV1, AV2 and AV3 if they are included with the data. */
/* See the discussion of quaternion styles below. */
/* The pointing data supplied to the type 4 CK writer (CKW04A) */
/* is packed into an array as a sequence of records, */
/* ---------------------------------------------------- */
/* | Record 1 | Record 2 | .. | Record N-1 | Record N | */
/* ---------------------------------------------------- */
/* with each record in data packets has the following format. */
/* ---------------------------------------------------- */
/* | The midpoint of the approximation interval | */
/* ---------------------------------------------------- */
/* | The radius of the approximation interval | */
/* ---------------------------------------------------- */
/* | Number of coefficients for q0 | */
/* ---------------------------------------------------- */
/* | Number of coefficients for q1 | */
/* ---------------------------------------------------- */
/* | Number of coefficients for q2 | */
/* ---------------------------------------------------- */
/* | Number of coefficients for q3 | */
/* ---------------------------------------------------- */
/* | Number of coefficients for AV1 | */
/* ---------------------------------------------------- */
/* | Number of coefficients for AV2 | */
/* ---------------------------------------------------- */
/* | Number of coefficients for AV3 | */
/* ---------------------------------------------------- */
/* | q0 Cheby coefficients | */
/* ---------------------------------------------------- */
/* | q1 Cheby coefficients | */
/* ---------------------------------------------------- */
/* | q2 Cheby coefficients | */
/* ---------------------------------------------------- */
/* | q3 Cheby coefficients | */
/* ---------------------------------------------------- */
/* | AV1 Cheby coefficients (optional) | */
/* ---------------------------------------------------- */
/* | AV2 Cheby coefficients (optional) | */
/* ---------------------------------------------------- */
/* | AV3 Cheby coefficients (optional) | */
/* ---------------------------------------------------- */
/* Quaternion Styles */
/* ----------------- */
/* There are different "styles" of quaternions used in */
/* science and engineering applications. Quaternion styles */
/* are characterized by */
/* - The order of quaternion elements */
/* - The quaternion multiplication formula */
/* - The convention for associating quaternions */
/* with rotation matrices */
/* Two of the commonly used styles are */
/* - "SPICE" */
/* > Invented by Sir William Rowan Hamilton */
/* > Frequently used in mathematics and physics textbooks */
/* - "Engineering" */
/* > Widely used in aerospace engineering applications */
/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */
/* Quaternions of any other style must be converted to SPICE */
/* quaternions before they are passed to SPICELIB routines. */
/* Relationship between SPICE and Engineering Quaternions */
/* ------------------------------------------------------ */
/* Let M be a rotation matrix such that for any vector V, */
/* M*V */
/* is the result of rotating V by theta radians in the */
/* counterclockwise direction about unit rotation axis vector A. */
/* Then the SPICE quaternions representing M are */
/* (+/-) ( cos(theta/2), */
/* sin(theta/2) A(1), */
/* sin(theta/2) A(2), */
/* sin(theta/2) A(3) ) */
/* while the engineering quaternions representing M are */
/* (+/-) ( -sin(theta/2) A(1), */
/* -sin(theta/2) A(2), */
/* -sin(theta/2) A(3), */
/* cos(theta/2) ) */
/* For both styles of quaternions, if a quaternion q represents */
/* a rotation matrix M, then -q represents M as well. */
/* Given an engineering quaternion */
/* QENG = ( q0, q1, q2, q3 ) */
/* the equivalent SPICE quaternion is */
/* QSPICE = ( q3, -q0, -q1, -q2 ) */
/* Associating SPICE Quaternions with Rotation Matrices */
/* ---------------------------------------------------- */
/* Let FROM and TO be two right-handed reference frames, for */
/* example, an inertial frame and a spacecraft-fixed frame. Let the */
/* symbols */
/* V , V */
/* FROM TO */
/* denote, respectively, an arbitrary vector expressed relative to */
/* the FROM and TO frames. Let M denote the transformation matrix */
/* that transforms vectors from frame FROM to frame TO; then */
/* V = M * V */
/* TO FROM */
/* where the expression on the right hand side represents left */
/* multiplication of the vector by the matrix. */
/* Then if the unit-length SPICE quaternion q represents M, where */
/* q = (q0, q1, q2, q3) */
/* the elements of M are derived from the elements of q as follows: */
/* +- -+ */
/* | 2 2 | */
/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */
/* | | */
/* | | */
/* | 2 2 | */
/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */
/* | | */
/* | | */
/* | 2 2 | */
/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */
/* | | */
/* +- -+ */
/* Note that substituting the elements of -q for those of q in the */
/* right hand side leaves each element of M unchanged; this shows */
/* that if a quaternion q represents a matrix M, then so does the */
/* quaternion -q. */
/* To map the rotation matrix M to a unit quaternion, we start by */
/* decomposing the rotation matrix as a sum of symmetric */
/* and skew-symmetric parts: */
/* 2 */
/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */
/* symmetric skew-symmetric */
/* OMEGA is a skew-symmetric matrix of the form */
/* +- -+ */
/* | 0 -n3 n2 | */
/* | | */
/* OMEGA = | n3 0 -n1 | */
/* | | */
/* | -n2 n1 0 | */
/* +- -+ */
/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */
/* of M and theta is M's rotation angle. Note that N and theta */
/* are not unique. */
/* Let */
/* C = cos(theta/2) */
/* S = sin(theta/2) */
/* Then the unit quaternions Q corresponding to M are */
/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */
/* The mappings between quaternions and the corresponding rotations */
/* are carried out by the SPICELIB routines */
/* Q2M {quaternion to matrix} */
/* M2Q {matrix to quaternion} */
/* M2Q always returns a quaternion with scalar part greater than */
/* or equal to zero. */
/* SPICE Quaternion Multiplication Formula */
/* --------------------------------------- */
/* Given a SPICE quaternion */
/* Q = ( q0, q1, q2, q3 ) */
/* corresponding to rotation axis A and angle theta as above, we can */
/* represent Q using "scalar + vector" notation as follows: */
/* s = q0 = cos(theta/2) */
/* v = ( q1, q2, q3 ) = sin(theta/2) * A */
/* Q = s + v */
/* Let Q1 and Q2 be SPICE quaternions with respective scalar */
/* and vector parts s1, s2 and v1, v2: */
/* Q1 = s1 + v1 */
/* Q2 = s2 + v2 */
/* We represent the dot product of v1 and v2 by */
/* <v1, v2> */
/* and the cross product of v1 and v2 by */
/* v1 x v2 */
/* Then the SPICE quaternion product is */
/* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */
/* If Q1 and Q2 represent the rotation matrices M1 and M2 */
/* respectively, then the quaternion product */
/* Q1*Q2 */
/* represents the matrix product */
/* M1*M2 */
/* $ Examples */
/* Assume that we have: */
/* HANDLE is the handle of an CK file opened with write */
/* access. */
/* SEGID is a character string of no more than 40 characters */
/* which provides a pedigree for the data in the CK */
/* segment we will create. */
/* INST is the SPICE ID code for the instrument whose */
/* pointing data is to be placed into the file. */
/* AVFLAG angular rates flag. */
/* REFFRM is the name of the SPICE reference frame for the */
/* pointing data. */
/* BEGTIM is the starting encoded SCLK time for which the */
/* segment is valid. */
/* ENDTIM is the ending encoded SCLK time for which the segment */
/* is valid. */
/* N is the number of type 4 records that we want to */
/* put into a segment in an CK file. */
/* NPKTS is integer array which contains the lengths of */
/* variable size data packets */
/* RECRDS contains N type 4 records packaged for the CK */
/* file. */
/* SCSTRT contains the initial encoded SC time for each of */
/* the records contained in RECRDS, where */
/* SCSTRT(I) < SCSTRT(I+1), I = 1, N-1 */
/* SCSTRT(1) <= FIRST, SCSTRT(N) < LAST */
/* Then the following code fragment demonstrates how to create */
/* a type 4 CK segment if all of the data for the segment is */
/* available at one time. */
/* C */
/* C Begin the segment. */
/* C */
/* CALL CKW04B ( HANDLE, BEGTIM, INST, REF, AVFLAG, SEGID ) */
/* C */
/* C Add the data to the segment all at once. */
/* C */
/* CALL CKW04A ( HANDLE, N, NPKTS, RECRDS, SCSTRT ) */
/* C */
/* C End the segment, making the segment a permanent */
/* C addition to the CK file. */
/* C */
/* CALL CKW04E ( HANDLE, ENDTIM ) */
/* $ Restrictions */
/* 1) The type 4 CK segment to which the data is added must have */
/* been started by the routine CKW04B, the routine which begins */
/* a type 4 CK segment. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* Y.K. Zaiko (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 26-FEB-2008 (NJB) */
/* Updated header; added information about SPICE */
/* quaternion conventions. */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Removed DAFHLU call; replaced ERRFNM call with ERRHAN. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */
/* -& */
/* $ Index_Entries */
/* add data to a type_4 ck segment */
/* -& */
/* Spicelib functions. */
/* Local parameters. */
/* The number of elements by which coefficients in each packet */
/* have to be shifted to the left after numbers of coefficients */
/* were packed into a single integer. */
/* Local Variables. */
/* Standard SPICELIB error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKW04A", (ftnlen)6);
}
/* First, check if the number of coefficient sets and epochs */
/* is positive and whether each packet is smaller than the */
/* maximum size of a record that CKPFS can handle. */
i__1 = *npkts;
for (k = 1; k <= i__1; ++k) {
if (pktsiz[k - 1] <= 0) {
setmsg_("The number of coefficient sets and epochs in the # data"
" packet (record) to be added to the DAF segment in the f"
"ile '#' was not positive. Its value was: #.", (ftnlen)154)
;
errint_("#", &k, (ftnlen)1);
errhan_("#", handle, (ftnlen)1);
errint_("#", &pktsiz[k - 1], (ftnlen)1);
sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22);
chkout_("CKW04A", (ftnlen)6);
return 0;
}
/* We do .GE. comparison because a type 4 CK record passed */
/* inside CKPFS will have one more element -- time at which */
/* the pointing will be evaluated. */
if (pktsiz[k - 1] >= 143) {
setmsg_("The total size of the # data packet (record) to be adde"
"d to the DAF segment in the file '#' is greater than the"
" maximum allowed type 4 record size #. Its value was: #.",
(ftnlen)167);
errint_("#", &k, (ftnlen)1);
errhan_("#", handle, (ftnlen)1);
errint_("#", &c__142, (ftnlen)1);
errint_("#", &pktsiz[k - 1], (ftnlen)1);
sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22);
chkout_("CKW04A", (ftnlen)6);
return 0;
}
}
displm = 0;
dispm = 0;
/* The cycle below encodes groups of numbers of coefficients in */
/* data packets to single double precision numbers and shift */
/* data in packets to the left to decrease the data packet */
/* lengths. */
i__1 = *npkts;
for (k = 1; k <= i__1; ++k) {
/* Encode integer numbers of coefficients for each component */
/* to single double precision variable */
for (kk = 1; kk <= 7; ++kk) {
numcft[(i__2 = kk - 1) < 7 && 0 <= i__2 ? i__2 : s_rnge("numcft",
i__2, "ckw04a_", (ftnlen)577)] = (integer) pktdat[kk + 2
+ displm - 1];
}
zzck4i2d_(numcft, &c__7, &c_b20, &pktdat[dispm + 2]);
/* Shift coefficients sets to the left to overwrite numbers of */
/* packets */
i__2 = pktsiz[k - 1];
for (kk = 4; kk <= i__2; ++kk) {
pktdat[kk + dispm - 1] = pktdat[kk + 6 + displm - 1];
}
/* Shift middle value and radii of interval */
pktdat[dispm] = pktdat[displm];
pktdat[dispm + 1] = pktdat[displm + 1];
displm += pktsiz[k - 1];
/* Length of each data packet became less for 6 elements because */
/* of encoding of 7 double precision numbers, which are the */
/* numbers of polynomial coefficients, to one double precision */
/* number */
pktsiz[k - 1] += -6;
dispm += pktsiz[k - 1];
}
/* Add the data. */
sgwvpk_(handle, npkts, pktsiz, pktdat, npkts, sclkdp);
/* No need to check FAILED() here, since all we do is check out. */
/* Leave it up to the caller. */
chkout_("CKW04A", (ftnlen)6);
return 0;
} /* ckw04a_ */
/* $Procedure INSRTC ( Insert an item into a character set ) */
/* Subroutine */ int insrtc_(char *item, char *a, ftnlen item_len, ftnlen
a_len)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer card, slen, last, size, i__;
extern integer cardc_(char *, ftnlen);
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sizec_(char *, ftnlen);
logical in;
extern /* Subroutine */ int scardc_(integer *, char *, ftnlen);
extern integer lstlec_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Insert an item into a character set. */
/* $ 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 */
/* SETS */
/* $ Keywords */
/* CELLS, SETS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ITEM I Item to be inserted. */
/* A I/O Insertion set. */
/* $ Detailed_Input */
/* ITEM is an item which is to be inserted into the */
/* specified set. ITEM may or may not already be an */
/* element of the set. If ITEM is longer than the */
/* length SLEN of the elements of A, only the substring */
/* consisting of the first SLEN characters of ITEM will */
/* be inserted into the set; any trailing non-blank */
/* characters in ITEM are ignored. */
/* A is a set. */
/* On input, A may or may not contain the input item */
/* as an element. */
/* $ Detailed_Output */
/* A on output contains the union of the input set and */
/* the singleton set containing the input item, unless */
/* there was not sufficient room in the set for the */
/* item to be included, in which case the set is not */
/* changed and an error is signaled. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the insertion of the item into the set causes an excess */
/* of elements, the error SPICE(SETEXCESS) is signaled. */
/* 2) If the item to be inserted has greater length than the string */
/* length of the elements of the set, the item will be truncated */
/* on the right when it is inserted. The insertion point of */
/* the element will be determined by the comparison of the */
/* truncated item to members of the set. If, after truncation, */
/* the item to be inserted matches an element already present */
/* in the set, no insertion occurs. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* In the following example, the element 'PLUTO' is removed from */
/* the character set PLANETS and inserted into the character set */
/* ASTEROIDS. */
/* CALL REMOVC ( 'PLUTO', PLANETS ) */
/* CALL INSRTC ( 'PLUTO', ASTEROIDS ) */
/* If 'PLUTO' is not an element of PLANETS, then the contents of */
/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */
/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */
/* Because inserting an element into a set can increase the */
/* cardinality of the set, an error may occur in the insertion */
/* routines. */
/* $ Literature_References */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* C.A. Curzon (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */
/* Bug fix: when the item to be inserted would, after */
/* truncation to the set's string length, match an item */
/* already in the set, no insertion is performed. Previously */
/* the truncated string was inserted, corrupting the set. */
/* Long error message was updated to include size of */
/* set into which insertion was attempted. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* insert an item into a character set */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */
/* Bug fix: when the item to be inserted would, after */
/* truncation to the set's string length, match an item */
/* already in the set, no insertion is performed. Previously */
/* the truncated string was inserted, corrupting the set. */
/* Long error message was updated to include size of */
/* set into which insertion was attempted. */
/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */
/* Calling protocol of EXCESS changed. Call to SETMSG removed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Set up the error processing. */
if (return_()) {
return 0;
}
chkin_("INSRTC", (ftnlen)6);
/* What are the size and cardinality of the set? */
size = sizec_(a, a_len);
card = cardc_(a, a_len);
/* When we insert an item into the set, any trailing characters */
/* that don't fit are truncated. So in deciding where to insert */
/* the item, we ignore any characters that won't remain after */
/* insertion. */
/* We're going to consider only the initial substring of ITEM */
/* whose length doesn't exceed the string length of the set's */
/* members. */
/* Computing MIN */
i__1 = i_len(item, item_len), i__2 = i_len(a + a_len * 6, a_len);
slen = min(i__1,i__2);
/* Find the last element of the set which would come before the */
/* input item. This will be the item itself, if it is already an */
/* element of the set. */
last = lstlec_(item, &card, a + a_len * 6, slen, a_len);
/* Is the item already in the set? If not, it needs to be inserted. */
if (last > 0) {
in = s_cmp(a + (last + 5) * a_len, item, a_len, slen) == 0;
} else {
in = FALSE_;
}
if (! in) {
/* If there is room in the set for the new element, then move */
/* the succeeding elements back to make room. And update the */
/* cardinality for future reference. */
if (card < size) {
i__1 = last + 1;
for (i__ = card; i__ >= i__1; --i__) {
s_copy(a + (i__ + 6) * a_len, a + (i__ + 5) * a_len, a_len,
a_len);
}
s_copy(a + (last + 6) * a_len, item, a_len, slen);
i__1 = card + 1;
scardc_(&i__1, a, a_len);
} else {
setmsg_("An element could not be inserted into the set due to la"
"ck of space; set size is #.", (ftnlen)82);
errint_("#", &size, (ftnlen)1);
sigerr_("SPICE(SETEXCESS)", (ftnlen)16);
}
}
chkout_("INSRTC", (ftnlen)6);
return 0;
} /* insrtc_ */
/* $Procedure ZZDYNVAI ( Fetch array, integer frame kernel variable ) */
/* Subroutine */ int zzdynvai_(char *frname, integer *frcode, char *item,
integer *maxn, integer *n, integer *values, ftnlen frname_len, ftnlen
item_len)
{
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen,
ftnlen, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
char dtype[1];
extern integer rtrim_(char *, ftnlen);
extern logical failed_(void);
integer codeln, nameln;
char kvname[32], cdestr[32];
integer itemln, reqnam;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
integer reqnum;
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_(
char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen), gipool_(char *, integer *, integer *, integer *,
integer *, logical *, ftnlen);
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Look up array-valued integer frame kernel variable. The frame */
/* name or frame ID may be used as part of the variable's name. */
/* If the kernel variable is not present, or if the variable */
/* has the wrong data type, signal an error. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* FRAMES */
/* KERNEL */
/* PRIVATE */
/* UTILITY */
/* $ Declarations */
/* $ Abstract */
/* Include file zzdyn.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters defined below are used by the SPICELIB dynamic */
/* frame subsystem. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* This file declares parameters required by the dynamic */
/* frame routines of the SPICELIB frame subsystem. */
/* $ Restrictions */
/* The parameter BDNMLN is this routine must be kept */
/* consistent with the parameter MAXL defined in */
/* zzbodtrn.inc */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */
/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */
/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */
/* -& */
/* String length parameters */
/* ======================== */
/* Kernel variable name length. This parameter must be */
/* kept consistent with the parameter MAXLEN used in the */
/* POOL umbrella routine. */
/* Length of a character kernel pool datum. This parameter must be */
/* kept consistent with the parameter MAXCHR used in the POOL */
/* umbrella routine. */
/* Reference frame name length. This parameter must be */
/* kept consistent with the parameter WDSIZE used in the */
/* FRAMEX umbrella routine. */
/* Body name length. This parameter is used to provide a level */
/* of indirection so the dynamic frame source code doesn't */
/* have to change if the name of this SPICELIB-scope parameter */
/* is changed. The value MAXL used here is defined in the */
/* INCLUDE file */
/* zzbodtrn.inc */
/* Current value of MAXL = 36 */
/* Numeric parameters */
/* =================================== */
/* The parameter MAXCOF is the maximum number of polynomial */
/* coefficients that may be used to define an Euler angle */
/* in an "Euler frame" definition */
/* The parameter LBSEP is the default angular separation limit for */
/* the vectors defining a two-vector frame. The angular separation */
/* of the vectors must differ from Pi and 0 by at least this amount. */
/* The parameter QEXP is used to determine the width of */
/* the interval DELTA used for the discrete differentiation */
/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */
/* recursive analogs. This parameter is appropriate for */
/* 64-bit IEEE double precision numbers; when SPICELIB */
/* is hosted on platforms where longer mantissas are supported, */
/* this parameter (and hence this INCLUDE file) will become */
/* platform-dependent. */
/* The choice of QEXP is based on heuristics. It's believed to */
/* be a reasonable choice obtainable without expensive computation. */
/* QEXP is the largest power of 2 such that */
/* 1.D0 + 2**QEXP = 1.D0 */
/* Given an epoch T0 at which a discrete derivative is to be */
/* computed, this choice provides a value of DELTA that usually */
/* contributes no round-off error in the computation of the function */
/* evaluation epochs */
/* T0 +/- DELTA */
/* while providing the largest value of DELTA having this form that */
/* causes the order of the error term O(DELTA**2) in the quadratric */
/* function approximation to round to zero. Note that the error */
/* itself will normally be small but doesn't necessarily round to */
/* zero. Note also that the small function approximation error */
/* is not a measurement of the error in the discrete derivative */
/* itself. */
/* For ET values T0 > 2**27 seconds past J2000, the value of */
/* DELTA will be set to */
/* T0 * 2**QEXP */
/* For smaller values of T0, DELTA should be set to 1.D0. */
/* Frame kernel parameters */
/* ======================= */
/* Parameters relating to kernel variable names (keywords) start */
/* with the letters */
/* KW */
/* Parameters relating to kernel variable values start with the */
/* letters */
/* KV */
/* Generic parameters */
/* --------------------------------- */
/* Token used to build the base frame keyword: */
/* Frame definition style parameters */
/* --------------------------------- */
/* Token used to build the frame definition style keyword: */
/* Token indicating parameterized dynamic frame. */
/* Freeze epoch parameters */
/* --------------------------------- */
/* Token used to build the freeze epoch keyword: */
/* Rotation state parameters */
/* --------------------------------- */
/* Token used to build the rotation state keyword: */
/* Token indicating rotating rotation state: */
/* Token indicating inertial rotation state: */
/* Frame family parameters */
/* --------------------------------- */
/* Token used to build the frame family keyword: */
/* Token indicating mean equator and equinox of date frame. */
/* Token indicating mean ecliptic and equinox of date frame. */
/* Token indicating true equator and equinox of date frame. */
/* Token indicating two-vector frame. */
/* Token indicating Euler frame. */
/* "Of date" frame family parameters */
/* --------------------------------- */
/* Token used to build the precession model keyword: */
/* Token used to build the nutation model keyword: */
/* Token used to build the obliquity model keyword: */
/* Mathematical models used to define "of date" frames will */
/* likely accrue over time. We will simply assign them */
/* numbers. */
/* Token indicating the Lieske earth precession model: */
/* Token indicating the IAU 1980 earth nutation model: */
/* Token indicating the IAU 1980 earth mean obliqity of */
/* date model. Note the name matches that of the preceding */
/* nutation model---this is intentional. The keyword */
/* used in the kernel variable definition indicates what */
/* kind of model is being defined. */
/* Two-vector frame family parameters */
/* --------------------------------- */
/* Token used to build the vector axis keyword: */
/* Tokens indicating axis values: */
/* Prefixes used for primary and secondary vector definition */
/* keywords: */
/* Token used to build the vector definition keyword: */
/* Token indicating observer-target position vector: */
/* Token indicating observer-target velocity vector: */
/* Token indicating observer-target near point vector: */
/* Token indicating constant vector: */
/* Token used to build the vector observer keyword: */
/* Token used to build the vector target keyword: */
/* Token used to build the vector frame keyword: */
/* Token used to build the vector aberration correction keyword: */
/* Token used to build the constant vector specification keyword: */
/* Token indicating rectangular coordinates used to */
/* specify constant vector: */
/* Token indicating latitudinal coordinates used to */
/* specify constant vector: */
/* Token indicating RA/DEC coordinates used to */
/* specify constant vector: */
/* Token used to build the cartesian vector literal keyword: */
/* Token used to build the constant vector latitude keyword: */
/* Token used to build the constant vector longitude keyword: */
/* Token used to build the constant vector right ascension keyword: */
/* Token used to build the constant vector declination keyword: */
/* Token used to build the angular separation tolerance keyword: */
/* See the section "Physical unit parameters" below for additional */
/* parameters applicable to two-vector frames. */
/* Euler frame family parameters */
/* --------------------------------- */
/* Token used to build the epoch keyword: */
/* Token used to build the Euler axis sequence keyword: */
/* Tokens used to build the Euler angle coefficients keywords: */
/* See the section "Physical unit parameters" below for additional */
/* parameters applicable to Euler frames. */
/* Physical unit parameters */
/* --------------------------------- */
/* Token used to build the units keyword: */
/* Token indicating radians: */
/* Token indicating degrees: */
/* End of include file zzdyn.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ------------------------------------------------- */
/* FRNAME I Frame name. */
/* FRCODE I Frame ID code. */
/* ITEM I Item associated with frame definition. */
/* MAXN I Maximum number of values to return. */
/* N O Number of returned values. */
/* VALUES O Output kernel variable. */
/* $ Detailed_Input */
/* FRNAME is the name of the reference frame with which */
/* the requested variable is associated. */
/* FRCODE is the frame ID code of the reference frame with */
/* which the requested variable is associated. */
/* ITEM is a string identifying the specific datum */
/* to be fetched. The kernel variable name */
/* has the form */
/* FRAME_<frame ID code>_<ITEM> */
/* or */
/* FRAME_<frame name>_<ITEM> */
/* The former of the two names takes precedence: */
/* this routine will look for a numeric variable */
/* of that name first. */
/* $ Detailed_Output */
/* N is the number of values returned in the array */
/* VALUES. */
/* VALUES are the values associated with the requested */
/* array-valued, integer kernel variable. The kernel */
/* variable name of the form */
/* FRAME_<frame ID code>_<ITEM> */
/* will be looked up first; if this variable */
/* is found and has numeric type, the associated */
/* values will be returned. If this variable is */
/* not found, the variable */
/* FRAME_<frame name>_<ITEM> */
/* will be looked up. If a numeric variable */
/* having that name is found, the associated */
/* values will be returned. */
/* $ Parameters */
/* See zzdyn.inc. */
/* $ Exceptions */
/* 1) If neither the frame-ID-based or frame-name-based form of the */
/* requested kernel variable name matches a kernel variable */
/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */
/* will be signaled. */
/* 2) If either the frame-ID-based or frame-name-based form of the */
/* requested kernel variable name has length greater than KVNMLN, */
/* the excessively long name will not be searched for. A search */
/* will still be done using the alternative form of the name if */
/* that form has length less than or equal to KVNMLN. */
/* 3) If both the frame-ID-based and frame-name-based forms of the */
/* requested kernel variable name have length greater than KVNMLN, */
/* the error SPICE(VARNAMETOOLONG) will be signaled. */
/* 4) If kernel variable matching one form of the requested kernel */
/* variable names is found, but that variable has character data */
/* type, the error SPICE(BADVARIABLETYPE) will be signaled. */
/* 5) If kernel variable matching one form of the requested kernel */
/* variable names is found, but that variable has more than MAXN */
/* associated values, the error SPICE(BADVARIABLESIZE) will be */
/* signaled. */
/* 6) If a name match is found for a numeric kernel variable, */
/* but that variable has a value that cannot be rounded to an */
/* integer representable on the host platform, an error will */
/* be signaled by a routine in the call tree of this routine. */
/* $ Files */
/* 1) Kernel variables fetched by this routine are normally */
/* introduced into the kernel pool by loading one or more */
/* frame kernels. See the Frames Required Reading for */
/* details. */
/* $ Particulars */
/* This routine centralizes logic for kernel variable lookups that */
/* must be performed by the SPICELIB frame subsystem. Part of the */
/* functionality of this routine consists of handling error */
/* conditions such as the unavailability of required kernel */
/* variables; hence no "found" flag is returned to the caller. */
/* As indicated above, the requested kernel variable may have a name */
/* of the form */
/* FRAME_<frame ID code>_<ITEM> */
/* or */
/* FRAME_<frame name>_<ITEM> */
/* Because most frame definition keywords have the first form, this */
/* routine looks for a name of that form first. */
/* Note that although this routine considers the two forms of the */
/* names to be synonymous, from the point of view of the kernel pool */
/* data structure, these names are distinct. Hence kernel variables */
/* having names of both forms, but having possibly different */
/* attributes, can be simultaneously present in the kernel pool. */
/* Intentional use of this kernel pool feature is discouraged. */
/* $ Examples */
/* See ZZDYNFRM. */
/* $ Restrictions */
/* 1) This is a SPICE private routine; the routine is subject */
/* to change without notice. User applications should not */
/* call this routine. */
/* 2) A scalar-valued kernel variable matching the "ID code form" */
/* of the requested kernel variable name could potentially */
/* mask an array-valued kernel variable matching the "name */
/* form" of the requested name. This problem can be prevented */
/* by sensible frame kernel design. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* TEMPLN is the length of the keyword template, minus */
/* the sum of the lengths of the two substitution markers ('#'). */
/* Local Variables */
/* Standard SPICE error handling */
if (return_()) {
return 0;
}
chkin_("ZZDYNVAI", (ftnlen)8);
/* Prepare to check the name of the kernel variable we're about */
/* to look up. */
/* Convert the frame code to a string. */
intstr_(frcode, cdestr, (ftnlen)32);
if (failed_()) {
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
}
/* Get the lengths of the input frame code, name and item. */
/* Compute the length of the ID-based kernel variable name; */
/* check this length against the maximum allowed value. If */
/* the name is too long, proceed to look up the form of the */
/* kernel variable name based on the frame name. */
codeln = rtrim_(cdestr, (ftnlen)32);
nameln = rtrim_(frname, frname_len);
itemln = rtrim_(item, item_len);
reqnum = codeln + itemln + 7;
if (reqnum <= 32) {
/* First try looking for a kernel variable including the frame ID */
/* code. */
/* Note the template is */
/* 'FRAME_#_#' */
repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, (
ftnlen)32);
repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
ftnlen)32);
dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1);
} else {
/* The ID-based name is too long. We can't find the variable if */
/* we can't look it up. */
found = FALSE_;
}
if (! found) {
/* We need to look up the frame name-based kernel variable. */
/* Determine the length of the name of this variable; make */
/* sure it's not too long. */
reqnam = nameln + itemln + 7;
if (reqnam > 32 && reqnum > 32) {
/* Both forms of the name are too long. */
setmsg_("Kernel variable FRAME_#_# has length #; kernel variable"
" FRAME_#_# has length #; maximum allowed length is #. N"
"either variable could be searched for in the kernel pool"
" due to these name length errors.", (ftnlen)200);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnum, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnam, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21);
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
} else if (reqnam > 32) {
/* We couldn't find the variable having the ID-based name, */
/* and the frame name-based variable name is too long to */
/* look up. */
/* Note that at this point KVNAME contains the ID-based */
/* kernel variable name. */
setmsg_("Kernel variable # was expected to be present in the ker"
"nel pool but was not found. The alternative form of ker"
"nel variable name FRAME_#_# was not searched for because"
" this name has excessive length (# characters vs allowed"
" maximum of #). One of these variables is needed to def"
"ine the parameterized dynamic frame #. Usually this typ"
"e of problem is due to an error in a frame definition pr"
"ovided in a frame kernel.", (ftnlen)416);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnam, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
}
/* Now try looking for a kernel variable including the frame */
/* name. */
repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1,
frname_len, (ftnlen)32);
repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
ftnlen)32);
dtpool_(kvname, &found, n, dtype, (ftnlen)32, (ftnlen)1);
if (! found && reqnum > 32) {
/* The kernel variable's presence (in one form or the other) */
/* is mandatory: signal an error. The error message */
/* depends on which variables we were able to try to */
/* look up. In this case, we never tried to look up the */
/* frame ID-based name. */
/* Note that at this point KVNAME contains the name-based */
/* kernel variable name. */
setmsg_("Kernel variable # was expected to be present in the ker"
"nel pool but was not found. The alternative form of ker"
"nel variable name FRAME_#_# was not searched for because"
" this name has excessive length (# characters vs allowed"
" maximum of #). One of these variables is needed to def"
"ine the parameterized dynamic frame #. Usually this typ"
"e of problem is due to an error in a frame definition pr"
"ovided in a frame kernel.", (ftnlen)416);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnum, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
} else if (! found) {
/* We tried to look up both names and failed. */
setmsg_("At least one of the kernel variables FRAME_#_# or FRAME"
"_#_# was expected to be present in the kernel pool but n"
"either was found. One of these variables is needed to de"
"fine the parameterized dynamic frame #. Usually this ty"
"pe of problem is due to a missing keyword assignment in "
"a frame kernel. Another, less likely, possibility is th"
"at other errors in a frame kernel have confused the fram"
"e subsystem into wrongly deciding these variables are ne"
"eded.", (ftnlen)452);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
}
}
/* Getting to this point means we found a kernel variable. The name */
/* of the variable is KVNAME. The data type is DTYPE and the */
/* cardinality is N. */
/* Rather than using BADKPV, we check the data type and cardinality */
/* of the kernel variable in-line so we can create a more detailed */
/* error message if need be. */
if (*(unsigned char *)dtype == 'C') {
setmsg_("The kernel variable # has used to define frame # was expect"
"ed to have integer data type but in fact has character type."
" Usually this type of problem is due to an error in a frame"
" definition provided in a frame kernel.", (ftnlen)218);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(BADVARIABLETYPE)", (ftnlen)22);
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
}
if (*n > *maxn) {
setmsg_("The kernel variable # has used to define frame # was expect"
"ed to have size not exceeding # but in fact has size #. Usua"
"lly this type of problem is due to an error in a frame defin"
"ition provided in a frame kernel.", (ftnlen)212);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errint_("#", maxn, (ftnlen)1);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22);
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
}
/* Look up the kernel variable. */
gipool_(kvname, &c__1, maxn, n, values, &found, (ftnlen)32);
if (! found) {
setmsg_("Variable # not found after DTPOOL indicated it was present "
"in pool.", (ftnlen)67);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
}
chkout_("ZZDYNVAI", (ftnlen)8);
return 0;
} /* zzdynvai_ */
/* $Procedure ZZEKAC09 ( EK, add class 9 column to segment ) */
/* Subroutine */ int zzekac09_(integer *handle, integer *segdsc, integer *
coldsc, char *cvals, logical *nlflgs, integer *wkindx, ftnlen
cvals_len)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_len(char *, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char page[1024];
integer from;
extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *,
ftnlen), zzekacps_(integer *, integer *, integer *, integer *,
integer *, integer *), zzekordc_(char *, logical *, logical *,
integer *, integer *, ftnlen), zzekpgwc_(integer *, integer *,
char *, ftnlen), zzekwpai_(integer *, integer *, integer *,
integer *, integer *, integer *), zzekwpal_(integer *, integer *,
integer *, logical *, integer *, integer *), zzekslnk_(integer *,
integer *, integer *, integer *);
integer l, p, mbase, npage;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
integer class__, nrows, cmbase;
extern logical return_(void);
char column[32];
integer colidx, datbas, dscbas, idxbas, idxpag, idxtyp, nflbas, nflpag,
nulptr, to;
logical fixlen, indexd, nullok;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), dasudi_(integer *, integer *, integer *, integer *);
integer spp;
/* $ Abstract */
/* Add an entire class 9 column to an EK 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 */
/* $ 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 Boolean Enumerated Type */
/* ekbool.inc Version 1 21-DEC-1994 (NJB) */
/* Within the EK system, boolean values sometimes must be */
/* represented by integer or character codes. The codes and their */
/* meanings are listed below. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* Character code indicating `true': */
/* Character code indicating `false': */
/* End Include Section: EK Boolean Enumerated Type */
/* $ 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 Class 9 Parameters */
/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */
/* The following parameters give the offsets of items in the */
/* class 9 integer metadata array. */
/* Data array base address: */
/* Null flag array base address: */
/* Size of class 9 metadata array: */
/* End Include Section: EK Column Class 9 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 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 Data Page Parameters */
/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */
/* These parameters apply to EK files using architecture 4. */
/* These files use a paged DAS file as their underlying file */
/* structure. */
/* In paged DAS EK files, data pages are structured: they contain */
/* metadata as well as data. The metadata is located in the last */
/* few addresses of each page, so as to interfere as little as */
/* possible with calculation of data addresses. */
/* Each data page belongs to exactly one segment. Some bookkeeping */
/* information, such as record pointers, is also stored in data */
/* pages. */
/* Each page contains a forward pointer that allows rapid lookup */
/* of data items that span multiple pages. Each page also keeps */
/* track of the current number of links from its parent segment */
/* to the page. Link counts enable pages to `know' when they */
/* are no longer in use by a segment; unused pages are deallocated */
/* and returned to the free list. */
/* The parameters in this include file depend on the parameters */
/* declared in the include file ekpage.inc. If those parameters */
/* change, this file must be updated. The specified parameter */
/* declarations we need from that file are: */
/* INTEGER PGSIZC */
/* PARAMETER ( PGSIZC = 1024 ) */
/* INTEGER PGSIZD */
/* PARAMETER ( PGSIZD = 128 ) */
/* INTEGER PGSIZI */
/* PARAMETER ( PGSIZI = 256 ) */
/* Character pages use an encoding mechanism to represent integer */
/* metadata. Each integer is encoded in five consecutive */
/* characters. */
/* Character data page parameters: */
/* Size of encoded integer: */
/* Usable page size: */
/* Location of character forward pointer: */
/* Location of character link count: */
/* Double precision data page parameters: */
/* Usable page size: */
/* Location of d.p. forward pointer: */
/* Location of d.p. link count: */
/* Integer data page parameters: */
/* Usable page size: */
/* Location of integer forward pointer: */
/* Location of integer link count: */
/* End Include Section: EK Data Page 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 Das Paging Parameters */
/* ekpage.inc Version 4 25-AUG-1995 (NJB) */
/* The EK DAS paging system makes use of the integer portion */
/* of an EK file's DAS address space to store the few numbers */
/* required to describe the system's state. The allocation */
/* of DAS integer addresses is shown below. */
/* DAS integer array */
/* +--------------------------------------------+ */
/* | EK architecture code | Address = 1 */
/* +--------------------------------------------+ */
/* | Character page size (in DAS words) | */
/* +--------------------------------------------+ */
/* | Character page base address | */
/* +--------------------------------------------+ */
/* | Number of character pages in file | */
/* +--------------------------------------------+ */
/* | Number of character pages on free list | */
/* +--------------------------------------------+ */
/* | Character free list head pointer | Address = 6 */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for d.p. pages | 7--11 */
/* | | */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for integer pages | 12--16 */
/* | | */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | End Address = */
/* | Unused space | integer page */
/* | | end */
/* +--------------------------------------------+ */
/* | | Start Address = */
/* | First integer page | integer page */
/* | | base */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | */
/* | Last integer page | */
/* | | */
/* +--------------------------------------------+ */
/* The following parameters indicate positions of elements in the */
/* paging system metadata array: */
/* Number of metadata items per data type: */
/* Character metadata indices: */
/* Double precision metadata indices: */
/* Integer metadata indices: */
/* Size of metadata area: */
/* Page sizes, in units of DAS words of the appropriate type: */
/* Default page base addresses: */
/* End Include Section: EK Das Paging 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 */
/* $ 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 Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to new EK file. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* CVALS I Character values to add to column. */
/* NLFLGS I Array of null flags for column entries. */
/* WKINDX I-O Work space for column index. */
/* $ Detailed_Input */
/* HANDLE the handle of an EK file that is open for writing. */
/* A `begin segment for fast load' operation must */
/* have already been performed for the designated */
/* segment. */
/* SEGDSC is a descriptor for the segment to which data is */
/* to be added. The segment descriptor is not */
/* updated by this routine, but some fields in the */
/* descriptor will become invalid after this routine */
/* returns. */
/* COLDSC is a descriptor for the column to be added. The */
/* column attributes must be filled in, but any */
/* pointers may be uninitialized. */
/* CVALS is an array containing the entire set of column */
/* entries for the specified column. The entries */
/* are listed in row-order: the column entry for the */
/* first row of the segment is first, followed by the */
/* column entry for the second row, and so on. The */
/* number of column entries must match the declared */
/* number of rows in the segment. Elements must be */
/* allocated for each column entry, including null */
/* entries. */
/* NLFLGS is an array of logical flags indicating whether */
/* the corresponding entries are null. If the Ith */
/* element of NLFLGS is .FALSE., the Ith column entry */
/* defined by CVALS is added to the specified segment */
/* in the specified kernel file. */
/* If the Ith element of NLFGLS is .TRUE., the */
/* contents of the Ith column entry are undefined. */
/* NLFLGS is used only for columns that allow null */
/* values; it's ignored for other columns. */
/* WKINDX is a work space array used for building a column */
/* index. If the column is indexed, the dimension of */
/* WKINDX must be at NROWS, where NROWS is the number */
/* of rows in the column. If the column is not */
/* indexed, this work space is not used, so the */
/* dimension may be any positive value. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If an I/O error occurs while reading or writing the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine operates by side effects: it modifies the named */
/* EK file by adding data to the specified column. This routine */
/* writes the entire contents of the specified column in one shot. */
/* This routine creates columns much more efficiently than can be */
/* done by sequential calls to EKACEC, but has the drawback that */
/* the caller must use more memory for the routine's inputs. This */
/* routine cannot be used to add data to a partially completed */
/* column. */
/* Class 9 columns have fixed record counts, and contain */
/* fixed-length strings. */
/* $ Examples */
/* See EKACLC. */
/* $ Restrictions */
/* 1) This routine assumes the EK file has been set up */
/* properly for a fast load operation. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKAC09", (ftnlen)8);
}
/* Grab the column's attributes. Initialize the maximum non-blank */
/* width of the column. */
class__ = coldsc[0];
idxtyp = coldsc[5];
nulptr = coldsc[7];
colidx = coldsc[8];
l = coldsc[2];
nullok = nulptr != -1;
indexd = idxtyp != -1;
fixlen = l != -1;
/* This column had better be class 9. */
if (class__ != 9) {
zzekcnam_(handle, coldsc, column, (ftnlen)32);
setmsg_("Column class code # found in descriptor for column #. Clas"
"s should be 9.", (ftnlen)73);
errint_("#", &class__, (ftnlen)1);
errch_("#", column, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(NOCLASS)", (ftnlen)14);
chkout_("ZZEKAC09", (ftnlen)8);
return 0;
}
/* Make sure the column has fixed-length strings. */
if (! fixlen) {
zzekcnam_(handle, coldsc, column, (ftnlen)32);
setmsg_("Column # has variable string length; class 9 supports fixed"
"-length strings only.", (ftnlen)80);
errch_("#", column, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKAC09", (ftnlen)8);
return 0;
}
/* Check the input string length. */
if (l < 0 || l > i_len(cvals, cvals_len) || l > 1014) {
setmsg_("String length # is just plain wrong.", (ftnlen)36);
errint_("#", &l, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("ZZEKAC09", (ftnlen)8);
return 0;
}
/* Compute the number of strings we can hold in one page. */
spp = 1014 / l;
/* Find the number of rows in the segment. */
nrows = segdsc[5];
/* Decide how many pages are required to hold the array, and */
/* allocate that many new, contiguous pages. */
npage = (nrows + spp - 1) / spp;
zzekacps_(handle, segdsc, &c__1, &npage, &p, &datbas);
/* We'll use FROM to indicate the element of CVALS we're */
/* considering and TO to indicate the element of PAGE to write */
/* to. */
to = 1;
s_copy(page, " ", (ftnlen)1024, (ftnlen)1);
i__1 = nrows;
for (from = 1; from <= i__1; ++from) {
/* The Assignment. */
if (! nullok || ! nlflgs[from - 1]) {
s_copy(page + (to - 1), cvals + (from - 1) * cvals_len, to + l -
1 - (to - 1), cvals_len);
}
to += l;
if (to > 1014 - l + 1 || from == nrows) {
/* Either the current data page is full, or we've buffered */
/* the last of the available data. It's time to write out the */
/* current page. */
zzekpgwc_(handle, &p, page, (ftnlen)1024);
/* Set the link count. */
i__2 = (to - l) / l;
zzekslnk_(handle, &c__1, &p, &i__2);
/* Next page. */
++p;
to = 1;
}
}
/* Update the column's metadata area to point to the data array. */
cmbase = coldsc[9];
i__1 = cmbase + 1;
i__2 = cmbase + 1;
dasudi_(handle, &i__1, &i__2, &datbas);
/* If the column is supposed to have an index, now is the time to */
/* build that index. Type 2 indexes are just order vectors. */
if (indexd) {
/* Compute the order vector. */
zzekordc_(cvals, &nullok, nlflgs, &nrows, wkindx, cvals_len);
/* Write out the index. */
zzekwpai_(handle, segdsc, &nrows, wkindx, &idxpag, &idxbas);
/* Update the column's metadata to point to the index. The */
/* pointer indicates base address of the index. Also set the */
/* index type in the column descriptor. */
mbase = segdsc[2];
dscbas = mbase + 24 + (colidx - 1) * 11;
i__1 = dscbas + 7;
i__2 = dscbas + 7;
dasudi_(handle, &i__1, &i__2, &idxbas);
i__1 = dscbas + 6;
i__2 = dscbas + 6;
dasudi_(handle, &i__1, &i__2, &c__2);
}
if (nullok) {
/* Nulls are allowed. Write out the null flag array. */
zzekwpal_(handle, segdsc, &nrows, nlflgs, &nflpag, &nflbas);
/* Update the column's metadata area to point to the null flag */
/* array. */
i__1 = cmbase + 2;
i__2 = cmbase + 2;
dasudi_(handle, &i__1, &i__2, &nflbas);
}
chkout_("ZZEKAC09", (ftnlen)8);
return 0;
} /* zzekac09_ */
/* $Procedure DASADD ( DAS, add data, double precision ) */
/* Subroutine */ int dasadd_(integer *handle, integer *n, doublereal *data)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer free;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer ncomc, recno, lastd;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer ncomr, numdp;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int dascud_(integer *, integer *, integer *),
dashfs_(integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
doublereal record[128];
integer lastla[3];
extern /* Subroutine */ int dasurd_(integer *, integer *, integer *,
integer *, doublereal *), daswrd_(integer *, integer *,
doublereal *);
integer lastrc[3], clsize;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer lastwd[3], nresvc, wordno;
extern logical return_(void);
integer nresvr, nwritn;
/* $ Abstract */
/* Add an array of double precision numbers to a DAS 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 */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* N I Number of d.p. numbers to add to DAS file. */
/* DATA I Array of d.p. numbers to add. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* N is a the number of double precision `words' to */
/* add to the DAS file specified by HANDLE. */
/* DATA is an array of double precision numbers to be */
/* added to the specified DAS file. Elements */
/* 1 through N are appended to the double precision */
/* data in the file. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) If an I/O error occurs during the data addition attempted */
/* by this routine, the error will be diagnosed by routines */
/* called by this routine. */
/* 3) If the input count N is less than 1, no data will be */
/* added to the specified DAS file. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine adds double precision data to a DAS file by */
/* `appending' it after any double precision data already in the */
/* file. The sense in which the data is `appended' is that the */
/* data will occupy a range of logical addresses for double precision */
/* data that immediately follow the last logical address of a double */
/* precision number that is occupied at the time this routine is */
/* called. The diagram below illustrates this addition: */
/* +-------------------------+ */
/* | (already in use) | D.p. logical address 1 */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | (already in use) | Last d.p. logical address */
/* +-------------------------+ in use before call to DASADD */
/* | DATA(1) | */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | DATA(N) | */
/* +-------------------------+ */
/* The logical organization of the double precision numbers in the */
/* DAS file is independent of the order of addition to the file or */
/* physical location of any data of integer or character type. */
/* The actual physical write operations that add the input array */
/* DATA to the indicated DAS file may not take place before this */
/* routine returns, since the DAS system buffers data that is */
/* written as well as data that is read. In any case, the data */
/* will be flushed to the file at the time the file is closed, if */
/* not earlier. A physical write of all buffered records can be */
/* forced by calling the SPICELIB routine DASWBR ( DAS, write */
/* buffered records ). */
/* In order to update double precision logical addresses that */
/* already contain data, the SPICELIB routine DASUDD */
/* ( DAS update data, double precision ) should be used. */
/* $ Examples */
/* 1) Create the new DAS file TEST.DAS and add 200 double */
/* precision numbers to it. Close the file, then re-open */
/* it and read the data back out. */
/* PROGRAM TEST_ADD */
/* CHARACTER*(4) TYPE */
/* DOUBLE PRECISION DATA ( 200 ) */
/* INTEGER HANDLE */
/* INTEGER I */
/* C */
/* C Open a new DAS file. Use the file name as */
/* C the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Fill the array DATA with the double precision */
/* C numbers 1.D0 through 100.D0, and add this array */
/* C to the file. */
/* C */
/* DO I = 1, 100 */
/* DATA(I) = DBLE(I) */
/* END DO */
/* CALL DASADD ( HANDLE, 100, DATA ) */
/* C */
/* C Now append the array DATA to the file again. */
/* C */
/* CALL DASADD ( HANDLE, 100, DATA ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now verify the addition of data by opening the */
/* C file for read access and retrieving the data. */
/* C */
/* CALL DASRDD ( HANDLE, 1, 200, DATA ) */
/* C */
/* C Dump the data to the screen. We should see the */
/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. The */
/* C numbers will be represented as double precision */
/* C numbers in the output. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Data from TEST.DAS: ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) DATA */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0 10-APR-2014 (NJB) */
/* Deleted declarations of unused parameters. */
/* Corrected header comments: routine that flushes */
/* written, buffered records is DASWBR, not DASWUR. */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* add double precision data to a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. Without */
/* this test, an infinite loop could result if DASA2L, DASURD or */
/* DASWRD signaled an error inside the loop. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASADD", (ftnlen)6);
}
/* Get the file summary for this DAS. */
dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
lastd = lastla[1];
/* We will keep track of the location that we wish to write to */
/* with the variables RECNO and WORDNO. RECNO will be the record */
/* number of the record we'll write to; WORDNO will be the number */
/* preceding the word index, within record number RECNO, that we'll */
/* write to. For example, if we're about to write to the first */
/* double precision number in record 10, RECNO will be 10 and */
/* WORDNO will be 0. Of course, when WORDNO reaches NWD, we'll */
/* have to find a free record before writing anything. */
/* Prepare the variables RECNO and WORDNO: use the physical */
/* location of the last double precision address, if there are any */
/* double precision data in the file. Otherwise, RECNO becomes the */
/* first record available for double precision data. */
if (lastd >= 1) {
dasa2l_(handle, &c__2, &lastd, &clbase, &clsize, &recno, &wordno);
} else {
recno = free;
wordno = 0;
}
/* Set the number of double precision words already written. Keep */
/* writing to the file until this number equals the number of */
/* elements in DATA. */
/* Note that if N is non-positive, the loop doesn't get exercised. */
nwritn = 0;
while(nwritn < *n && ! failed_()) {
/* Write as much data as we can (or need to) into the current */
/* record. We assume that RECNO, WORDNO, and NWRITN have been */
/* set correctly at this point. */
/* Find out how many words to write into the current record. */
/* There may be no space left in the current record. */
/* Computing MIN */
i__1 = *n - nwritn, i__2 = 128 - wordno;
numdp = min(i__1,i__2);
if (numdp > 0) {
/* Write NUMDP words into the current record. If the record */
/* is new, write the entire record. Otherwise, just update */
/* the part we're interested in. */
if (wordno == 0) {
moved_(&data[nwritn], &numdp, record);
daswrd_(handle, &recno, record);
} else {
i__1 = wordno + 1;
i__2 = wordno + numdp;
dasurd_(handle, &recno, &i__1, &i__2, &data[nwritn]);
}
nwritn += numdp;
wordno += numdp;
} else {
/* It's time to start on a new record. If the record we */
/* just finished writing to (or just attempted writing to, */
/* if it was full) was FREE or a higher-numbered record, */
/* then we are writing to a contiguous set of data records: */
/* the next record to write to is the immediate successor */
/* of the last one. Otherwise, FREE is the next record */
/* to write to. */
/* We intentionally leave FREE at the value it had before */
/* we starting adding data to the file. */
if (recno >= free) {
++recno;
} else {
recno = free;
}
wordno = 0;
}
}
/* Update the DAS file directories to reflect the addition of N */
/* double precision words. DASCUD will also update the file summary */
/* accordingly. */
dascud_(handle, &c__2, n);
chkout_("DASADD", (ftnlen)6);
return 0;
} /* dasadd_ */
/* $Procedure CKGP ( C-kernel, get pointing ) */
/* Subroutine */ int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol,
char *ref, doublereal *cmat, doublereal *clkout, logical *found,
ftnlen ref_len)
{
/* Initialized data */
static logical first = TRUE_;
logical pfnd, sfnd;
integer sclk;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *),
zznamfrm_(integer *, char *, integer *, char *, integer *,
ftnlen, ftnlen);
integer type1, type2;
extern /* Subroutine */ int zzctruin_(integer *);
char segid[40];
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), ckbss_(integer *, doublereal *,
doublereal *, logical *), ckpfs_(integer *, doublereal *,
doublereal *, doublereal *, logical *, doublereal *, doublereal *,
doublereal *, logical *), moved_(doublereal *, integer *,
doublereal *), cksns_(integer *, doublereal *, char *, logical *,
ftnlen);
static char svref[32];
logical gotit;
static integer svctr1[2];
extern logical failed_(void);
doublereal av[3], et;
integer handle;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
logical needav;
extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen);
integer refseg, center;
extern /* Subroutine */ int frinfo_(integer *, integer *, integer *,
integer *, logical *);
integer refreq, typeid;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
static integer svrefr;
extern logical return_(void);
doublereal dcd[2];
integer icd[6];
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
doublereal rot[9] /* was [3][3] */;
/* $ Abstract */
/* Get pointing (attitude) for a specified spacecraft clock time. */
/* $ 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 */
/* SCLK */
/* $ Keywords */
/* POINTING */
/* $ 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. */
/* ALL indicates any of the above classes. This parameter */
/* is used in APIs that fetch information about frames */
/* of a specified class. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 4.0.0, 08-MAY-2012 (NJB) */
/* The parameter ALL was added to support frame fetch APIs. */
/* - 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) */
/* -& */
/* End of INCLUDE file frmtyp.inc */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* INST I NAIF ID of instrument, spacecraft, or structure. */
/* SCLKDP I Encoded spacecraft clock time. */
/* TOL I Time tolerance. */
/* REF I Reference frame. */
/* CMAT O C-matrix pointing data. */
/* CLKOUT O Output encoded spacecraft clock time. */
/* FOUND O True when requested pointing is available. */
/* $ Detailed_Input */
/* INST is the NAIF integer ID for the instrument, spacecraft, */
/* or other structure for which pointing is requested. */
/* For brevity we will refer to this object as the */
/* "instrument," and the frame fixed to this object as */
/* the "instrument frame" or "instrument-fixed" frame. */
/* SCLKDP is the encoded spacecraft clock time for which */
/* pointing is requested. */
/* The SPICELIB routines SCENCD and SCE2C respectively */
/* convert spacecraft clock strings and ephemeris time to */
/* encoded spacecraft clock. The inverse conversions are */
/* performed by SCDECD and SCT2E. */
/* TOL is a time tolerance in ticks, the units of encoded */
/* spacecraft clock time. */
/* The SPICELIB routine SCTIKS converts a spacecraft */
/* clock tolerance duration from its character string */
/* representation to ticks. SCFMT performs the inverse */
/* conversion. */
/* The C-matrix returned by CKGP is the one whose time */
/* tag is closest to SCLKDP and within TOL units of */
/* SCLKDP. (More in Particulars, below.) */
/* In general, because using a non-zero tolerance */
/* affects selection of the segment from which the */
/* data is obtained, users are strongly discouraged */
/* from using a non-zero tolerance when reading CKs */
/* with continuous data. Using a non-zero tolerance */
/* should be reserved exclusively to reading CKs with */
/* discrete data because in practice obtaining data */
/* from such CKs using a zero tolerance is often not */
/* possible due to time round off. */
/* REF is the desired reference frame for the returned */
/* pointing. The returned C-matrix CMAT gives the */
/* orientation of the instrument designated by INST */
/* relative to the frame designated by REF. When a */
/* vector specified relative to frame REF is left- */
/* multiplied by CMAT, the vector is rotated to the */
/* frame associated with INST. See the discussion of */
/* CMAT below for details. */
/* Consult the SPICE document "Frames" for a discussion */
/* of supported reference frames. */
/* $ Detailed_Output */
/* CMAT is a rotation matrix that transforms the components of */
/* a vector expressed in the reference frame specified by */
/* REF to components expressed in the frame tied to the */
/* instrument, spacecraft, or other structure at time */
/* CLKOUT (see below). */
/* Thus, if a vector v has components x,y,z in the REF */
/* reference frame, then v has components x',y',z' in the */
/* instrument fixed frame at time CLKOUT: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* If you know x', y', z', use the transpose of the */
/* C-matrix to determine x, y, z as follows: */
/* [ x ] [ ]T [ x' ] */
/* | y | = | CMAT | | y' | */
/* [ z ] [ ] [ z' ] */
/* (Transpose of CMAT) */
/* CLKOUT is the encoded spacecraft clock time associated with */
/* the returned C-matrix. This value may differ from the */
/* requested time, but never by more than the input */
/* tolerance TOL. */
/* The particulars section below describes the search */
/* algorithm used by CKGP to satisfy a pointing */
/* request. This algorithm determines the pointing */
/* instance (and therefore the associated time value) */
/* that is returned. */
/* FOUND is true if a record was found to satisfy the pointing */
/* request. FOUND will be false otherwise. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If a C-kernel file has not been loaded using FURNSH prior to */
/* a call to this routine, an error is signaled by a routine in */
/* the call tree of this routine. */
/* 2) If TOL is negative, found is set to .FALSE. */
/* 3) If REF is not a supported reference frame, an error is */
/* signaled by a routine in the call tree of this routine and */
/* FOUND is set to .FALSE. */
/* $ Files */
/* CKGP searches through files loaded by FURNSH to locate a */
/* segment that can satisfy the request for pointing for instrument */
/* INST at time SCLKDP. You must load a C-kernel file using FURNSH */
/* prior to calling this routine. */
/* $ Particulars */
/* How the tolerance argument is used */
/* ================================== */
/* Reading a type 1 CK segment (discrete pointing instances) */
/* --------------------------------------------------------- */
/* In the diagram below */
/* - "0" is used to represent discrete pointing instances */
/* (quaternions and associated time tags). */
/* - "( )" are used to represent the end points of the time */
/* interval covered by a segment in a CK file. */
/* - SCLKDP is the time at which you requested pointing. */
/* The location of SCLKDP relative to the time tags of the */
/* pointing instances is indicated by the "+" sign. */
/* - TOL is the time tolerance specified in the pointing */
/* request. The square brackets "[ ]" represent the */
/* endpoints of the time interval */
/* SCLKDP-TOL : SCLKDP+TOL */
/* - The quaternions occurring in the segment need not be */
/* evenly spaced in time. */
/* Case 1: pointing is available */
/* ------------------------------ */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (0-----0--0--0--0--0--0---0--0------------0--0--0--0) */
/* ^ */
/* | */
/* CKGP returns this instance. */
/* Case 2: pointing is not available */
/* ---------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) */
/* CKGP returns no pointing; the output */
/* FOUND flag is set to .FALSE. */
/* Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) */
/* ------------------------------------------------------------- */
/* In the diagrams below */
/* - "==" is used to represent periods of continuous pointing. */
/* - "--" is used to represent gaps in the pointing coverage. */
/* - "( )" are used to represent the end points of the time */
/* interval covered by a segment in a CK file. */
/* - SCLKDP is the time at which you requested pointing. */
/* The location of SCLKDP relative to the time tags of the */
/* pointing instances is indicated by the "+" sign. */
/* - TOL is the time tolerance specified in the pointing */
/* request. The square brackets "[ ]" represent the */
/* endpoints of the time interval */
/* SCLKDP-TOL : SCLKDP+TOL */
/* - The quaternions occurring in the periods of continuous */
/* pointing need not be evenly spaced in time. */
/* Case 1: pointing is available at the request time */
/* -------------------------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* . . . */
/* Segment (==---===========---=======----------===--) */
/* ^ */
/* | */
/* The request time lies within an interval where */
/* continuous pointing is available. CKGP returns */
/* pointing at the requested epoch. */
/* Case 2: pointing is available "near" the request time */
/* ------------------------------------------------------ */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (==---===========----=======---------===--) */
/* ^ */
/* | */
/* The request time lies in a gap: an interval where */
/* continuous pointing is *not* available. CKGP */
/* returns pointing for the epoch closest to the */
/* request time SCLKDP. */
/* Case 3: pointing is not available */
/* ---------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (==---===========----=======---------===--) */
/* CKGP returns no pointing; the output */
/* FOUND flag is set to .FALSE. */
/* Tolerance and segment priority */
/* ============================== */
/* CKGP searches through loaded C-kernels to satisfy a pointing */
/* request. Last-loaded files are searched first. Individual files */
/* are searched in backwards order, so that between competing */
/* segments (segments containing data for the same object, for */
/* overlapping time ranges), the one closest to the end of the file */
/* has highest priority. */
/* The search ends when a segment is found that can provide pointing */
/* for the specified instrument at a time falling within the */
/* specified tolerance on either side of the request time. Within */
/* that segment, the instance closest to the input time is located */
/* and returned. */
/* The following four cases illustrate this search procedure. */
/* Segments A and B are in the same file, with segment A located */
/* further towards the end of the file than segment B. Both segments */
/* A and B contain discrete pointing data, indicated by the number */
/* 0. */
/* Case 1: Pointing is available in the first segment searched. */
/* Because segment A has the highest priority and can */
/* satisfy the request, segment B is not searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* ^ */
/* | */
/* | */
/* CKGP returns this instance */
/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */
/* Case 2: Pointing is not available in the first segment searched. */
/* Because segment A cannot satisfy the request, segment B */
/* is searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* . . . */
/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segments that contain continuous pointing data are searched in */
/* the same manner as segments containing discrete pointing data. */
/* For request times that fall within the bounds of continuous */
/* intervals, CKGP will return pointing at the request time. When */
/* the request time does not fall within an interval, then a time at */
/* an endpoint of an interval may be returned if it is the closest */
/* time in the segment to the user request time and is also within */
/* the tolerance. */
/* In the following examples, segment A is located further towards */
/* the end of the file than segment C. Segment A contains discrete */
/* pointing data and segment C contains continuous data, indicated */
/* by the "=" character. */
/* Case 3: Pointing is not available in the first segment searched. */
/* Because segment A cannot satisfy the request, segment C */
/* is searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* . . . */
/* . . . */
/* Segment C (---=============-----====--------==--) */
/* ^ */
/* | */
/* | */
/* CKGP returns this instance */
/* In the next case, assume that the order of segments A and C in the */
/* file is reversed: A is now closer to the front, so data from */
/* segment C are considered first. */
/* Case 4: Pointing is available in the first segment searched. */
/* Because segment C has the highest priority and can */
/* satisfy the request, segment A is not searched. */
/* SCLKDP */
/* / */
/* | TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment C (---=============-----====--------==--) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segment A (0-----------------0--------0--0-----0) */
/* ^ */
/* | */
/* "Best" answer */
/* The next case illustrates an unfortunate side effect of using */
/* a non-zero tolerance when reading multi-segment CKs with */
/* continuous data. In all cases when the look-up interval */
/* formed using tolerance overlaps a segment boundary and */
/* the request time falls within the coverage of the lower */
/* priority segment, the data at the end of the higher priority */
/* segment will be picked instead of the data from the lower */
/* priority segment. */
/* Case 5: Pointing is available in the first segment searched. */
/* Because segment C has the highest priority and can */
/* satisfy the request, segment A is not searched. */
/* SCLKDP */
/* / */
/* | TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment C (===============) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segment A (=====================) */
/* ^ */
/* | */
/* "Best" answer */
/* $ Examples */
/* Suppose you have two C-kernel files containing data for the */
/* Voyager 2 narrow angle camera. One file contains predict values, */
/* and the other contains corrected pointing for a selected group */
/* of images, that is, for a subset of images from the first file. */
/* The following example program uses CKGP to get C-matrices for a */
/* set of images whose SCLK counts (un-encoded character string */
/* versions) are contained in the array SCLKCH. */
/* If available, the program will get the corrected pointing values. */
/* Otherwise, predict values will be used. */
/* For each C-matrix, a unit pointing vector is constructed */
/* and printed. */
/* C */
/* C Constants for this program. */
/* C */
/* C -- The code for the Voyager 2 spacecraft clock is -32 */
/* C */
/* C -- The code for the narrow angle camera on the Voyager 2 */
/* C spacecraft is -32001. */
/* C */
/* C -- Spacecraft clock times for successive Voyager images */
/* C always differ by more than 0:0:400. This is an */
/* C acceptable tolerance, and must be converted to "ticks" */
/* C (units of encoded SCLK) for input to CKGP. */
/* C */
/* C -- The reference frame we want is FK4. */
/* C */
/* C -- The narrow angle camera boresight defines the third */
/* C axis of the instrument-fixed coordinate system. */
/* C Therefore, the vector ( 0, 0, 1 ) represents */
/* C the boresight direction in the camera-fixed frame. */
/* C */
/* IMPLICIT NONE */
/* INTEGER FILEN */
/* PARAMETER ( FILEN = 255 ) */
/* INTEGER NPICS */
/* PARAMETER ( NPICS = 2 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 30 ) */
/* INTEGER REFLEN */
/* PARAMETER ( REFLEN = 32 ) */
/* CHARACTER*(TIMLEN) CLKCH */
/* CHARACTER*(FILEN) CKPRED */
/* CHARACTER*(FILEN) CKCORR */
/* CHARACTER*(REFLEN) REF */
/* CHARACTER*(FILEN) SCLK */
/* CHARACTER*(TIMLEN) SCLKCH ( NPICS ) */
/* CHARACTER*(TIMLEN) TOLVGR */
/* DOUBLE PRECISION CLKOUT */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* DOUBLE PRECISION SCLKDP */
/* DOUBLE PRECISION TOLTIK */
/* DOUBLE PRECISION VCFIX ( 3 ) */
/* DOUBLE PRECISION VINERT ( 3 ) */
/* INTEGER SC */
/* INTEGER I */
/* INTEGER INST */
/* LOGICAL FOUND */
/* CKPRED = 'voyager2_predict.bc' */
/* CKCORR = 'voyager2_corrected.bc' */
/* SCLK = 'voyager2_sclk.tsc' */
/* SC = -32 */
/* INST = -32001 */
/* SCLKCH(1) = '4/08966:30:768' */
/* SCLKCH(2) = '4/08970:58:768' */
/* TOLVGR = '0:0:400' */
/* REF = 'FK4' */
/* VCFIX( 1 ) = 0.D0 */
/* VCFIX( 2 ) = 0.D0 */
/* VCFIX( 3 ) = 1.D0 */
/* C */
/* C Loading the files in this order ensures that the */
/* C corrected file will get searched first. */
/* C */
/* CALL FURNSH ( CKPRED ) */
/* CALL FURNSH ( CKCORR ) */
/* C */
/* C Need to load a Voyager 2 SCLK kernel to convert from */
/* C clock strings to ticks. */
/* C */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Convert tolerance from VGR formatted character string */
/* C SCLK to ticks which are units of encoded SCLK. */
/* C */
/* CALL SCTIKS ( SC, TOLVGR, TOLTIK ) */
/* DO I = 1, NPICS */
/* C */
/* C CKGP requires encoded spacecraft clock. */
/* C */
/* CALL SCENCD ( SC, SCLKCH( I ), SCLKDP ) */
/* CALL CKGP ( INST, SCLKDP, TOLTIK, REF, CMAT, */
/* . CLKOUT, FOUND ) */
/* IF ( FOUND ) THEN */
/* C */
/* C Use the transpose of the C-matrix to transform the */
/* C boresight vector from camera-fixed to reference */
/* C coordinates. */
/* C */
/* CALL MTXV ( CMAT, VCFIX, VINERT ) */
/* CALL SCDECD ( SC, CLKOUT, CLKCH ) */
/* WRITE (*,*) 'VGR 2 SCLK Time: ', CLKCH */
/* WRITE (*,*) 'VGR 2 NA ISS boresight ' */
/* . // 'pointing vector: ', VINERT */
/* ELSE */
/* WRITE (*,*) 'Pointing not found for time ', SCLKCH(I) */
/* END IF */
/* END DO */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* J.M. Lynch (JPL) */
/* B.V. Semenov (JPL) */
/* M.J. Spencer (JPL) */
/* R.E. Thurman (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 5.4.0, 23-SEP-2013 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* - SPICELIB Version 5.3.1, 09-JUN-2010 (BVS) */
/* Header update: description of the tolerance and Particulars */
/* section were expanded to address some problems arising from */
/* using a non-zero tolerance. */
/* - SPICELIB Version 5.3.0, 23-APR-2010 (NJB) */
/* Bug fix: this routine now obtains the rotation */
/* from the request frame to the applicable CK segment's */
/* base frame via a call to REFCHG. Formerly the routine */
/* used FRMCHG, which required that angular velocity data */
/* be available for this transformation. */
/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* - SPICELIB Version 5.1.2, 29-JAN-2004 (NJB) */
/* Header update: description of input argument REF was */
/* expanded. */
/* - SPICELIB Version 5.1.1, 27-JUL-2003 (CHA) (NJB) */
/* Various header corrections were made. */
/* - SPICELIB Version 3.2.0, 23-FEB-1999 (WLT) */
/* The previous editions of this routine did not properly handle */
/* the case when TOL was negative. The routine now returns a */
/* value of .FALSE. for FOUND as is advertised above. */
/* - SPICELIB Version 3.1.0, 13-APR-1998 (WLT) */
/* The call to CHKOUT in the case when FAILED returned the */
/* value TRUE used to check out with the name 'CKGPAV'. This */
/* has been changed to a CKGP. */
/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */
/* The routine was upgraded to support non-inertial frames. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */
/* The Particulars section was updated to show how the */
/* search algorithm processes segments with continuous */
/* pointing data. */
/* The example program now loads an SCLK kernel. */
/* FAILED is checked after the call to IRFROT to handle the */
/* case where the reference frame is invalid and the error */
/* handling is not set to abort. */
/* FAILED is checked in the DO WHILE loop to handle the case */
/* where an error is detected by a SPICELIB routine inside the */
/* loop and the error handling is not set to abort. */
/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */
/* The restriction that a C-kernel file must be loaded */
/* was explicitly stated. */
/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */
/* -& */
/* $ Index_Entries */
/* get ck pointing */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* - SPICELIB Version 3.1.0, 20-DEC-1995 (WLT) */
/* A call to FRINFO did not have enough arguments and */
/* went undetected until Howard Taylor of ACT. Many */
/* thanks go out to Howard for tracking down this error. */
/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */
/* The routine was upgraded to support non-inertial frames. */
/* Calls to NAMIRF and IRFROT were replaced with calls to */
/* NAMFRM and FRMCHG respectively. */
/* - SPICELIB Version 1.0.2, 30-AUG-1991 (JML) */
/* 1) The Particulars section was updated to show how the */
/* search algorithm processes segments with continuous */
/* pointing data. */
/* 2) The example program now loads an SCLK kernel. */
/* 3) FAILED is checked after the call to IRFROT to handle the */
/* case where the reference frame is invalid and the error */
/* handling is not set to abort. */
/* 4) FAILED is checked in the DO WHILE loop to handle the case */
/* where an error is detected by a SPICELIB routine inside the */
/* loop and the error handling is not set to abort. */
/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */
/* 1) The restriction that a C-kernel file must be loaded */
/* was explicitly stated. */
/* 2) Minor changes were made to the wording of the header. */
/* - Beta Version 1.1.0, 29-AUG-1990 (MJS) */
/* The following changes were made as a result of the */
/* NAIF CK Code and Documentation Review: */
/* 1) The variable SCLK was changed to SCLKDP. */
/* 2) The variable INSTR was changed to INST. */
/* 3) The variable IDENT was changed to SEGID. */
/* 4) The declarations for the parameters NDC, NIC, NC, and */
/* IDLEN were moved from the "Declarations" section of the */
/* header to the "Local parameters" section of the code below */
/* the header. These parameters are not meant to modified by */
/* users. */
/* 5) The header was updated to reflect the changes. */
/* - Beta Version 1.0.0, 04-MAY-1990 (RET) (IMU) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* NDC is the number of double precision components in an */
/* unpacked C-kernel segment descriptor. */
/* NIC is the number of integer components in an unpacked */
/* C-kernel segment descriptor. */
/* NC is the number of components in a packed C-kernel */
/* descriptor. All DAF summaries have this formulaic */
/* relationship between the number of its integer and */
/* double precision components and the number of packed */
/* components. */
/* IDLEN is the length of the C-kernel segment identifier. */
/* All DAF names have this formulaic relationship */
/* between the number of summary components and */
/* the length of the name (You will notice that */
/* a name and a summary have the same length in bytes.) */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKGP", (ftnlen)4);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* Don't need angular velocity data. */
/* Assume the segment won't be found until it really is. */
needav = FALSE_;
*found = FALSE_;
/* If the tolerance is less than zero, we go no further. */
if (*tol < 0.) {
chkout_("CKGP", (ftnlen)4);
return 0;
}
/* Begin a search for this instrument and time, and get the first */
/* applicable segment. */
ckbss_(inst, sclkdp, tol, &needav);
cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
/* Keep trying candidate segments until a segment can produce a */
/* pointing instance within the specified time tolerance of the */
/* input time. */
/* Check FAILED to prevent an infinite loop if an error is detected */
/* by a SPICELIB routine and the error handling is not set to abort. */
while(sfnd && ! failed_()) {
ckpfs_(&handle, descr, sclkdp, tol, &needav, cmat, av, clkout, &pfnd);
if (pfnd) {
/* Found one. If the C-matrix doesn't already rotate from the */
/* requested frame, convert it to one that does. */
dafus_(descr, &c__2, &c__6, dcd, icd);
refseg = icd[1];
/* Look up the id code for the requested reference frame. */
zznamfrm_(svctr1, svref, &svrefr, ref, &refreq, (ftnlen)32,
ref_len);
if (refreq != refseg) {
/* We may need to convert the output ticks CLKOUT to ET */
/* so that we can get the needed state transformation */
/* matrix. This is the case if either of the frames */
/* is non-inertial. */
frinfo_(&refreq, ¢er, &type1, &typeid, &gotit);
frinfo_(&refseg, ¢er, &type2, &typeid, &gotit);
if (type1 == 1 && type2 == 1) {
/* Any old value of ET will do in this case. We'll */
/* use zero. */
et = 0.;
} else {
/* Look up the spacecraft clock id to use to convert */
/* the output CLKOUT to ET. */
ckmeta_(inst, "SCLK", &sclk, (ftnlen)4);
sct2e_(&sclk, clkout, &et);
}
/* Get the transformation from the requested frame to */
/* the segment frame at ET. */
refchg_(&refreq, &refseg, &et, rot);
/* If REFCHG detects that the reference frame is invalid */
/* then return from this routine with FOUND equal to false. */
if (failed_()) {
chkout_("CKGP", (ftnlen)4);
return 0;
}
/* Transform the attitude information: convert CMAT so that */
/* it maps from request frame to C-matrix frame. */
mxm_(cmat, rot, tmpmat);
moved_(tmpmat, &c__9, cmat);
}
*found = TRUE_;
chkout_("CKGP", (ftnlen)4);
return 0;
}
cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
}
/* $Procedure EDTCMD ( Edit a file using a specified text editor ) */
/* Subroutine */ int edtcmd_(char *cmd, char *file, ftnlen cmd_len, ftnlen
file_len)
{
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer rtrim_(char *, ftnlen);
char loccmd[255];
extern /* Subroutine */ int chkout_(char *, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int exesys_(char *, ftnlen);
/* $ Abstract */
/* Edit a file using a specified editor. */
/* $ 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 */
/* SYSTEM */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CMD I Command string used to invoke editor. */
/* FILE I Name of file to edit. */
/* $ Detailed_Input */
/* CMD is a character string containing the command */
/* used to invoke a text editor available on the */
/* system under which the calling program is running. */
/* This routine will invoke the specified editor */
/* using FILE as the target file to edit. The name */
/* of the file to be edited is not included in the */
/* command; this name is input as a separate argument. */
/* Case sensitivity of CMD varies with the system on */
/* which the calling program is run. */
/* Trailing white space in CMD is not significant. */
/* FILE is the name of a file that is to be edited. FILE */
/* need not exist at the time this routine is called. */
/* Case sensitivity of FILE varies with the system on */
/* which the calling program is run. */
/* Trailing white space in FILE is not significant. */
/* $ Detailed_Output */
/* None. See $Particulars for further information on the action of */
/* this routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the specified edit command fails, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) If the editing session started by this routine is terminated */
/* abnormally, the effect on the operation of the calling program */
/* is unspecified. */
/* $ Files */
/* See $Particulars. */
/* $ Particulars */
/* This routine should be used with caution; calls to this routine */
/* may have unintended side effects on the operation of the calling */
/* program. A solid understanding of the global operation of the */
/* calling program is a prerequisite for programmers wishing to */
/* use this routine. */
/* The input argument FILE should unambiguously designate a file */
/* that can be edited by the specified editor on the system under */
/* which the calling program is being run. The calling program */
/* should have read or write privileges consistent with the intended */
/* mode of access to FILE. */
/* This routine may fail to recover in a predictable fashion from */
/* abnormal termination of an editing session. */
/* $ Examples */
/* 1) On a VAX/VMS system, the EDT editor could be invoked by */
/* the calls */
/* CALL EDTCMD ( 'EDIT/EDT', FILE ) */
/* or */
/* CALL EDTCMD ( 'EDIT/EDT/COMMAND = <command file>', FILE ) */
/* 2) On a Unix system, the emacs editor could be invoked */
/* (normally) by the calls */
/* CALL EDTCMD ( 'emacs', FILE ) */
/* or */
/* CALL EDTCMD ( '/usr/bin/emacs', FILE ) */
/* $ Restrictions */
/* 1) The means by which this routine invokes an editor are system- */
/* dependent; invoking the editor may have side effects that */
/* affect the operation of the calling program. For example, */
/* on Unix systems, this routine may start a new shell in which */
/* to run the editor; starting a new shell may interfere with */
/* any sequential file I/O in progress at the time the shell is */
/* started. */
/* See the code for implementation details. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 2.22.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - Beta Version 2.21.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - Beta Version 2.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - Beta Version 2.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - Beta Version 2.18.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - Beta Version 2.17.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - Beta Version 2.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - Beta Version 2.15.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - Beta Version 2.14.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - Beta Version 2.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - Beta Version 2.12.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - Beta Version 2.11.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - Beta Version 2.10.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - Beta Version 2.9.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - Beta Version 2.8.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - Beta Version 2.7.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - Beta Version 2.6.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - Beta Version 2.5.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - Beta Version 2.4.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - Beta Version 2.3.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - Beta Version 2.2.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - Beta Version 2.2.4, 08-OCT-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are WIN-NT */
/* - Beta Version 2.2.3, 20-SEP-1999 (NJB) */
/* CSPICE and PC-LINUX environment lines were added. Some */
/* typos were corrected. */
/* - Beta Version 2.2.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - Beta Version 2.2.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - Beta Version 2.2.0, 12-AUG-1996 (WLT) */
/* Added DEC-OSF1 to the list of supported environments */
/* - Beta Version 2.1.0, 10-JAN-1996 (WLT) */
/* Added PC-LAHEY to the list of supported environments. */
/* - Beta Version 2.0.0, 16-JUN-1995 (WLT)(HAN) */
/* Created master file from collection of machine dependent */
/* routines. Copyright notice added. */
/* - Beta Version 1.0.0, 16-AUG-1994 (NJB) */
/* -& */
/* $ Index_Entries */
/* invoke a text editor within a program */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("EDTCMD", (ftnlen)6);
}
/* VAX: */
/* Computer: VAX 11/780 */
/* Operating System: VAX VMS 5.3 */
/* Fortran: VAX FORTRAN 5.5 */
/* PC-MS: */
/* Computer: PC */
/* Operating System: Microsoft DOS 5.00 */
/* Fortran: Microsoft Powerstation Fortran V1.0 */
/* Build the edit command to be passed to the system. */
s_copy(loccmd, cmd, (ftnlen)255, cmd_len);
suffix_(file, &c__1, loccmd, file_len, (ftnlen)255);
/* Invoke the editor. */
exesys_(loccmd, rtrim_(loccmd, (ftnlen)255));
chkout_("EDTCMD", (ftnlen)6);
return 0;
} /* edtcmd_ */
/* $Procedure TIPBOD ( Transformation, inertial position to bodyfixed ) */
/* Subroutine */ int tipbod_(char *ref, integer *body, doublereal *et,
doublereal *tipm, ftnlen ref_len)
{
doublereal ref2j[9] /* was [3][3] */;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
extern logical failed_(void);
extern /* Subroutine */ int bodmat_(integer *, doublereal *, doublereal *)
, chkout_(char *, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern /* Subroutine */ int irftrn_(char *, char *, doublereal *, ftnlen,
ftnlen);
extern logical return_(void);
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Return a 3x3 matrix that transforms positions in inertial */
/* coordinates to positions in body-equator-and-prime-meridian */
/* coordinates. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PCK */
/* NAIF_IDS */
/* ROTATION */
/* TIME */
/* $ Keywords */
/* TRANSFORMATION */
/* ROTATION */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* REF I ID of inertial reference frame to transform from. */
/* BODY I ID code of body. */
/* ET I Epoch of transformation. */
/* TIPM O Transformation (position), inertial to prime */
/* meridian. */
/* $ Detailed_Input */
/* REF is the NAIF name for an inertial reference frame. */
/* Acceptable names include: */
/* Name Description */
/* -------- -------------------------------- */
/* 'J2000' Earth mean equator, dynamical */
/* equinox of J2000 */
/* 'B1950' Earth mean equator, dynamical */
/* equinox of B1950 */
/* 'FK4' Fundamental Catalog (4) */
/* 'DE-118' JPL Developmental Ephemeris (118) */
/* 'DE-96' JPL Developmental Ephemeris ( 96) */
/* 'DE-102' JPL Developmental Ephemeris (102) */
/* 'DE-108' JPL Developmental Ephemeris (108) */
/* 'DE-111' JPL Developmental Ephemeris (111) */
/* 'DE-114' JPL Developmental Ephemeris (114) */
/* 'DE-122' JPL Developmental Ephemeris (122) */
/* 'DE-125' JPL Developmental Ephemeris (125) */
/* 'DE-130' JPL Developmental Ephemeris (130) */
/* 'GALACTIC' Galactic System II */
/* 'DE-200' JPL Developmental Ephemeris (200) */
/* 'DE-202' JPL Developmental Ephemeris (202) */
/* (See the routine CHGIRF for a full list of names.) */
/* The output TIPM will give the transformation */
/* from this frame to the bodyfixed frame specified by */
/* BODY at the epoch specified by ET. */
/* BODY is the integer ID code of the body for which the */
/* position transformation matrix is requested. Bodies */
/* are numbered according to the standard NAIF */
/* numbering scheme. The numbering scheme is */
/* explained in the NAIF_IDS required reading file. */
/* ET is the epoch at which the position transformation */
/* matrix is requested. (This is typically the */
/* epoch of observation minus the one-way light time */
/* from the observer to the body at the epoch of */
/* observation.) */
/* $ Detailed_Output */
/* TIPM is a 3x3 coordinate transformation matrix. It is */
/* used to transform positions from inertial */
/* coordinates to body fixed (also called equator and */
/* prime meridian --- PM) coordinates. */
/* Given a position P in the inertial reference frame */
/* specified by REF, the corresponding bodyfixed */
/* position is given by the matrix vector product: */
/* TIPM * S */
/* The X axis of the PM system is directed to the */
/* intersection of the equator and prime meridian. */
/* The Z axis points along the spin axis and points */
/* towards the same side of the invariable plane of */
/* the solar system as does earth's north pole. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the kernel pool does not contain all of the data required */
/* for computing the transformation matrix, TIPM, the error */
/* SPICE(INSUFFICIENTANGLES) is signalled. */
/* 2) If the reference frame, REF, is not recognized, a routine */
/* called by TIPBOD will diagnose the condition and invoke the */
/* SPICE error handling system. */
/* 3) If the specified body code, BODY, is not recognized, the */
/* error is diagnosed by a routine called by TIPBOD. */
/* $ Files */
/* None. */
/* $ Particulars */
/* TIPBOD takes PCK information as input, either in the */
/* form of a binary or text PCK file. High precision */
/* binary files are searched for first (the last loaded */
/* file takes precedence); then it defaults to the text */
/* PCK file. If binary information is found for the */
/* requested body and time, the Euler angles are */
/* evaluated and the transformation matrix is calculated */
/* from them. Using the Euler angles PHI, DELTA and W */
/* we compute */
/* TIPM = [W] [DELTA] [PHI] */
/* 3 1 3 */
/* If no appropriate binary PCK files have been loaded, */
/* the text PCK file is used. Here information is found */
/* as RA, DEC and W (with the possible addition of nutation */
/* and libration terms for satellites). Again, the Euler */
/* angles are found, and the transformation matrix is */
/* calculated from them. The transformation from inertial to */
/* bodyfixed coordinates is represented as: */
/* TIPM = [W] [HALFPI-DEC] [RA+HALFPI] */
/* 3 1 3 */
/* These are basically the Euler angles, PHI, DELTA and W: */
/* RA = PHI - HALFPI */
/* DEC = HALFPI - DELTA */
/* W = W */
/* In the text file, RA, DEC, and W are defined as follows: */
/* 2 ____ */
/* RA2*t \ */
/* RA = RA0 + RA1*t/T + ------ + / a sin theta */
/* 2 ---- i i */
/* T i */
/* 2 ____ */
/* DEC2*t \ */
/* DEC = DEC0 + DEC1*t/T + ------- + / d cos theta */
/* 2 ---- i i */
/* T i */
/* 2 ____ */
/* W2*t \ */
/* W = W0 + W1*t/d + ----- + / w sin theta */
/* 2 ---- i i */
/* d i */
/* where: */
/* d = seconds/day */
/* T = seconds/Julian century */
/* a , d , and w arrays apply to satellites only. */
/* i i i */
/* theta = THETA0(i) + THETA1(i)*t/T are specific to each */
/* i */
/* planet. */
/* These angles -- typically nodal rates -- vary in number and */
/* definition from one planetary system to the next. */
/* $ Examples */
/* Note that the items necessary to compute the Euler angles */
/* must have been loaded into the kernel pool (by one or more */
/* previous calls to FURNSH). The Euler angles are typically */
/* stored in the P_constants kernel file that comes with */
/* SPICELIB. */
/* 1) In the following code fragment, TIPBOD is used to transform */
/* a position in J2000 inertial coordinates to a state in */
/* bodyfixed coordinates. */
/* The 3-vectors POSTN represents the inertial position */
/* of an object with respect to the center of the */
/* body at time ET. */
/* C */
/* C First load the kernel pool. */
/* C */
/* CALL FURNSH ( 'PLANETARY_CONSTANTS.KER' ) */
/* C */
/* C Next get the transformation and its derivative. */
/* C */
/* CALL TIPBOD ( 'J2000', BODY, ET, TIPM ) */
/* C */
/* C Convert position, the first three elements of */
/* C STATE, to bodyfixed coordinates. */
/* C */
/* CALL MXVG ( TIPM, POSTN, BDPOS ) */
/* $ Restrictions */
/* The kernel pool must be loaded with the appropriate */
/* coefficients (from the P_constants kernel or binary PCK file) */
/* prior to calling this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. Replaced header references to LDPOOL with */
/* references to FURNSH. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. */
/* - SPICELIB Version 1.0.3, 10-MAR-1994 (KSZ) */
/* Underlying BODMAT code changed to look for binary PCK */
/* data files, and use them to get orientation information if */
/* they are available. Only the comments to TIPBOD changed. */
/* - SPICELIB Version 1.0.2, 06-JUL-1993 (HAN) */
/* Example in header was corrected. Previous version had */
/* incorrect matrix dimension specifications passed to MXVG. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 05-AUG-1991 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* transformation from inertial position to bodyfixed */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 06-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. Replaced header references to LDPOOL with */
/* references to FURNSH. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. The new checks */
/* are intended to prevent arithmetic operations from */
/* being performed with uninitialized or invalid data. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("TIPBOD", (ftnlen)6);
}
/* Get the transformation from the inertial from REF to J2000 */
/* coordinates. */
irftrn_(ref, "J2000", ref2j, ref_len, (ftnlen)5);
/* Get the transformation from J2000 to body-fixed coordinates */
/* for the requested epoch. */
bodmat_(body, et, tipm);
if (failed_()) {
chkout_("TIPBOD", (ftnlen)6);
return 0;
}
/* Compose the transformations to arrive at the REF-to-J2000 */
/* transformation. */
mxm_(tipm, ref2j, tmpmat);
moved_(tmpmat, &c__9, tipm);
/* That's all folks. Check out and get out. */
chkout_("TIPBOD", (ftnlen)6);
return 0;
} /* tipbod_ */
/* $Procedure PJELPL ( Project ellipse onto plane ) */
/* Subroutine */ int pjelpl_(doublereal *elin, doublereal *plane, doublereal *
elout)
{
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal const__;
extern /* Subroutine */ int vperp_(doublereal *, doublereal *, doublereal
*), vprjp_(doublereal *, doublereal *, doublereal *), el2cgv_(
doublereal *, doublereal *, doublereal *, doublereal *), cgv2el_(
doublereal *, doublereal *, doublereal *, doublereal *), pl2nvc_(
doublereal *, doublereal *, doublereal *);
doublereal prjvc1[3], prjvc2[3], center[3], normal[3], smajor[3];
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal prjctr[3], sminor[3];
extern logical return_(void);
/* $ Abstract */
/* Project an ellipse onto a plane, orthogonally. */
/* $ 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 */
/* ELLIPSES */
/* PLANES */
/* $ Keywords */
/* ELLIPSE */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ELIN I A SPICELIB ellipse to be projected. */
/* PLANE I A plane onto which ELIN is to be projected. */
/* ELOUT O A SPICELIB ellipse resulting from the projection. */
/* $ Detailed_Input */
/* ELIN, */
/* PLANE are, respectively, a SPICELIB ellipse and a */
/* SPICELIB plane. The geometric ellipse represented */
/* by ELIN is to be orthogonally projected onto the */
/* geometric plane represented by PLANE. */
/* $ Detailed_Output */
/* ELOUT is a SPICELIB ellipse that represents the geometric */
/* ellipse resulting from orthogonally projecting the */
/* ellipse represented by INEL onto the plane */
/* represented by PLANE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input plane is invalid, the error will be diagnosed */
/* by routines called by this routine. */
/* 2) The input ellipse may be degenerate--its semi-axes may be */
/* linearly dependent. Such ellipses are allowed as inputs. */
/* 3) The ellipse resulting from orthogonally projecting the input */
/* ellipse onto a plane may be degenerate, even if the input */
/* ellipse is not. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Projecting an ellipse orthogonally onto a plane can be thought of */
/* finding the points on the plane that are `under' or `over' the */
/* ellipse, with the `up' direction considered to be perpendicular */
/* to the plane. More mathematically, the orthogonal projection is */
/* the set of points Y in the plane such that for some point X in */
/* the ellipse, the vector Y - X is perpendicular to the plane. */
/* The orthogonal projection of an ellipse onto a plane yields */
/* another ellipse. */
/* $ Examples */
/* 1) With CENTER = ( 1.D0, 1.D0, 1.D0 ), */
/* VECT1 = ( 2.D0, 0.D0, 0.D0 ), */
/* VECT2 = ( 0.D0, 1.D0, 1.D0 ), */
/* NORMAL = ( 0.D0, 0.D0, 1.D0 ), */
/* the code fragment */
/* CALL NVC2PL ( NORMAL, 0.D0, PLANE ) */
/* CALL CGV2EL ( CENTER, VECT1, VECT2, ELIN ) */
/* CALL PJELPL ( ELIN, PLANE, ELOUT ) */
/* CALL EL2CGV ( ELOUT, PRJCTR, PRJMAJ, PRJMIN ) */
/* returns */
/* PRJCTR = ( 1.D0, 1.D0, 0.D0 ) */
/* PRJMAJ = ( 2.D0, 0.D0, 0.D0 ) */
/* PRJMIN = ( 0.D0, 1.D0, 0.D0 ) */
/* 2) With VECT1 = ( 2.D0, 0.D0, 0.D0 ), */
/* VECT2 = ( 1.D0, 1.D0, 1.D0 ), */
/* CENTER = ( 0.D0, 0.D0, 0.D0 ), */
/* NORMAL = ( 0.D0, 0.D0, 1.D0 ), */
/* the code fragment */
/* CALL NVC2PL ( NORMAL, 0.D0, PLANE ) */
/* CALL CGV2EL ( CENTER, VECT1, VECT2, ELIN ) */
/* CALL PJELPL ( ELIN, PLANE, ELOUT ) */
/* CALL EL2CGV ( ELOUT, PRJCTR, PRJMAJ, PRJMIN ) */
/* returns */
/* PRJCTR = ( 0.D0, 0.D0, 0.D0 ) */
/* PRJMAJ = ( -2.227032728823213D0, */
/* -5.257311121191336D-1, */
/* 0.D0 ) */
/* PRJMIN = ( 2.008114158862273D-1, */
/* -8.506508083520399D-1, */
/* 0.D0 ) */
/* 3) An example of actual use: Suppose we wish to compute the */
/* distance from an ellipsoid to a line. Let the line be */
/* defined by a point P and a direction vector DIRECT; the */
/* line is the set of points */
/* P + t * DIRECT, */
/* where t is any real number. Let the ellipsoid have semi- */
/* axis lengths A, B, and C. */
/* We can reduce the problem to that of finding the distance */
/* between the line and an ellipse on the ellipsoid surface by */
/* considering the fact that the surface normal at the nearest */
/* point to the line will be orthogonal to DIRECT; the set of */
/* surface points where this condition holds lies in a plane, */
/* and hence is an ellipse on the surface. The problem can be */
/* further simplified by projecting the ellipse orthogonally */
/* onto the plane defined by */
/* < X, DIRECT > = 0. */
/* The problem is then a two dimensional one: find the */
/* distance of the projected ellipse from the intersection of */
/* the line and this plane (which is necessarily one point). */
/* A `paraphrase' of the relevant code is: */
/* C Step 1. Find the candidate ellipse CAND. */
/* C NORMAL is a normal vector to the plane */
/* C containing the candidate ellipse. The */
/* C ellipse must exist, since it's the */
/* C intersection of an ellipsoid centered at */
/* C the origin and a plane containing the */
/* C origin. For this reason, we don't check */
/* C INEDPL's `found flag' FOUND below. */
/* C */
/* NORMAL(1) = DIRECT(1) / A**2 */
/* NORMAL(2) = DIRECT(2) / B**2 */
/* NORMAL(3) = DIRECT(3) / C**2 */
/* CALL NVC2PL ( NORMAL, 0.D0, CANDPL ) */
/* CALL INEDPL ( A, B, C, CANDPL, CAND, FOUND ) */
/* C */
/* C Step 2. Project the candidate ellipse onto a */
/* C plane orthogonal to the line. We'll */
/* C call the plane PRJPL and the */
/* C projected ellipse PRJEL. */
/* C */
/* CALL NVC2PL ( DIRECT, 0.D0, PRJPL ) */
/* CALL PJELPL ( CAND, PRJPL, PRJEL ) */
/* C */
/* C Step 3. Find the point on the line lying in the */
/* C projection plane, and then find the */
/* C near point PJNEAR on the projected */
/* C ellipse. Here PRJPT is the point on the */
/* C input line that lies in the projection */
/* C plane. The distance between PRJPT and */
/* C PJNEAR is DIST. */
/* CALL VPRJP ( LINEPT, PRJPL, PRJPT ) */
/* CALL NPEDPT ( PRJEL, PRJPT, PJNEAR, DIST ) */
/* C */
/* C Step 4. Find the near point PNEAR on the */
/* C ellipsoid by taking the inverse */
/* C orthogonal projection of PJNEAR; this is */
/* C the point on the candidate ellipse that */
/* C projects to PJNEAR. Note that the output */
/* C DIST was computed in step 3. */
/* C */
/* C The inverse projection of PJNEAR is */
/* C guaranteed to exist, so we don't have to */
/* C check FOUND. */
/* C */
/* CALL VPRJPI ( PJNEAR, PRJPL, CANDPL, PNEAR, FOUND ) */
/* The value of DIST returned is the distance we're looking */
/* for. */
/* The procedure described here is carried out in the routine */
/* NPEDLN. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 02-NOV-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* project ellipse onto plane */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("PJELPL", (ftnlen)6);
}
/* Find generating vectors of the input ellipse. */
el2cgv_(elin, center, smajor, sminor);
/* Find a normal vector for the input plane. */
pl2nvc_(plane, normal, &const__);
/* Find the components of the semi-axes that are orthogonal to the */
/* input plane's normal vector. The components are generating */
/* vectors for the projected plane. */
vperp_(smajor, normal, prjvc1);
vperp_(sminor, normal, prjvc2);
/* Find the projection of the ellipse's center onto the input plane. */
/* This is the center of the projected ellipse. */
/* In case the last assertion is non-obvious, note that the */
/* projection we're carrying out is the composition of a linear */
/* mapping (projection to a plane containing the origin and parallel */
/* to PLANE) and a translation mapping (adding the closest point to */
/* the origin in PLANE to every point), and both linear mappings and */
/* translations carry the center of an ellipse to the center of the */
/* ellipse's image. Let's state this using mathematical symbols. */
/* Let L be a linear mapping and let T be a translation mapping, */
/* say */
/* T(x) = x + A. */
/* Then */
/* T ( L ( center + cos(theta)smajor + sin(theta)sminor ) ) */
/* = A + L ( center + cos(theta)smajor + sin(theta)sminor ) */
/* = A + L (center) */
/* + cos(theta) L(smajor) */
/* + sin(theta) L(sminor) */
/* From the form of this last expression, we see that we have an */
/* ellipse centered at */
/* A + L (center) */
/* = T ( L (center) ) */
/* This last term is the image of the center of the original ellipse, */
/* as we wished to demonstrate. */
/* Now in the case of orthogonal projection onto a plane PL, L can be */
/* taken as the orthogonal projection onto a parallel plane PL' */
/* containing the origin. Then L is a linear mapping. Let M be */
/* the multiple of the normal vector of PL such that M is contained */
/* in PL (M is the closest point in PL to the origin). Then the */
/* orthogonal projection mapping onto PL, which we will name PRJ, */
/* can be defined by */
/* PRJ (x) = L (x) + M. */
/* So PRJ is the composition of a translation and a linear mapping, */
/* as claimed. */
vprjp_(center, plane, prjctr);
/* Put together the projected ellipse. */
cgv2el_(prjctr, prjvc1, prjvc2, elout);
chkout_("PJELPL", (ftnlen)6);
return 0;
} /* pjelpl_ */
/* $Procedure SBINIT ( String buffer, initialize ) */
/* Subroutine */ int sbinit_1__(integer *nsize, integer *psize, integer *vdim,
char *names, integer *ptrs, char *buffer, ftnlen names_len, ftnlen
buffer_len)
{
extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen), ssizec_(integer *, char *,
ftnlen);
integer maxptr;
extern logical return_(void);
extern /* Subroutine */ int lbinit_1__(integer *, integer *, integer *,
char *, ftnlen);
/* $ Abstract */
/* $ 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 */
/* CB, LB, SB */
/* $ Keywords */
/* ASCII */
/* CHARACTER */
/* STRING */
/* TEXT */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* NSIZE I Name size. */
/* PSIZE I Pointer size. */
/* VDIM I Value dimension */
/* NAMES, */
/* PTRS, */
/* BUFFER I,O String buffer. */
/* $ Detailed_Input */
/* NAMES is a character cell array to be used as the name */
/* component of a string buffer. */
/* NSIZE is the declared dimension of NAMES. */
/* PTRS is an integer cell array to be used as the pointer */
/* component of a string buffer. */
/* PSIZE is the declared dimension of PTRS. */
/* BUFFER is a character buffer array to be used as the */
/* character component of a string buffer. */
/* VDIM is the declared dimension of BUFFER. */
/* $ Detailed_Output */
/* NAMES, */
/* PTRS, */
/* BUFFER together are an initialized string buffer. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If the size of the pointer array is not sufficient to */
/* hold pointers for the maximum number of strings, the */
/* error 'SPICE(SBINSUFPTRSIZE)' is signalled. */
/* $ Particulars */
/* A string buffer must be initialized to allow subsequent */
/* operations on the buffer to detect possible overflows. */
/* All three components of the buffer are initialized by a */
/* single call to SBINIT. */
/* In order to make full use of the name cell of the string buffer, */
/* the arrays and name buffers should be declared as shown below. */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXNL */
/* PARAMETER ( MAXNL = maximum name length ) */
/* INTEGER MAXN */
/* PARAMETER ( MAXN = maximum number of names ) */
/* CHARACTER*(MAXNL) NAMES ( MAXN ) */
/* INTEGER PTRS ( MAXN * 4 + 4 ) */
/* The character buffer portion of the string buffer should be */
/* declared as shown below. */
/* INTEGER MAXL */
/* PARAMETER ( MAXL = maximum expected string length ) */
/* INTEGER AVGL */
/* PARAMETER ( AVGL = average expected string length ) */
/* INTEGER LBCBUF */
/* PARAMETER ( LBCBUF = 0 ) */
/* CHARACTER*(MAXL) BUFFER ( LBCBUF:(MAXN * AVGL) / MAXL + 1 ) */
/* $ Examples */
/* The following code fragment illustrates the initialization */
/* of a typical string buffer. */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER LBCBUF */
/* PARAMETER ( LBCBUF = 0 ) */
/* CHARACTER*(32) NAMES ( LBCELL:1000 ) */
/* INTEGER PTRS ( LBCELL:4004 ) */
/* CHARACTER*(250) BUFFER ( LBCBUF:100 ) */
/* . */
/* . */
/* CALL SBINIT ( MAXN, PSIZE, BUFDIM, NAMES, PTRS, BUFFER ) */
/* In this example, the buffer may be used to store up to 1000 */
/* strings averaging 25 characters per string, or 25,000 total */
/* characters. The length of any particular string may range from */
/* a single character to the entire 25,000 characters. The names */
/* used to identify the strings may contain up to 32 characters. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* Dagny Taggart, (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 19-JAN-1989 (DT) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard error handling. */
if (return_()) {
return 0;
} else {
chkin_("SBINIT_1", (ftnlen)8);
}
/* Make sure that the line buffer is large enough (but ONLY large */
/* enough) to hold the maximum number of strings. The name list */
/* should be empty. The LB should be initialized as a unit. */
maxptr = *nsize + 1 << 2;
if (*psize < maxptr) {
sigerr_("SPICE(SBINSUFPTRSIZE)", (ftnlen)21);
} else {
ssizec_(nsize, names, names_len);
lbinit_1__(&maxptr, vdim, ptrs, buffer, buffer_len);
}
chkout_("SBINIT_1", (ftnlen)8);
return 0;
} /* sbinit_1__ */
/* $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 SIZEC ( Size of a character cell ) */
integer sizec_(char *cell, ftnlen cell_len)
{
/* System generated locals */
integer ret_val;
/* Local variables */
integer card, size;
extern /* Subroutine */ int chkin_(char *, ftnlen), dechar_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Return the size (maximum cardinality) of a character cell. */
/* $ 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 */
/* $ Keywords */
/* CELLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* CELL I Input cell. */
/* The function returns the size of the input cell. */
/* $ Detailed_Input */
/* CELL is a cell. */
/* $ Detailed_Output */
/* The function returns the size of (maximum number of elements in) */
/* the input cell. */
/* $ Parameters */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* The size (SIZE) functions are typically used in conjunction */
/* with the cardinality functions to predict (and subsequently */
/* avoid) overflows when manipulating cells. In the following */
/* example, SIZEI is used to determine whether the integer cell */
/* ORIGINAL can be safely copied into the integer cell SAVE before */
/* actually attempting the operation. (If ORIGINAL contains more */
/* elements than SAVE is capable of holding, then the operation */
/* will fail.) */
/* IF ( CARDI ( ORIGINAL ) .LE. SIZEI ( SAVE ) ) THEN */
/* CALL COPYI ( ORIGINAL, SAVE, ERROR ) */
/* ELSE */
/* . */
/* . */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Exceptions */
/* 1) If the input array has invalid cardinality, the error */
/* SPICE(INVALIDCARDINALITY) is signalled. SIZEC returns */
/* an unspecified value in this case. */
/* 2) If the input array has invalid size, the error */
/* SPICE(INVALIDSIZE) is signalled. SIZEC returns */
/* an unspecified value in this case. */
/* $ Files */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* C.A. Curzon (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */
/* If the value of the function RETURN is TRUE upon execution of */
/* this module, this function is assigned a default value of */
/* either 0, 0.0D0, .FALSE., or blank depending on the type of the */
/* function. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* size of a character cell */
/* -& */
/* $ Revisions */
/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */
/* Check for valid input cell added. The input cell must */
/* have valid size and cardinality values. */
/* -& */
/* SPICELIB functions */
/* Local variables */
if (return_()) {
ret_val = 0;
return ret_val;
} else {
chkin_("SIZEC", (ftnlen)5);
}
/* Set return value, regardless of validity. */
dechar_(cell + (cell_len << 2), &size, cell_len);
ret_val = size;
/* Squeal if something is awry. */
dechar_(cell + cell_len * 5, &card, cell_len);
if (size < 0) {
setmsg_("Invalid cell size. The size was #.", (ftnlen)35);
errint_("#", &size, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("SIZEC", (ftnlen)5);
return ret_val;
} else if (card < 0) {
setmsg_("Invalid cell cardinality. The cardinality was #.", (ftnlen)
49);
errint_("#", &card, (ftnlen)1);
sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25);
chkout_("SIZEC", (ftnlen)5);
return ret_val;
} else if (card > size) {
setmsg_("Invalid cell cardinality; cardinality exceeds cell size. T"
"he cardinality was #. The size was #.", (ftnlen)97);
errint_("#", &card, (ftnlen)1);
errint_("#", &size, (ftnlen)1);
sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25);
chkout_("SIZEC", (ftnlen)5);
return ret_val;
}
chkout_("SIZEC", (ftnlen)5);
return ret_val;
} /* sizec_ */
/* $Procedure BODFND ( Find values from the kernel pool ) */
logical bodfnd_(integer *body, char *item, ftnlen item_len)
{
/* System generated locals */
logical ret_val;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char code[16];
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
logical found;
char dtype[1], varnam[32];
extern /* Subroutine */ int chkout_(char *, ftnlen), dtpool_(char *,
logical *, integer *, char *, ftnlen, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
/* $ Abstract */
/* Determine whether values exist for some item for any body */
/* in the kernel pool. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* KERNEL */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ITEM I Item to find ('RADII', 'NUT_AMP_RA', etc.). */
/* $ Detailed_Input */
/* BODY is the ID code of the body for which the item is */
/* requested. Bodies are numbered according to the */
/* standard NAIF numbering scheme. */
/* ITEM is the item to be returned. Together, the body and */
/* item name combine to form a variable name, e.g., */
/* 'BODY599_RADII' */
/* 'BODY4_POLE_RA' */
/* $ Detailed_Output */
/* The result is TRUE if the item is in the kernel pool, */
/* and is FALSE if it is not. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* BODVCD, which returns values from the kernel pool, causes an */
/* error to be signalled whenever the specified item is not found. */
/* In many cases, this is appropriate. However, sometimes the */
/* program may attempt to recover, by providing default values, */
/* prompting for replacements, and so on. */
/* $ Examples */
/* In the following example, default values are substituted for */
/* bodies for which axes are not found. */
/* IF ( BODFND ( TARGET, 'RADII' ) ) THEN */
/* CALL BODVCD ( TARGET, 'RADII', 3, N, RADII ) */
/* ELSE */
/* CALL VPACK ( 100.D0, 100.D0, 100.D0, RADII ) */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Refer to the SPK required reading file for a complete list of */
/* the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.1, 24-OCT-2005 (NJB) */
/* Header update: calls to BODVAR in example code were replaced */
/* with calls to BODVCD. The string 'AXES' and variable AXES */
/* were replaced with the string 'RADII' and variable 'RADII' */
/* throughout the header. */
/* - SPICELIB Version 1.2.0, 15-MAR-2002 (NJB) */
/* Bug fix: routine was updated to work with string-valued */
/* kernel variables. */
/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */
/* If the value of the function RETURN is TRUE upon execution of */
/* this module, this function is assigned a default value of */
/* either 0, 0.0D0, .FALSE., or blank depending on the type of */
/* the function. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* find constants for a body in the kernel pool */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
ret_val = FALSE_;
return ret_val;
} else {
chkin_("BODFND", (ftnlen)6);
}
/* Construct the variable name from BODY and ITEM. */
s_copy(varnam, "BODY", (ftnlen)32, (ftnlen)4);
intstr_(body, code, (ftnlen)16);
suffix_(code, &c__0, varnam, (ftnlen)16, (ftnlen)32);
suffix_("_", &c__0, varnam, (ftnlen)1, (ftnlen)32);
suffix_(item, &c__0, varnam, item_len, (ftnlen)32);
/* Search the kernel pool for the item. */
dtpool_(varnam, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
/* Was anything there? */
ret_val = found;
chkout_("BODFND", (ftnlen)6);
return ret_val;
} /* bodfnd_ */
/* $Procedure DVSEP ( Derivative of separation angle ) */
doublereal dvsep_(doublereal *s1, doublereal *s2)
{
/* System generated locals */
doublereal ret_val, d__1;
/* Local variables */
extern doublereal vdot_(doublereal *, doublereal *);
doublereal numr;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal denom;
extern /* Subroutine */ int dvhat_(doublereal *, doublereal *), vcrss_(
doublereal *, doublereal *, doublereal *);
extern doublereal vnorm_(doublereal *), zzdiv_(doublereal *, doublereal *)
;
extern logical vzero_(doublereal *);
doublereal u1[6], u2[6];
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal pcross[3];
extern logical return_(void);
/* $ Abstract */
/* Calculate the time derivative of the separation angle between */
/* two input states, S1 and S2. */
/* $ 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 */
/* GEOMETRY */
/* DERIVATIVES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* S1 I State vector of the first body. */
/* S2 I State vector of the second body. */
/* $ Detailed_Input */
/* S1 the state vector of the first target body as seen from */
/* the observer. */
/* S2 the state vector of the second target body as seen from */
/* the observer. */
/* An implicit assumption exists that both states lie in the same */
/* reference frame with the same observer for the same epoch. If this */
/* is not the case, the numerical result has no meaning. */
/* $ Detailed_Output */
/* The function returns the double precision value of the time */
/* derivative of the angular separation between S1 and S2. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) The routine in the call tree of this routine signal errors for */
/* numeric overflow and underflow cases. */
/* 2) If called in RETURN mode, the return has value 0. */
/* 3) Linear dependent position components of S1 and S1 constitutes */
/* a non-error exception. The function returns 0 for this case. */
/* $ Files */
/* None. */
/* $ Particulars */
/* In this discussion, the notation */
/* < V1, V2 > */
/* indicates the dot product of vectors V1 and V2. The notation */
/* V1 x V2 */
/* indicates the cross product of vectors V1 and V2. */
/* To start out, note that we need consider only unit vectors, */
/* since the angular separation of any two non-zero vectors */
/* equals the angular separation of the corresponding unit vectors. */
/* Call these vectors U1 and U2; let their velocities be V1 and V2. */
/* For unit vectors having angular separation */
/* THETA */
/* the identity */
/* || U1 x U1 || = ||U1|| * ||U2|| * sin(THETA) (1) */
/* reduces to */
/* || U1 x U2 || = sin(THETA) (2) */
/* and the identity */
/* | < U1, U2 > | = || U1 || * || U2 || * cos(THETA) (3) */
/* reduces to */
/* | < U1, U2 > | = cos(THETA) (4) */
/* Since THETA is an angular separation, THETA is in the range */
/* 0 : Pi */
/* Then letting s be +1 if cos(THETA) > 0 and -1 if cos(THETA) < 0, */
/* we have for any value of THETA other than 0 or Pi */
/* 2 1/2 */
/* cos(THETA) = s * ( 1 - sin (THETA) ) (5) */
/* or */
/* 2 1/2 */
/* < U1, U2 > = s * ( 1 - sin (THETA) ) (6) */
/* At this point, for any value of THETA other than 0 or Pi, */
/* we can differentiate both sides with respect to time (T) */
/* to obtain */
/* 2 -1/2 */
/* < U1, V2 > + < V1, U2 > = s * (1/2)(1 - sin (THETA)) */
/* * (-2) sin(THETA)*cos(THETA) */
/* * d(THETA)/dT (7a) */
/* Using equation (5), and noting that s = 1/s, we can cancel */
/* the cosine terms on the right hand side */
/* -1 */
/* < U1, V2 > + < V1, U2 > = (1/2)(cos(THETA)) */
/* * (-2) sin(THETA)*cos(THETA) */
/* * d(THETA)/dT (7b) */
/* With (7b) reducing to */
/* < U1, V2 > + < V1, U2 > = - sin(THETA) * d(THETA)/dT (8) */
/* Using equation (2) and switching sides, we obtain */
/* || U1 x U2 || * d(THETA)/dT = - < U1, V2 > - < V1, U2 > (9) */
/* or, provided U1 and U2 are linearly independent, */
/* d(THETA)/dT = ( - < U1, V2 > - < V1, U2 > ) / ||U1 x U2|| (10) */
/* Note for times when U1 and U2 have angular separation 0 or Pi */
/* radians, the derivative of angular separation with respect to */
/* time doesn't exist. (Consider the graph of angular separation */
/* with respect to time; typically the graph is roughly v-shaped at */
/* the singular points.) */
/* $ Examples */
/* PROGRAM DVSEP_T */
/* IMPLICIT NONE */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION DSEPT */
/* DOUBLE PRECISION STATEE (6) */
/* DOUBLE PRECISION STATEM (6) */
/* INTEGER STRLEN */
/* PARAMETER ( STRLEN = 64 ) */
/* CHARACTER*(STRLEN) BEGSTR */
/* DOUBLE PRECISION DVSEP */
/* C */
/* C Load kernels. */
/* C */
/* CALL FURNSH ('standard.tm') */
/* C */
/* C An arbitrary time. */
/* C */
/* BEGSTR = 'JAN 1 2009' */
/* CALL STR2ET( BEGSTR, ET ) */
/* C */
/* C Calculate the state vectors sun to Moon, sun to earth at ET. */
/* C */
/* C */
/* CALL SPKEZR ( 'EARTH', ET, 'J2000', 'NONE', 'SUN', */
/* . STATEE, LT) */
/* CALL SPKEZR ( 'MOON', ET, 'J2000', 'NONE', 'SUN', */
/* . STATEM, LT) */
/* C */
/* C Calculate the time derivative of the angular separation of */
/* C the earth and Moon as seen from the sun at ET. */
/* C */
/* DSEPT = DVSEP( STATEE, STATEM ) */
/* WRITE(*,*) 'Time derivative of angular separation: ', DSEPT */
/* END */
/* The program compiled on OS X with g77 outputs (radians/sec): */
/* Time derivative of angular separation: 3.81211936E-09 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 21-MAR-2014 (EDW) */
/* Reimplemented algorithm using ZZDIV. */
/* - SPICELIB Version 1.0.1, 15-MAR-2010 (EDW) */
/* Trivial header format clean-up. */
/* - SPICELIB Version 1.0.0, 31-MAR-2009 (EDW) */
/* -& */
/* $ Index_Entries */
/* time derivative of angular separation */
/* -& */
/* SPICELIB functions */
/* Local variables */
if (return_()) {
ret_val = 0.;
return ret_val;
}
chkin_("DVSEP", (ftnlen)5);
/* Compute the unit vectors and corresponding time derivatives */
/* for the input state vectors. */
dvhat_(s1, u1);
dvhat_(s2, u2);
/* Calculate the cross product vector of U1 and U2. As both vectors */
/* have magnitude one, the magnitude of the cross product equals */
/* sin(THETA), with THETA the angle between S1 and S2. */
vcrss_(u1, u2, pcross);
/* Handle the parallel and anti-parallel cases. */
if (vzero_(pcross)) {
ret_val = 0.;
chkout_("DVSEP", (ftnlen)5);
return ret_val;
}
/* Now calculate the time derivative of the angular separation */
/* between S1 and S2. */
/* Separately calculate the numerator and denominator. */
numr = vdot_(u1, &u2[3]) + vdot_(&u1[3], u2);
denom = vnorm_(pcross);
/* ZZDIV checks for over- or underflow. Finite precision */
/* arithmetic is a pain. */
d__1 = -numr;
ret_val = zzdiv_(&d__1, &denom);
/* Return, the expectation exists that a FAILED() call */
/* follows the DVSEP call. */
chkout_("DVSEP", (ftnlen)5);
return ret_val;
} /* dvsep_ */
/* $Procedure SPKR02 ( SPK, read record from segment, type 2 ) */
/* Subroutine */ int spkr02_(integer *handle, doublereal *descr, doublereal *
et, doublereal *record)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nrec;
doublereal init;
integer begin;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer recno;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal dc[2];
integer ic[6], recadr;
doublereal intlen;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer recsiz;
extern logical return_(void);
integer end;
/* $ Abstract */
/* Read a single SPK data record from a segment of type 2 */
/* (Chebyshev, position only). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* ET I Evaluation epoch. */
/* RECORD O Data record. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle and segment descriptor for */
/* an SPK segment of type 2. */
/* ET is an epoch for which a data record from the */
/* specified segment is required. ET is expressed as */
/* seconds past J2000 TDB. */
/* $ Detailed_Output */
/* RECORD is an array of data from the specified segment which, */
/* when evaluated at epoch ET, will give the state */
/* (position and velocity) of the target body identified */
/* by the input segment descriptor. The descriptor */
/* specifies the center of motion and reference frame of */
/* the state. */
/* The structure of the record is as follows: */
/* +--------------------------------------+ */
/* | record size (excluding this element) | */
/* +--------------------------------------+ */
/* | Coverage interval midpoint | */
/* +--------------------------------------+ */
/* | Coverage interval radius | */
/* +--------------------------------------+ */
/* | Coeffs for X position component | */
/* +--------------------------------------+ */
/* | Coeffs for Y position component | */
/* +--------------------------------------+ */
/* | Coeffs for Z position component | */
/* +--------------------------------------+ */
/* In the above record */
/* - Times are expressed as seconds past J2000 TDB. */
/* - Position components have units of km. */
/* RECORD must be declared by the caller with size large */
/* enough to accommodate the largest record that can be */
/* returned by this routine. See the INCLUDE file */
/* spkrec.inc for the correct record length. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) Any errors that occur while looking up SPK data will be */
/* diagnosed by routines in the call tree of this routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* See the SPK Required Reading file for a description of the */
/* structure of a data type 2 (Chebyshev polynomials, position */
/* only) segment. */
/* $ Examples */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRxx */
/* routines might be used to "dump" and check segment data for a */
/* particular epoch. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 2 ) THEN */
/* CALL SPKR02 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 18-JAN-2014 (NJB) */
/* Enhanced header and in-line documentation. */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */
/* SPK02 was removed from the Required_Reading section of the */
/* header. The information in the SPK02 Required Reading file */
/* is now part of the SPK Required Reading file. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* read record from type_2 spk segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKR02", (ftnlen)6);
}
/* Unpack the segment descriptor. */
dafus_(descr, &c__2, &c__6, dc, ic);
begin = ic[4];
end = ic[5];
/* The segment is made up of a number of logical records, each */
/* having the same size, and covering the same length of time. */
/* We can determine which record to return using the input epoch, */
/* the initial time of the first record's coverage interval, and the */
/* length of the interval covered by each record. These constants */
/* are located at the end of the segment, along with the size of */
/* each logical record and the total number of records. */
i__1 = end - 3;
dafgda_(handle, &i__1, &end, record);
init = record[0];
intlen = record[1];
recsiz = (integer) record[2];
nrec = (integer) record[3];
recno = (integer) ((*et - init) / intlen) + 1;
recno = min(recno,nrec);
/* Compute the address of the desired record. */
recadr = (recno - 1) * recsiz + begin;
/* Along with the record, return the size of the record. */
record[0] = record[2];
i__1 = recadr + recsiz - 1;
dafgda_(handle, &recadr, &i__1, &record[1]);
chkout_("SPKR02", (ftnlen)6);
return 0;
} /* spkr02_ */
/* $Procedure SPKE18 ( S/P Kernel, evaluate, type 18 ) */
/* Subroutine */ int spke18_(doublereal *et, doublereal *record, doublereal *
state)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer from;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
doublereal work[516] /* was [258][2] */;
integer i__, j, n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal vbuff[6];
integer to;
doublereal locrec[129];
integer packsz;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
extern doublereal lgrint_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *);
extern /* Subroutine */ int hrmint_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), setmsg_(
char *, ftnlen), errint_(char *, integer *, ftnlen), xpsgip_(
integer *, integer *, doublereal *);
extern logical return_(void);
integer xstart, subtyp, ystart;
/* $ Abstract */
/* Evaluate a single data record from a type 18 SPK 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 */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 18. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* SPK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) */
/* -& */
/* SPK type 18 subtype codes: */
/* Subtype 0: Hermite interpolation, 12-element packets, order */
/* reduction at boundaries to preceding number */
/* equivalent to 3 mod 4. */
/* Subtype 1: Lagrange interpolation, 6-element packets, order */
/* reduction at boundaries to preceding odd number. */
/* Packet sizes associated with the various subtypes: */
/* End of include file spk18.inc. */
/* $ Abstract */
/* Declare SPK data record size. This record is declared in */
/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */
/* (SPKExx) routines. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* SPK */
/* $ Restrictions */
/* 1) If new SPK types are added, it may be necessary to */
/* increase the size of this record. The header of SPKPVN */
/* should be updated as well to show the record size */
/* requirement for each data type. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */
/* -& */
/* End include file spkrec.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* MAXREC P Maximum size of SPK record. See SPKPVN. */
/* ET I Epoch for which a state is desired. */
/* RECORD I Record from a type 18 SPK segment valid for ET. */
/* STATE O State (position and velocity) at epoch ET. */
/* $ Detailed_Input */
/* ET is the epoch for which a state vector is desired. */
/* RECORD is a record from a type 18 SPK segment which, when */
/* evaluated at epoch ET, will give the state */
/* (position and velocity) of some body, relative to */
/* some center, in some inertial reference frame. */
/* The structure of the record is as follows: */
/* +----------------------+ */
/* | subtype code | */
/* +----------------------+ */
/* | number of packets (n)| */
/* +----------------------+ */
/* | packet 1 | */
/* +----------------------+ */
/* | packet 2 | */
/* +----------------------+ */
/* . */
/* . */
/* . */
/* +----------------------+ */
/* | packet n | */
/* +----------------------+ */
/* | epochs 1--n | */
/* +----------------------+ */
/* $ Detailed_Output */
/* STATE is the state vector at epoch ET. Its contents are, in */
/* order, X, Y, Z, X', Y', and Z'. Units are km and km/sec. */
/* $ Parameters */
/* MAXREC is the maximum size of SPK record. See the SPICELIB */
/* routine SPKPVN for details. */
/* $ Exceptions */
/* None. This routine assumes that the input record is valid. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The exact format and structure of type 18 (MEX/Rosetta Orbit */
/* file interpolation) SPK segments is described in the SPK */
/* Required Reading. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* The data returned by the SPKRnn routine is in a raw form, taken */
/* directly from the segment. As such, it will be not be directly */
/* useful to a user unless they have a complete understanding of the */
/* structure of the data type. Given that understanding, however, */
/* the SPKRnn routines could be used to "dump" and check segment data */
/* for a particular epoch before evaluating the record to obtain a */
/* state vector, as in the example which follows. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 18 ) THEN */
/* CALL SPKR18 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE18 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* 1) This routine assumes that the input record is valid. Any */
/* checking of the input data is assumed to have been performed */
/* when the source SPK file was created. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in XPOSEG and LGRINT calls. */
/* - SPICELIB Version 1.0.0, 17-AUG-2002 (NJB) */
/* -& */
/* $ Index_Entries */
/* evaluate type_18 spk segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in XPOSEG and LGRINT calls. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Index of subtype code in record: */
/* Index of packet count in record: */
/* Index at which packets start: */
/* Maximum polynomial degree: */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKE18", (ftnlen)6);
/* Capture the subtype from the record and set the packet size */
/* accordingly. */
subtyp = i_dnnt(record);
if (subtyp == 0) {
packsz = 12;
} else if (subtyp == 1) {
packsz = 6;
} else {
setmsg_("Unexpected SPK type 18 subtype found in type 18 record.", (
ftnlen)55);
errint_("#", &subtyp, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("SPKE18", (ftnlen)6);
return 0;
}
/* Get the packet count. */
n = i_dnnt(&record[1]);
if (subtyp == 1) {
/* This is the easy case: we perform Lagrange interpolation */
/* on each state component. */
/* We'll transpose the state information in the input record so */
/* that contiguous pieces of it can be shoved directly into the */
/* interpolation routine LGRINT. */
n = i_dnnt(&record[1]);
xpsgip_(&packsz, &n, &record[2]);
/* We interpolate each state component in turn. */
xstart = n * packsz + 3;
i__1 = packsz;
for (i__ = 1; i__ <= i__1; ++i__) {
ystart = n * (i__ - 1) + 3;
state[(i__2 = i__ - 1) < 6 && 0 <= i__2 ? i__2 : s_rnge("state",
i__2, "spke18_", (ftnlen)310)] = lgrint_(&n, &record[
xstart - 1], &record[ystart - 1], locrec, et);
}
} else {
/* We interpolate each state component in turn. Position and */
/* velocity are interpolated separately. */
xstart = packsz * n + 3;
for (i__ = 1; i__ <= 3; ++i__) {
i__1 = n;
for (j = 1; j <= i__1; ++j) {
/* For the Jth input packet, copy the Ith position and */
/* velocity components into the local record buffer LOCREC. */
from = packsz * (j - 1) + 2 + i__;
to = (j << 1) - 1;
locrec[(i__2 = to - 1) < 129 && 0 <= i__2 ? i__2 : s_rnge(
"locrec", i__2, "spke18_", (ftnlen)335)] = record[
from - 1];
locrec[(i__2 = to) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec"
, i__2, "spke18_", (ftnlen)336)] = record[from + 2];
}
/* Interpolate the Ith position and velocity components of the */
/* state. We'll keep the position and overwrite the velocity. */
hrmint_(&n, &record[xstart - 1], locrec, et, work, &state[(i__1 =
i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1,
"spke18_", (ftnlen)344)], &state[(i__2 = i__ + 2) < 6 &&
0 <= i__2 ? i__2 : s_rnge("state", i__2, "spke18_", (
ftnlen)344)]);
}
/* Now interpolate velocity, using separate velocity data and */
/* acceleration. */
for (i__ = 1; i__ <= 3; ++i__) {
i__1 = n;
for (j = 1; j <= i__1; ++j) {
/* For the Jth input packet, copy the Ith position and */
/* velocity components into the local record buffer LOCREC. */
from = packsz * (j - 1) + 2 + packsz / 2 + i__;
to = (j << 1) - 1;
locrec[(i__2 = to - 1) < 129 && 0 <= i__2 ? i__2 : s_rnge(
"locrec", i__2, "spke18_", (ftnlen)368)] = record[
from - 1];
locrec[(i__2 = to) < 129 && 0 <= i__2 ? i__2 : s_rnge("locrec"
, i__2, "spke18_", (ftnlen)369)] = record[from + 2];
}
/* Interpolate the Ith velocity and acceleration components of */
/* the state. We'll capture the result in a temporary buffer, */
/* then transfer the velocity to the output state array. */
hrmint_(&n, &record[xstart - 1], locrec, et, work, &vbuff[(i__1 =
i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("vbuff", i__1,
"spke18_", (ftnlen)378)], &vbuff[(i__2 = i__ + 2) < 6 &&
0 <= i__2 ? i__2 : s_rnge("vbuff", i__2, "spke18_", (
ftnlen)378)]);
}
/* Fill in the velocity in the output state using the results of */
/* interpolating velocity and acceleration. */
vequ_(vbuff, &state[3]);
}
chkout_("SPKE18", (ftnlen)6);
return 0;
} /* spke18_ */
/* $Procedure ZZSTELAB ( Private --- stellar aberration correction ) */
/* Subroutine */ int zzstelab_(logical *xmit, doublereal *accobs, doublereal *
vobs, doublereal *starg, doublereal *scorr, doublereal *dscorr)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal);
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
doublereal dphi, rhat[3];
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
doublereal term1[3], term2[3], term3[3], c__, lcacc[3];
integer i__;
doublereal s;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal saoff[6] /* was [3][2] */, drhat[3];
extern /* Subroutine */ int dvhat_(doublereal *, doublereal *);
doublereal ptarg[3], evobs[3], srhat[6], vphat[3], vtarg[3];
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *), vperp_(doublereal *, doublereal *,
doublereal *);
extern doublereal vnorm_(doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *), cleard_(integer *, doublereal *);
doublereal vp[3];
extern doublereal clight_(void);
doublereal dptmag, ptgmag, eptarg[3], dvphat[3], lcvobs[3];
extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_(
char *, ftnlen), setmsg_(char *, ftnlen);
doublereal svphat[6];
extern logical return_(void);
extern /* Subroutine */ int vminus_(doublereal *, doublereal *);
doublereal sgn, dvp[3], svp[6];
/* $ 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 (position and velocity) 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 */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* XMIT I Reception/transmission flag. */
/* ACCOBS I Observer acceleration relative to SSB. */
/* VOBS I Observer velocity relative to to SSB. */
/* STARG I State of target relative to observer. */
/* SCORR O Stellar aberration correction for position. */
/* DSCORR O Stellar aberration correction for velocity. */
/* $ Detailed_Input */
/* XMIT is a logical flag which is set to .TRUE. for the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at an observation epoch ET */
/* and arrive at the target's location at the light-time */
/* corrected epoch ET+LT, where LT is the one-way light */
/* time between observer and target; XMIT is set to */
/* .FALSE. for "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. */
/* Note that the observation epoch is not used in this */
/* routine. */
/* XMIT must be consistent with any light time */
/* corrections used for the input state STARG: if that */
/* state has been corrected for "reception" light time; */
/* XMIT must be .FALSE.; otherwise XMIT must be .TRUE. */
/* ACCOBS is the geometric acceleration of the observer */
/* relative to the solar system barycenter. Units are */
/* km/sec**2. ACCOBS must be expressed relative to */
/* an inertial reference frame. */
/* VOBS is the geometric velocity of the observer relative to */
/* the solar system barycenter. VOBS must be expressed */
/* relative to the same inertial reference frame as */
/* ACCOBS. Units are km/sec. */
/* STARG is the Cartesian state of the target relative to the */
/* observer. Normally STARG has been corrected for */
/* one-way light time, but this is not required. STARG */
/* must be expressed relative to the same inertial */
/* reference frame as ACCOBS. Components are */
/* (x, y, z, dx, dy, dz). Units are km and km/sec. */
/* $ Detailed_Output */
/* SCORR is the stellar aberration correction for the position */
/* component of STARG. Adding SCORR to this position */
/* vector produces the input observer-target position, */
/* corrected for stellar aberration. */
/* The reference frame of SCORR is the common frame */
/* relative to which the inputs ACCOBS, VOBS, and STARG */
/* are expressed. Units are km. */
/* DSCORR is the stellar aberration correction for the velocity */
/* component of STARG. Adding DSCORR to this velocity */
/* vector produces the input observer-target velocity, */
/* corrected for stellar aberration. */
/* The reference frame of DSCORR is the common frame */
/* relative to which the inputs ACCOBS, VOBS, and STARG */
/* are expressed. Units are km/s. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If attempt to divide by zero occurs, the error */
/* SPICE(DIVIDEBYZERO) will be signaled. This case may occur */
/* due to uninitialized inputs. */
/* 2) Loss of precision will occur for geometric cases in which */
/* VOBS is nearly parallel to the position component of STARG. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine computes a Newtonian estimate of the stellar */
/* aberration correction of an input state. Normally the input state */
/* has already been corrected for one-way light time. */
/* Since stellar aberration corrections are typically "small" */
/* relative to the magnitude of the input observer-target position */
/* and velocity, this routine avoids loss of precision by returning */
/* the corrections themselves rather than the corrected state */
/* vector. This allows the caller to manipulate (for example, */
/* interpolate) the corrections with greater accuracy. */
/* $ Examples */
/* See SPICELIB routine SPKACS. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* SPK Required Reading. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 15-APR-2014 (NJB) */
/* Added RETURN test and discovery check-in. */
/* Check for division by zero was added. This */
/* case might occur due to uninitialized inputs. */
/* - SPICELIB Version 1.0.1, 12-FEB-2009 (NJB) */
/* Minor updates were made to the inline documentation. */
/* - SPICELIB Version 1.0.0, 17-JAN-2008 (NJB) */
/* -& */
/* Note for the maintenance programmer */
/* =================================== */
/* The source code of the test utility T_ZZSTLABN must be */
/* kept in sync with the source code of this routine. That */
/* routine uses a value of SEPLIM that forces the numeric */
/* branch of the velocity computation to be taken in all */
/* cases. See the documentation of that routine for details. */
/* SPICELIB functions */
/* Local parameters */
/* Let PHI be the (non-negative) rotation angle of the stellar */
/* aberration correction; then SEPLIM is a limit on how close PHI */
/* may be to zero radians while stellar aberration velocity is */
/* computed analytically. When sin(PHI) is less than SEPLIM, the */
/* velocity must be computed numerically. */
/* Let TDELTA be the time interval, measured in seconds, */
/* used for numerical differentiation of the stellar */
/* aberration correction, when this is necessary. */
/* Local variables */
/* Use discovery check-in. */
if (return_()) {
return 0;
}
/* In the discussion below, the dot product of vectors X and Y */
/* is denoted by */
/* <X,Y> */
/* The speed of light is denoted by the lower case letter "c." BTW, */
/* variable names used here are case-sensitive: upper case "C" */
/* represents a different quantity which is unrelated to the speed */
/* of light. */
/* Variable names ending in "HAT" denote unit vectors. Variable */
/* names starting with "D" denote derivatives with respect to time. */
/* We'll compute the correction SCORR and its derivative with */
/* respect to time DSCORR for the reception case. In the */
/* transmission case, we perform the same computation with the */
/* negatives of the observer velocity and acceleration. */
/* In the code below, we'll store the position and velocity portions */
/* of the input observer-target state STARG in the variables PTARG */
/* and VTARG, respectively. */
/* Let VP be the component of VOBS orthogonal to PTARG. VP */
/* is defined as */
/* VOBS - < VOBS, RHAT > RHAT (1) */
/* where RHAT is the unit vector */
/* PTARG/||PTARG|| */
/* Then */
/* ||VP||/c (2) */
/* is the magnitude of */
/* s = sin( phi ) (3) */
/* where phi is the stellar aberration correction angle. We'll */
/* need the derivative with respect to time of (2). */
/* Differentiating (1) with respect to time yields the */
/* velocity DVP, where, letting */
/* DRHAT = d(RHAT) / dt */
/* VPHAT = VP / ||VP|| */
/* DVPMAG = d( ||VP|| ) / dt */
/* we have */
/* DVP = d(VP)/dt */
/* = ACCOBS - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */
/* + <VOBS,RHAT> * DRHAT ) (4) */
/* and */
/* DVPMAG = < DVP, VPHAT > (5) */
/* Now we can find the derivative with respect to time of */
/* the stellar aberration angle phi: */
/* ds/dt = d(sin(phi))/dt = d(phi)/dt * cos(phi) (6) */
/* Using (2) and (5), we have for positive phi, */
/* ds/dt = (1/c)*DVPMAG = (1/c)*<DVP, VPHAT> (7) */
/* Then for positive phi */
/* d(phi)/dt = (1/cos(phi)) * (1/c) * <DVP, VPHAT> (8) */
/* Equation (8) is well-defined as along as VP is non-zero: */
/* if VP is the zero vector, VPHAT is undefined. We'll treat */
/* the singular and near-singular cases separately. */
/* The aberration correction itself is a rotation by angle phi */
/* from RHAT towards VP, so the corrected vector is */
/* ( sin(phi)*VPHAT + cos(phi)*RHAT ) * ||PTARG|| */
/* and we can express the offset of the corrected vector from */
/* PTARG, which is the output SCORR, as */
/* SCORR = */
/* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| (9) */
/* Let DPTMAG be defined as */
/* DPTMAG = d ( ||PTARG|| ) / dt (10) */
/* Then the derivative with respect to time of SCORR is */
/* DSCORR = */
/* ( sin(phi)*DVPHAT */
/* + cos(phi)*d(phi)/dt * VPHAT */
/* + (cos(phi) - 1) * DRHAT */
/* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */
/* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG (11) */
/* Computations begin here: */
/* Split STARG into position and velocity components. Compute */
/* RHAT */
/* DRHAT */
/* VP */
/* DPTMAG */
if (*xmit) {
vminus_(vobs, lcvobs);
vminus_(accobs, lcacc);
} else {
vequ_(vobs, lcvobs);
vequ_(accobs, lcacc);
}
vequ_(starg, ptarg);
vequ_(&starg[3], vtarg);
dvhat_(starg, srhat);
vequ_(srhat, rhat);
vequ_(&srhat[3], drhat);
vperp_(lcvobs, rhat, vp);
dptmag = vdot_(vtarg, rhat);
/* Compute sin(phi) and cos(phi), which we'll call S and C */
/* respectively. Note that phi is always close to zero for */
/* realistic inputs (for which ||VOBS|| << CLIGHT), so the */
/* cosine term is positive. */
s = vnorm_(vp) / clight_();
/* Computing MAX */
d__1 = 0., d__2 = 1 - s * s;
c__ = sqrt((max(d__1,d__2)));
if (c__ == 0.) {
/* C will be used as a divisor later (in the computation */
/* of DPHI), so we'll put a stop to the problem here. */
chkin_("ZZSTELAB", (ftnlen)8);
setmsg_("Cosine of the aberration angle is 0; this cannot occur for "
"realistic observer velocities. This case can arise due to un"
"initialized inputs. This cosine value is used as a divisor i"
"n a later computation, so it must not be equal to zero.", (
ftnlen)234);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("ZZSTELAB", (ftnlen)8);
return 0;
}
/* Compute the unit vector VPHAT and the stellar */
/* aberration correction. We avoid relying on */
/* VHAT's exception handling for the zero vector. */
if (vzero_(vp)) {
cleard_(&c__3, vphat);
} else {
vhat_(vp, vphat);
}
/* Now we can use equation (9) to obtain the stellar */
/* aberration correction SCORR: */
/* SCORR = */
/* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| */
ptgmag = vnorm_(ptarg);
d__1 = ptgmag * s;
d__2 = ptgmag * (c__ - 1.);
vlcom_(&d__1, vphat, &d__2, rhat, scorr);
/* Now we use S as an estimate of PHI to decide if we're */
/* going to differentiate the stellar aberration correction */
/* analytically or numerically. */
/* Note that S is non-negative by construction, so we don't */
/* need to use the absolute value of S here. */
if (s >= 1e-6) {
/* This is the analytic case. */
/* Compute DVP---the derivative of VP with respect to time. */
/* Recall equation (4): */
/* DVP = d(VP)/dt */
/* = ACCOBS - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */
/* + <VOBS,RHAT> * DRHAT ) */
d__1 = -vdot_(lcvobs, drhat) - vdot_(lcacc, rhat);
d__2 = -vdot_(lcvobs, rhat);
vlcom3_(&c_b7, lcacc, &d__1, rhat, &d__2, drhat, dvp);
vhat_(vp, vphat);
/* Now we can compute DVPHAT, the derivative of VPHAT: */
vequ_(vp, svp);
vequ_(dvp, &svp[3]);
dvhat_(svp, svphat);
vequ_(&svphat[3], dvphat);
/* Compute the DPHI, the time derivative of PHI, using equation 8: */
/* d(phi)/dt = (1/cos(phi)) * (1/c) * <DVP, VPHAT> */
dphi = 1. / (c__ * clight_()) * vdot_(dvp, vphat);
/* At long last we've assembled all of the "ingredients" required */
/* to compute DSCORR: */
/* DSCORR = */
/* ( sin(phi)*DVPHAT */
/* + cos(phi)*d(phi)/dt * VPHAT */
/* + (cos(phi) - 1) * DRHAT */
/* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */
/* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG */
d__1 = c__ * dphi;
vlcom_(&s, dvphat, &d__1, vphat, term1);
d__1 = c__ - 1.;
d__2 = -s * dphi;
vlcom_(&d__1, drhat, &d__2, rhat, term2);
vadd_(term1, term2, term3);
d__1 = dptmag * s;
d__2 = dptmag * (c__ - 1.);
vlcom3_(&ptgmag, term3, &d__1, vphat, &d__2, rhat, dscorr);
} else {
/* This is the numeric case. We're going to differentiate */
/* the stellar aberration correction offset vector using */
/* a quadratic estimate. */
for (i__ = 1; i__ <= 2; ++i__) {
/* Set the sign of the time offset. */
if (i__ == 1) {
sgn = -1.;
} else {
sgn = 1.;
}
/* Estimate the observer's velocity relative to the */
/* solar system barycenter at the current epoch. We use */
/* the local copies of the input velocity and acceleration */
/* to make a linear estimate. */
d__1 = sgn * 1.;
vlcom_(&c_b7, lcvobs, &d__1, lcacc, evobs);
/* Estimate the observer-target vector. We use the */
/* observer-target state velocity to make a linear estimate. */
d__1 = sgn * 1.;
vlcom_(&c_b7, starg, &d__1, &starg[3], eptarg);
/* Let RHAT be the unit observer-target position. */
/* Compute the component of the observer's velocity */
/* that is perpendicular to the target position; call */
/* this vector VP. Also compute the unit vector in */
/* the direction of VP. */
vhat_(eptarg, rhat);
vperp_(evobs, rhat, vp);
if (vzero_(vp)) {
cleard_(&c__3, vphat);
} else {
vhat_(vp, vphat);
}
/* Compute the sine and cosine of the correction */
/* angle. */
s = vnorm_(vp) / clight_();
/* Computing MAX */
d__1 = 0., d__2 = 1 - s * s;
c__ = sqrt((max(d__1,d__2)));
/* Compute the vector offset of the correction. */
ptgmag = vnorm_(eptarg);
d__1 = ptgmag * s;
d__2 = ptgmag * (c__ - 1.);
vlcom_(&d__1, vphat, &d__2, rhat, &saoff[(i__1 = i__ * 3 - 3) < 6
&& 0 <= i__1 ? i__1 : s_rnge("saoff", i__1, "zzstelab_", (
ftnlen)597)]);
}
/* Now compute the derivative. */
qderiv_(&c__3, saoff, &saoff[3], &c_b7, dscorr);
}
/* At this point the correction offset SCORR and its derivative */
/* with respect to time DSCORR are both set. */
return 0;
} /* zzstelab_ */
/* $Procedure EQNCPV (Equinoctial Elements to position and velocity) */
/* Subroutine */ int eqncpv_(doublereal *et, doublereal *epoch, doublereal *
eqel, doublereal *rapol, doublereal *decpol, doublereal *state)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), sin(doublereal), cos(doublereal), d_mod(
doublereal *, doublereal *);
/* Local variables */
doublereal nfac, node, mldt, temp[3], a, b, h__, k, l, eecan, p, q, r__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal dlpdt, prate;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal xhold[6];
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
doublereal trans[9] /* was [3][3] */;
extern doublereal twopi_(void);
doublereal x1, y1;
extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
doublereal ca, cd, cf, di, cn, ra, sa, rb, sd, dt, sf, ml, dx, dy, vf[3],
vg[3], sn, nodedt;
extern doublereal kepleq_(doublereal *, doublereal *, doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
static doublereal pi2;
doublereal dx1, dy1;
extern logical return_(void);
doublereal ecc, can, dlp, san;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Compute the state (position and velocity of an object whose */
/* trajectory is described via equinoctial elements relative to some */
/* fixed plane (usually the equatorial plane of some planet). */
/* $ 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 */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ET I Epoch in seconds past J2000 to find state */
/* EPOCH I Epoch of elements in seconds past J2000 */
/* EQEL I Array of equinoctial elements */
/* RAPOL I Right Ascension of the pole of the reference plane */
/* DECPOL I Declination of the pole of the reference plane */
/* STATE O State of the object described by EQEL. */
/* $ Detailed_Input */
/* ET is the epoch (ephemeris time) at which the state */
/* of the target body is to be computed. ET is measured */
/* in seconds past the J2000 epoch. */
/* EPOCH is the epoch of the equinoctial elements in seconds */
/* past the J2000 epoch. */
/* EQEL is an array of 9 double precision numbers that */
/* are the equinoctial elements for some orbit expressed */
/* relative to the equatorial frame of the central body. */
/* (The z-axis of the equatorial frame is the direction */
/* of the pole of the central body relative to some */
/* inertial frame. The x-axis is given by the cross */
/* product of the Z-axis of the inertial frame */
/* with the direction of the pole of the central body. */
/* The Y-axis completes a right handed frame. */
/* (If the z-axis of the equatorial frame is aligned */
/* with the z-axis of the inertial frame, then the */
/* x-axis of the equatorial frame will be located at */
/* 90 degrees + RAPOL in the inertial frame.) */
/* The specific arrangement of the elements is spelled */
/* out below. The following terms are used in the */
/* discussion of elements of EQEL */
/* INC --- inclination of the orbit */
/* ARGP --- argument of periapse */
/* NODE --- longitude of the ascending node */
/* E --- eccentricity of the orbit */
/* EQEL(1) is the semi-major axis (A) of the orbit in km. */
/* EQEL(2) is the value of H at the specified epoch. */
/* ( E*SIN(ARGP+NODE) ). */
/* EQEL(3) is the value of K at the specified epoch */
/* ( E*COS(ARGP+NODE) ). */
/* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */
/* the epoch of the elements measured in radians. */
/* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */
/* the specified epoch. */
/* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */
/* the specified epoch. */
/* EQEL(7) is the rate of the longitude of periapse */
/* (dARGP/dt + dNODE/dt ) at the epoch of */
/* the elements. This rate is assumed to hold */
/* for all time. The rate is measured in */
/* radians per second. */
/* EQEL(8) is the derivative of the mean longitude */
/* ( dM/dt + dARGP/dt + dNODE/dt ). This */
/* rate is assumed to be constant and is */
/* measured in radians/second. */
/* EQEL(9) is the rate of the longitude of the ascending */
/* node ( dNODE/dt). This rate is measured */
/* in radians per second. */
/* RAPOL Right Ascension of the pole of the reference plane */
/* with respect to some inertial frame (measured in */
/* radians). */
/* DECPOL Declination of the pole of the reference plane */
/* with respect to some inertial frame (measured in */
/* radians). */
/* $ Detailed_Output */
/* STATE State of the object described by EQEL relative to the */
/* inertial frame used to define RAPOL and DECPOL. Units */
/* are in km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity corresponding to the input elements is */
/* greater than 0.9, the error SPICE(ECCOUTOFRANGE) is signalled. */
/* 2) If the semi-major axis of the elements is non-positive, the */
/* error SPICE(BADSEMIAXIS) is signalled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine evaluates the input equinoctial elements for */
/* the specified epoch and return the corresponding state. */
/* This routine was adapted from a routine provided by */
/* Bob Jacobson of the Planetary Dynamics Group of */
/* the Navigation and Flight Mechanics Section at JPL. */
/* $ Examples */
/* Suppose you have classical elements and rates of */
/* change of the ascending node and argument of periapse */
/* for some satellite of the earth. */
/* By transforming the classical elements */
/* this routine can be used to compute the state of the */
/* object at an arbitrary epoch. The code below illustrates */
/* how you might do this. */
/* The table below illustrates the meanings of the various */
/* variables used in the discussion below. */
/* Variable Meaning */
/* -------- ---------------------------------- */
/* A Semi-major axis in km */
/* ECC Eccentricity of orbit */
/* INC Inclination of orbit */
/* NODE Longitude of the ascending node at epoch */
/* OMEGA Argument of periapse at epoch */
/* M Mean anomaly at epoch */
/* DMDT Mean anomaly rate in radians/second */
/* DNODE Rate of change of longitude of ascending node */
/* in radians/second */
/* DARGP Rate of change of argument of periapse in */
/* radians/second */
/* EPOCH is the epoch of the elements in seconds past */
/* the J2000 epoch. */
/* EQEL(1) = A */
/* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */
/* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */
/* EQEL(4) = M + OMEGA + NODE */
/* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */
/* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */
/* EQEL(7) = DARGP */
/* EQEL(8) = DARGP + DMDT + DNODE */
/* EQEL(9) = DNODE */
/* We shall compute the state of the satellite in the */
/* pole and equator reference system. */
/* RAPOL = -HALFPI() */
/* DECPOL = HALFPI() */
/* Now compute the state at the desired epoch ET. */
/* CALL EQNCPV ( ET, EPOCH, EQEL, RAPOL, DECPOL, STATE ) */
/* $ Restrictions */
/* The equinoctial elements used by this routine are taken */
/* from "Tangent" formulation of equinoctial elements */
/* p = Tan(inclination/2) * Sin(R.A. of ascending node) */
/* q = Tan(inclination/2) * Cos(R.A. of ascending node) */
/* Other formulations use Sine instead of Tangent. We shall */
/* call these the "Sine" formulations. */
/* p = Sin(inclination/2) * Sin(R.A. of ascending node) */
/* q = Sin(inclination/2) * Cos(R.A. of ascending node) */
/* If you have equinoctial elements from this alternative */
/* formulation you should replace p and q by the */
/* expressions below. */
/* P = P / DSQRT ( 1.0D0 - P*P - Q*Q ) */
/* Q = Q / DSQRT ( 1.0D0 - P*P - Q*Q ) */
/* This will convert the Sine formulation to the Tangent formulation. */
/* $ Literature_References */
/* JPL Engineering Memorandum 314-513 "Optical Navigation Program */
/* Mathematical Models" by William M. Owen, Jr. and Robin M Vaughan */
/* August 9, 1991 */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* R.A. Jacobson (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 18-MAY-2010 (BVS) */
/* Removed "C$" marker from text in the header. */
/* - SPICELIB Version 1.0.1, 31-JAN-2008 (BVS) */
/* Removed non-standard header section heading */
/* 'Declarations_of_external_functions'. */
/* - SPICELIB Version 1.0.0, 8-JAN-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Compute a state from equinoctial elements */
/* -& */
/* SPICELIB Functions. */
/* LOCAL VARIABLES */
/* Constants computed on first pass */
/* Standard SPICE exception handling code. */
if (return_()) {
return 0;
}
chkin_("EQNCPV", (ftnlen)6);
/* The first time through this routine we fetch the various */
/* constants we need for this routine. */
if (first) {
first = FALSE_;
pi2 = twopi_();
}
/* Take care of the various errors that can arise with the */
/* input elements. */
if (eqel[0] <= 0.) {
setmsg_("The semi-major axis supplied to EQNCPV was non-positive. Th"
"e value is required to be positive by this routine. The valu"
"e supplied was #. ", (ftnlen)137);
errdp_("#", eqel, (ftnlen)1);
sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18);
chkout_("EQNCPV", (ftnlen)6);
return 0;
}
ecc = sqrt(eqel[1] * eqel[1] + eqel[2] * eqel[2]);
if (ecc > .9) {
setmsg_("The routine EQNCPV can reliably evaluate states from equino"
"ctial elements if the eccentricity of the orbit associated w"
"ith the elements is less than 0.9. The eccentricity associa"
"ted with the elements supplies is #. The values of H and K "
"are: # and # respectively. ", (ftnlen)266);
errdp_("#", &ecc, (ftnlen)1);
errdp_("#", &eqel[1], (ftnlen)1);
errdp_("#", &eqel[2], (ftnlen)1);
sigerr_("SPICE(ECCOUTOFRANGE)", (ftnlen)20);
chkout_("EQNCPV", (ftnlen)6);
return 0;
}
/* Form the transformation from planetary equator to the inertial */
/* reference frame. */
sa = sin(*rapol);
ca = cos(*rapol);
sd = sin(*decpol);
cd = cos(*decpol);
trans[0] = -sa;
trans[3] = -ca * sd;
trans[6] = ca * cd;
trans[1] = ca;
trans[4] = -sa * sd;
trans[7] = sa * cd;
trans[2] = 0.;
trans[5] = cd;
trans[8] = sd;
/* Compute the offset of the input epoch (ET) from the */
/* epoch of the elements. */
dt = *et - *epoch;
/* Obtain the elements, rates, and other parameters. First get */
/* the semi-major axis. */
a = eqel[0];
/* Recall that H and K at the epoch of the elements are in */
/* EQEL(2) and EQEL(3) respectively. */
/* H_0 = E*Sin(ARGP_0 + NODE_0 ) */
/* K_0 = E*Cos(ARGP_0 + NODE_0 ) */
/* The values of H and K at the epoch of interest is */
/* H_dt = E*Sin(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */
/* K_dt = E*Cos(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */
/* But using the identities Sin(A+B) = Sin(A)Cos(B) + Sin(B)Cos(A) */
/* Cos(A+B) = Cos(A)Cos(B) - Sin(A)Sin(B) */
/* We can re-write the expression for H_dt and K_dt as */
/* H_dt = E*Sin(ARGP_0 + NODE_0 )Cos(dt*d(ARGP+NODE)/dt ) */
/* + E*Cos(ARGP_0 + NODE_0 )Sin(dt*d(ARGP+NODE)/dt ) */
/* = H_0 * Cos(dt*d(ARGP+NODE)/dt ) */
/* + K_0 * Sin(dt*d(ARGP+NODE)/dt ) */
/* and */
/* K_dt = E*Cos(ARGP_0 + NODE_0)Cos(dt*d(ARGP+NODE)/dt) */
/* - E*Sin(ARGP_0 + NODE_0)Sin(dt*d(ARGP+NODE)/dt) */
/* = K_0 * Cos(dt*d(ARGP+NODE)/dt) */
/* - H_0 * Sin(dt*d(ARGP+NODE)/dt) */
/* Thus we can easily compute H and K at the current epoch. */
/* Recall that the derivative of the longitude of periapse is */
/* in entry 7 of EQEL. */
dlpdt = eqel[6];
dlp = dt * dlpdt;
can = cos(dlp);
san = sin(dlp);
h__ = eqel[1] * can + eqel[2] * san;
k = eqel[2] * can - eqel[1] * san;
/* The mean longitude at epoch is in the 4th element of EQEL. */
l = eqel[3];
/* The values for P and Q at epoch are stored in entries 5 and 6 */
/* of the array EQEL. Recall that */
/* P_0 = TAN(INC/2)*SIN(NODE_0) */
/* Q_0 = TAN(INC/2)*COS(NODE_0) */
/* We need P and Q offset from the initial epoch by DT. */
/* P = TAN(INC/2)*SIN(NODE_0 + dt*dNODE/dt) */
/* Q = TAN(INC/2)*COS(NODE_0 + dt*dNODE/dt) */
/* Applying the same identities as we did before we have */
/* P = P_0 * Cos( dt*dNODE/dt ) + Q_0 * Sin( dt*dNODE/dt ) */
/* Q = Q_0 * Cos( dt*dNODE/dt ) - P_0 * Sin( dt*dNODE/dt ) */
nodedt = eqel[8];
node = dt * nodedt;
cn = cos(node);
sn = sin(node);
p = eqel[4] * cn + eqel[5] * sn;
q = eqel[5] * cn - eqel[4] * sn;
mldt = eqel[7];
/* We compute the rate of change of the argument of periapse */
/* by taking the difference between the rate of the longitude */
/* of periapse and the rate of the node. */
prate = dlpdt - nodedt;
/* Form Broucke's beta parameter */
b = sqrt(1. - h__ * h__ - k * k);
b = 1. / (b + 1.);
/* Construct the coordinate axes */
di = 1. / (p * p + 1. + q * q);
vf[0] = (1. - p * p + q * q) * di;
vf[1] = p * 2. * q * di;
vf[2] = p * -2. * di;
vg[0] = p * 2. * q * di;
vg[1] = (p * p + 1. - q * q) * di;
vg[2] = q * 2. * di;
/* Compute the mean longitude */
d__1 = mldt * dt;
ml = l + d_mod(&d__1, &pi2);
/* Obtain the eccentric longitude from Kepler's equation */
eecan = kepleq_(&ml, &h__, &k);
/* Trigonometric functions of the eccentric longitude */
sf = sin(eecan);
cf = cos(eecan);
/* Position in the orbit plane */
/* Computing 2nd power */
d__1 = h__;
x1 = a * ((1. - b * (d__1 * d__1)) * cf + (h__ * k * b * sf - k));
/* Computing 2nd power */
d__1 = k;
y1 = a * ((1. - b * (d__1 * d__1)) * sf + (h__ * k * b * cf - h__));
/* Radial distance and functions of the radial distance */
rb = h__ * sf + k * cf;
r__ = a * (1. - rb);
ra = mldt * a * a / r__;
/* Velocity in the orbit plane */
dx1 = ra * (-sf + h__ * b * rb);
dy1 = ra * (cf - k * b * rb);
/* Correction factor for periapsis rate */
nfac = 1. - dlpdt / mldt;
/* Include precession in velocity */
dx = nfac * dx1 - prate * y1;
dy = nfac * dy1 + prate * x1;
/* Form the planetary mean equator position vector */
vlcom_(&x1, vf, &y1, vg, xhold);
/* Form the planetary mean equator velocity vector */
temp[0] = -nodedt * xhold[1];
temp[1] = nodedt * xhold[0];
temp[2] = 0.;
vlcom3_(&c_b13, temp, &dx, vf, &dy, vg, &xhold[3]);
/* Transform to an inertial state vector */
mxv_(trans, xhold, state);
mxv_(trans, &xhold[3], &state[3]);
chkout_("EQNCPV", (ftnlen)6);
return 0;
} /* eqncpv_ */
/* $Procedure SYFETC ( Fetch the Nth symbol in the table ) */
/* Subroutine */ int syfetc_(integer *nth, char *tabsym, integer *tabptr,
char *tabval, char *name__, logical *found, ftnlen tabsym_len, ftnlen
tabval_len, ftnlen name_len)
{
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer nsym;
extern integer cardc_(char *, ftnlen);
extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *,
ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Fetch the Nth symbol in a character symbol table. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NTH I Index of symbol to be fetched. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I Components of the symbol table. */
/* NAME O Name of the NTH symbol in the symbol table. */
/* FOUND O True if the NTH symbol is in the symbol table, */
/* false if it is not. */
/* $ Detailed_Input */
/* NTH is the index of the symbol to be fetched. If the NTH */
/* symbol does not exist, FOUND is FALSE. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of a character symbol table. */
/* The NTH symbol may or may not be in the symbol */
/* table. The symbol table is not modified by this */
/* subroutine. */
/* $ Detailed_Output */
/* NAME is the name of the NTH symbol in the symbol table. */
/* FOUND is true if the NTH symbol is in the symbol table. */
/* If the NTH symbol is not in the table, FOUND is false. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* The contents of the symbol table are: */
/* BOHR --> HYDROGEN ATOM */
/* EINSTEIN --> SPECIAL RELATIVITY */
/* PHOTOELECTRIC EFFECT */
/* BROWNIAN MOTION */
/* FERMI --> NUCLEAR FISSION */
/* The calls, */
/* CALL SYFETC ( 2, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* CALL SYFETC ( 3, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* CALL SYFETC ( -1, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* CALL SYFETC ( 4, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* result in the values for NAME and FOUND: */
/* NAME FOUND */
/* ---------- ----- */
/* EINSTEIN TRUE */
/* FERMI TRUE */
/* FALSE */
/* FALSE */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* fetch the nth symbol in the table */
/* -& */
/* $ Revisions */
/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */
/* Declaration of the unused variable SUMAI removed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYFETC", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
/* If the value of NTH is out of range, that's a problem. */
if (*nth < 1 || *nth > nsym) {
*found = FALSE_;
/* Otherwise, we can proceed without fear of error. Merely locate */
/* and return the appropriate component from the values table. */
} else {
*found = TRUE_;
s_copy(name__, tabsym + (*nth + 5) * tabsym_len, name_len, tabsym_len)
;
}
chkout_("SYFETC", (ftnlen)6);
return 0;
} /* syfetc_ */
/* $Procedure ZZFOVAXI ( Generate an axis vector for polygonal FOV ) */
/* Subroutine */ int zzfovaxi_(char *inst, integer *n, doublereal *bounds,
doublereal *axis, ftnlen inst_len)
{
/* System generated locals */
integer bounds_dim2, i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
doublereal uvec[3];
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
extern doublereal vsep_(doublereal *, doublereal *);
integer next;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *), zzhullax_(
char *, integer *, doublereal *, doublereal *, ftnlen);
integer i__;
doublereal v[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
doublereal limit;
extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal
*);
extern logical vzero_(doublereal *);
doublereal cp[3];
extern logical failed_(void);
logical ok;
extern /* Subroutine */ int cleard_(integer *, doublereal *);
extern doublereal halfpi_(void);
extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *)
, chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *),
setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen);
extern logical return_(void);
doublereal sep;
/* $ 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. */
/* Generate an axis of an instrument's polygonal FOV such that all */
/* of the FOV's boundary vectors have angular separation of strictly */
/* less than pi/2 radians from this axis. */
/* $ 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 */
/* FRAMES */
/* GF */
/* IK */
/* KERNEL */
/* $ Keywords */
/* FOV */
/* GEOMETRY */
/* INSTRUMENT */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* MARGIN P Minimum complement of FOV cone angle. */
/* INST I Instrument name. */
/* N I Number of FOV boundary vectors. */
/* BOUNDS I FOV boundary vectors. */
/* AXIS O Instrument FOV axis vector. */
/* $ Detailed_Input */
/* INST is the name of an instrument with which the field of */
/* view (FOV) of interest is associated. This name is */
/* used only to generate long error messages. */
/* N is the number of boundary vectors in the array */
/* BOUNDS. */
/* BOUNDS is an array of N vectors emanating from a common */
/* vertex and defining the edges of a pyramidal region in */
/* three-dimensional space: this the region within the */
/* FOV of the instrument designated by INST. The Ith */
/* vector of BOUNDS resides in elements (1:3,I) of this */
/* array. */
/* The vectors contained in BOUNDS are called the */
/* "boundary vectors" of the FOV. */
/* The boundary vectors must satisfy the constraints: */
/* 1) The boundary vectors must be contained within */
/* a right circular cone of angular radius less */
/* than than (pi/2) - MARGIN radians; in other */
/* words, there must be a vector A such that all */
/* boundary vectors have angular separation from */
/* A of less than (pi/2)-MARGIN radians. */
/* 2) There must be a pair of vectors U, V in BOUNDS */
/* such that all other boundary vectors lie in */
/* the same half space bounded by the plane */
/* containing U and V. Furthermore, all other */
/* boundary vectors must have orthogonal */
/* projections onto a plane normal to this plane */
/* such that the projections have angular */
/* separation of at least 2*MARGIN radians from */
/* the plane spanned by U and V. */
/* Given the first constraint above, there is plane PL */
/* such that each of the set of rays extending the */
/* boundary vectors intersects PL. (In fact, there is an */
/* infinite set of such planes.) The boundary vectors */
/* must be ordered so that the set of line segments */
/* connecting the intercept on PL of the ray extending */
/* the Ith vector to that of the (I+1)st, with the Nth */
/* intercept connected to the first, form a polygon (the */
/* "FOV polygon") constituting the intersection of the */
/* FOV pyramid with PL. This polygon may wrap in either */
/* the positive or negative sense about a ray emanating */
/* from the FOV vertex and passing through the plane */
/* region bounded by the FOV polygon. */
/* The FOV polygon need not be convex; it may be */
/* self-intersecting as well. */
/* No pair of consecutive vectors in BOUNDS may be */
/* linearly dependent. */
/* The boundary vectors need not have unit length. */
/* $ Detailed_Output */
/* AXIS is a unit vector normal to a plane containing the */
/* FOV polygon. All boundary vectors have angular */
/* separation from AXIS of not more than */
/* ( pi/2 ) - MARGIN */
/* radians. */
/* This routine signals an error if it cannot find */
/* a satisfactory value of AXIS. */
/* $ Parameters */
/* MARGIN is a small positive number used to constrain the */
/* orientation of the boundary vectors. See the two */
/* constraints described in the Detailed_Input section */
/* above for specifics. */
/* $ Exceptions */
/* 1) In the input vector count N is not at least 3, the error */
/* SPICE(INVALIDCOUNT) is signaled. */
/* 2) If any pair of consecutive boundary vectors has cross */
/* product zero, the error SPICE(DEGENERATECASE) is signaled. */
/* For this test, the first vector is considered the successor */
/* of the Nth. */
/* 3) If this routine can't find a face of the convex hull of */
/* the set of boundary vectors such that this face satisfies */
/* constraint (2) of the Detailed_Input section above, the */
/* error SPICE(FACENOTFOUND) is signaled. */
/* 4) If any boundary vectors have longitude too close to 0 */
/* or too close to pi radians in the face frame (see discussion */
/* of the search algorithm's steps 3 and 4 in Particulars */
/* below), the respective errors SPICE(NOTSUPPORTED) or */
/* SPICE(FOVTOOWIDE) are signaled. */
/* 5) If any boundary vectors have angular separation of more than */
/* (pi/2)-MARGIN radians from the candidate FOV axis, the */
/* error SPICE(FOVTOOWIDE) is signaled. */
/* $ Files */
/* The boundary vectors input to this routine are typically */
/* obtained from an IK file. */
/* $ Particulars */
/* Normally implementation is not discussed in SPICE headers, but we */
/* make an exception here because this routine's implementation and */
/* specification are deeply intertwined. */
/* This routine first computes the average of the unitized input */
/* boundary vectors; if this vector satisfies the angular separation */
/* constraint (1) in Detailed_Input, a unit length copy of this */
/* vector is returned as the FOV axis. */
/* If the procedure above fails, an algorithm based on selection */
/* of a suitable face of the boundary vector's convex hull is tried. */
/* See the routine ZZHULLAX for details. */
/* If the second approach fails, an error is signaled. */
/* Note that it's easy to construct FOVs where the average of the */
/* boundary vectors doesn't yield a viable axis: a FOV of angular */
/* width nearly equal to pi radians, with a sufficiently large */
/* number of boundary vectors on one side and few boundary vectors */
/* on the other, is one such example. This routine can find an */
/* axis for many such intractable FOVs---that's why ZZHULLAX */
/* is called after the simple approach fails. */
/* $ Examples */
/* See SPICELIB private routine ZZGFFVIN. */
/* $ Restrictions */
/* 1) This is a SPICE private routine. User applications should not */
/* call this routine. */
/* 2) There may "reasonable" polygonal FOVs that cannot be handled */
/* by this routine. See the discussions in Detailed_Input, */
/* Exceptions, and Particulars above for restrictions on the */
/* input set of FOV boundary vectors. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Parameter adjustments */
bounds_dim2 = *n;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZFOVAXI", (ftnlen)8);
/* We must have at least 3 boundary vectors. */
if (*n < 3) {
setmsg_("Polygonal FOV requires at least 3 boundary vectors but numb"
"er supplied for # was #.", (ftnlen)83);
errch_("#", inst, (ftnlen)1, inst_len);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
}
/* Check for linearly dependent consecutive boundary vectors. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Set the index of the next ray. When we get to the */
/* last boundary vector, the next ray is the first. */
if (i__ == *n) {
next = 1;
} else {
next = i__ + 1;
}
/* Find the cross product of the first ray with the */
/* second. Depending on the ordering of the boundary */
/* vectors, this could be an inward or outward normal, */
/* in the case the current face is is exterior. */
vcrss_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ?
i__2 : s_rnge("bounds", i__2, "zzfovaxi_", (ftnlen)313)], &
bounds[(i__3 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__3 ?
i__3 : s_rnge("bounds", i__3, "zzfovaxi_", (ftnlen)313)], cp);
/* We insist on consecutive boundary vectors being */
/* linearly independent. */
if (vzero_(cp)) {
setmsg_("Polygonal FOV must have linearly independent consecutiv"
"e boundary but vectors at indices # and # have cross pro"
"duct equal to the zero vector. Instrument is #.", (ftnlen)
158);
errint_("#", &i__, (ftnlen)1);
errint_("#", &next, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
}
}
/* First try the average of the FOV unit boundary vectors as */
/* a candidate axis. In many cases, this simple approach */
/* does the trick. */
cleard_(&c__3, axis);
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
vhat_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ?
i__2 : s_rnge("bounds", i__2, "zzfovaxi_", (ftnlen)346)],
uvec);
vadd_(uvec, axis, v);
vequ_(v, axis);
}
d__1 = 1. / *n;
vsclip_(&d__1, axis);
/* If each boundary vector has sufficiently small */
/* angular separation from AXIS, we're done. */
limit = halfpi_() - 1e-12;
ok = TRUE_;
i__ = 1;
while(i__ <= *n && ok) {
sep = vsep_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__1 ? i__1 : s_rnge("bounds", i__1, "zzfovaxi_", (ftnlen)365)
], axis);
if (sep > limit) {
ok = FALSE_;
} else {
++i__;
}
}
if (! ok) {
/* See whether we can find an axis using a */
/* method based on finding a face of the convex */
/* hull of the FOV. ZZHULLAX signals an error */
/* if it doesn't succeed. */
zzhullax_(inst, n, bounds, axis, inst_len);
if (failed_()) {
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
}
}
/* At this point AXIS is valid. Make the axis vector unit length. */
vhatip_(axis);
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
} /* zzfovaxi_ */
/* $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 DISPLY ( BRIEF Display Summary ) */
/* Subroutine */ int disply_(char *fmtpic, logical *tdsp, logical *gdsp,
logical *obnam, integer *objlis, char *winsym, integer *winptr,
doublereal *winval, char *timtyp, char *kertyp, ftnlen fmtpic_len,
ftnlen winsym_len, ftnlen timtyp_len, ftnlen kertyp_len)
{
/* System generated locals */
address a__1[3];
integer i__1, i__2, i__3[3], i__4, i__5;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
static char name__[64];
static logical same;
static char line[132];
static integer nobj, objn[2], sobj, size;
static char rest[132];
static integer b, e, i__, j;
extern integer cardc_(char *, ftnlen);
static integer s;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static char names[64*100006];
static logical found, group;
extern integer rtrim_(char *, ftnlen);
static integer n1, n2;
static char p1[8], p2[8];
static integer start;
static char header[132*2], wd[8];
extern integer objact_(integer *);
extern /* Subroutine */ int maknam_(integer *, integer *, logical *, char
*, char *, ftnlen, ftnlen), appndc_(char *, char *, ftnlen,
ftnlen);
static integer object[3], remain;
extern /* Subroutine */ int objget_(integer *, integer *, integer *),
objrem_(integer *, integer *), rmaini_(integer *, integer *,
integer *, integer *);
static char timlbl[8];
static integer npline;
extern /* Subroutine */ int objnth_(integer *, integer *, integer *,
logical *), prname_(integer *, integer *, char *, char *, char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen)
;
static doublereal filwin[1006];
static integer nlines, objtmp[2];
extern integer touchi_(integer *);
extern /* Subroutine */ int distim_(char *, doublereal *, char *, char *,
ftnlen, ftnlen, ftnlen);
static integer widest;
extern integer objsiz_(integer *);
extern /* Subroutine */ int chkout_(char *, ftnlen), objnxt_(integer *,
integer *, integer *, logical *), nextwd_(char *, char *, char *,
ftnlen, ftnlen, ftnlen);
static integer ngroup;
extern /* Subroutine */ int sygetd_(char *, char *, integer *, doublereal
*, integer *, doublereal *, logical *, ftnlen, ftnlen), ssizec_(
integer *, char *, ftnlen);
extern logical return_(void);
static doublereal lstwin[1006];
static char timstr[64];
extern /* Subroutine */ int writit_(char *, ftnlen);
static logical fnd;
static integer obj[2];
/* $ Abstract */
/* Display BRIEF summary. */
/* $ 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 */
/* $ 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 */
/* W.L. Taber (NAIF) */
/* B.V. Semenov (NAIF) */
/* $ Version */
/* - BRIEF Version 3.0.0, 14-JAN-2008 (BVS) */
/* Increased MAXBOD to 100,000 (from 20,000). */
/* Increased CMDSIZ to 25,000 (from 4,000). */
/* Updated version string and changed its format to */
/* '#.#.#, Month DD, YYYY' (from '#.#.#'). */
/* - BRIEF Version 1.0.0, 14-MAR-1996 (WLT) */
/* Initial release. */
/* -& */
/* The Version is stored as a string. */
/* MAXUSE is the maximum number of bodies that can be explicitly */
/* specified on the command line for brief summaries. */
/* The longest command line that can be accommodated is */
/* given by CMDSIZ */
/* The maximum number of bodies that can be summarized is stored */
/* in the parameter MAXBOD */
/* The average number of intervals per body */
/* The largest expected window */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* FMTPIC I Body name/ID format picture (see BRIEF.PGM) */
/* TDSP I Tabular display flag */
/* GDSP I Grouping display flag */
/* OBNAM I Name ordering flag */
/* OBJLIS I List of object (?) */
/* WINSYM I Symbol table with object attributes (?) */
/* WINPTR I Symbol table with object attributes (?) */
/* WINVAL I Symbol table with object attributes (?) */
/* TIMTYP I Output time type (see DISTIM.FOR) */
/* KERTYP I Kernel type (SPK, PCK) */
/* $ Detailed_Input */
/* See Brief_I/O. */
/* $ Detailed_Output */
/* This routine return no outputs. Instead it prints summary of */
/* provided input information to STDOUT. */
/* $ Parameters */
/* LBCELL. */
/* $ Exceptions */
/* 1) Errors may be signaled by routines in the calling tree of */
/* this routine. */
/* $ Files */
/* TBD. */
/* $ Particulars */
/* TBD. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* This routine must not be called by any routines except BRIEF's */
/* main program. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - BRIEF Version 2.0.0, 22-OCT-2007 (BVS) */
/* Added output time type to the argument list. Changed to */
/* call DISTIM to format output time and provide time system */
/* label for the summary table header. */
/* - BRIEF Version 1.0.0, 14-MAR-1996 (WLT) */
/* Bill's initial version. */
/* -& */
/* $ Index_Entries */
/* display summary by BRIEF */
/* -& */
/* SPICELIB functions */
/* Parameters */
/* Local Variables. */
/* SPICELIB Calls */
/* Saved variables */
/* The SAVE statement that appears here causes f2c to create */
/* local variables with static duration. This enables the CSPICE */
/* version of brief to run under cygwin. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DISPLY", (ftnlen)6);
}
/* Get time system label for the table header. */
distim_(timtyp, &c_b3, timlbl, timstr, timtyp_len, (ftnlen)8, (ftnlen)64);
/* Set local grouping flag. */
group = ! (*tdsp) || *gdsp;
/* First take apart the format picture to see what */
/* the various components are. */
nextwd_(fmtpic, p1, rest, fmtpic_len, (ftnlen)8, (ftnlen)132);
nextwd_(rest, wd, rest, (ftnlen)132, (ftnlen)8, (ftnlen)132);
nextwd_(rest, p2, rest, (ftnlen)132, (ftnlen)8, (ftnlen)132);
size = 1;
if (s_cmp(p2, " ", (ftnlen)8, (ftnlen)1) != 0) {
size = 3;
}
/* Find out the width of the widest name. */
nobj = objact_(objlis);
sobj = objsiz_(objlis);
/* If we don't have any objects to display then */
/* we just return. */
if (nobj == 0) {
chkout_("DISPLY", (ftnlen)6);
return 0;
}
objnth_(objlis, &c__1, obj, &found);
widest = 0;
while(found) {
objget_(obj, objlis, object);
objnxt_(obj, objlis, objn, &found);
prname_(object, &sobj, p1, wd, p2, &size, kertyp, name__, (ftnlen)8, (
ftnlen)8, (ftnlen)8, kertyp_len, (ftnlen)64);
/* Computing MAX */
i__1 = widest, i__2 = rtrim_(name__, (ftnlen)64);
widest = max(i__1,i__2);
obj[0] = objn[0];
obj[1] = objn[1];
}
/* Are we going to group by window? If not, this is pretty */
/* easy. Just display stuff. */
if (*tdsp && ! (*gdsp)) {
s = widest + 3;
e = s + 32;
if (s_cmp(kertyp, "SPK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Bodies", (ftnlen)132, (ftnlen)6);
} else if (s_cmp(kertyp, "PCK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Frames", (ftnlen)132, (ftnlen)6);
} else {
s_copy(line, "IDs", (ftnlen)132, (ftnlen)3);
}
/* Writing concatenation */
i__3[0] = 19, a__1[0] = "Start of Interval (";
i__3[1] = rtrim_(timlbl, (ftnlen)8), a__1[1] = timlbl;
i__3[2] = 1, a__1[2] = ")";
s_cat(line + (s - 1), a__1, i__3, &c__3, 132 - (s - 1));
/* Writing concatenation */
i__3[0] = 17, a__1[0] = "End of Interval (";
i__3[1] = rtrim_(timlbl, (ftnlen)8), a__1[1] = timlbl;
i__3[2] = 1, a__1[2] = ")";
s_cat(line + (e - 1), a__1, i__3, &c__3, 132 - (e - 1));
writit_(line, (ftnlen)132);
s_copy(line, "-------", (ftnlen)132, (ftnlen)7);
s_copy(line + (s - 1), "-----------------------------", 132 - (s - 1),
(ftnlen)29);
s_copy(line + (e - 1), "-----------------------------", 132 - (e - 1),
(ftnlen)29);
writit_(line, (ftnlen)132);
objnth_(objlis, &c__1, obj, &found);
n1 = 0;
while(found) {
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
objget_(obj, objlis, object);
prname_(object, &sobj, p1, wd, p2, &size, kertyp, line, (ftnlen)8,
(ftnlen)8, (ftnlen)8, kertyp_len, (ftnlen)132);
maknam_(object, &sobj, obnam, kertyp, name__, kertyp_len, (ftnlen)
64);
sygetd_(name__, winsym, winptr, winval, &n2, &filwin[6], &found, (
ftnlen)64, winsym_len);
if (n2 == n1) {
same = TRUE_;
i__ = 1;
while(same && i__ <= n1) {
same = filwin[(i__1 = i__ + 5) < 1006 && 0 <= i__1 ? i__1
: s_rnge("filwin", i__1, "disply_", (ftnlen)340)]
== lstwin[(i__2 = i__ + 5) < 1006 && 0 <= i__2 ?
i__2 : s_rnge("lstwin", i__2, "disply_", (ftnlen)
340)];
++i__;
}
} else {
same = FALSE_;
}
if (! same) {
i__1 = n2;
for (i__ = 1; i__ <= i__1; i__ += 2) {
distim_(timtyp, &filwin[(i__2 = i__ + 5) < 1006 && 0 <=
i__2 ? i__2 : s_rnge("filwin", i__2, "disply_", (
ftnlen)352)], timlbl, line + (s - 1), timtyp_len,
(ftnlen)8, 132 - (s - 1));
distim_(timtyp, &filwin[(i__2 = i__ + 6) < 1006 && 0 <=
i__2 ? i__2 : s_rnge("filwin", i__2, "disply_", (
ftnlen)353)], timlbl, line + (e - 1), timtyp_len,
(ftnlen)8, 132 - (e - 1));
writit_(line, (ftnlen)132);
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
lstwin[(i__2 = i__ + 5) < 1006 && 0 <= i__2 ? i__2 :
s_rnge("lstwin", i__2, "disply_", (ftnlen)356)] =
filwin[(i__4 = i__ + 5) < 1006 && 0 <= i__4 ?
i__4 : s_rnge("filwin", i__4, "disply_", (ftnlen)
356)];
lstwin[(i__2 = i__ + 6) < 1006 && 0 <= i__2 ? i__2 :
s_rnge("lstwin", i__2, "disply_", (ftnlen)357)] =
filwin[(i__4 = i__ + 6) < 1006 && 0 <= i__4 ?
i__4 : s_rnge("filwin", i__4, "disply_", (ftnlen)
357)];
n1 = n2;
}
} else {
i__1 = s + 11;
s_copy(line + i__1, "Same coverage as previous object ", 132
- i__1, (ftnlen)33);
writit_(line, (ftnlen)132);
}
objnxt_(obj, objlis, objtmp, &found);
obj[0] = touchi_(objtmp);
obj[1] = touchi_(&objtmp[1]);
}
} else if (*tdsp && *gdsp) {
s = widest + 3;
e = s + 32;
if (s_cmp(kertyp, "SPK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Bodies", (ftnlen)132, (ftnlen)6);
} else if (s_cmp(kertyp, "PCK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Frames", (ftnlen)132, (ftnlen)6);
} else {
s_copy(line, "IDs", (ftnlen)132, (ftnlen)3);
}
/* Writing concatenation */
i__3[0] = 19, a__1[0] = "Start of Interval (";
i__3[1] = rtrim_(timlbl, (ftnlen)8), a__1[1] = timlbl;
i__3[2] = 1, a__1[2] = ")";
s_cat(line + (s - 1), a__1, i__3, &c__3, 132 - (s - 1));
/* Writing concatenation */
i__3[0] = 17, a__1[0] = "End of Interval (";
i__3[1] = rtrim_(timlbl, (ftnlen)8), a__1[1] = timlbl;
i__3[2] = 1, a__1[2] = ")";
s_cat(line + (e - 1), a__1, i__3, &c__3, 132 - (e - 1));
writit_(line, (ftnlen)132);
s_copy(line, "-------", (ftnlen)132, (ftnlen)7);
s_copy(line + (s - 1), "-----------------------------", 132 - (s - 1),
(ftnlen)29);
s_copy(line + (e - 1), "-----------------------------", 132 - (e - 1),
(ftnlen)29);
writit_(line, (ftnlen)132);
objnth_(objlis, &c__1, obj, &found);
while(found) {
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
objget_(obj, objlis, object);
prname_(object, &sobj, p1, wd, p2, &size, kertyp, line, (ftnlen)8,
(ftnlen)8, (ftnlen)8, kertyp_len, (ftnlen)132);
maknam_(object, &sobj, obnam, kertyp, name__, kertyp_len, (ftnlen)
64);
sygetd_(name__, winsym, winptr, winval, &n1, &filwin[6], &found, (
ftnlen)64, winsym_len);
i__1 = n1;
for (i__ = 1; i__ <= i__1; i__ += 2) {
distim_(timtyp, &filwin[(i__2 = i__ + 5) < 1006 && 0 <= i__2 ?
i__2 : s_rnge("filwin", i__2, "disply_", (ftnlen)416)
], timlbl, line + (s - 1), timtyp_len, (ftnlen)8, 132
- (s - 1));
distim_(timtyp, &filwin[(i__2 = i__ + 6) < 1006 && 0 <= i__2 ?
i__2 : s_rnge("filwin", i__2, "disply_", (ftnlen)417)
], timlbl, line + (e - 1), timtyp_len, (ftnlen)8, 132
- (e - 1));
writit_(line, (ftnlen)132);
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
lstwin[(i__2 = i__ + 5) < 1006 && 0 <= i__2 ? i__2 : s_rnge(
"lstwin", i__2, "disply_", (ftnlen)420)] = filwin[(
i__4 = i__ + 5) < 1006 && 0 <= i__4 ? i__4 : s_rnge(
"filwin", i__4, "disply_", (ftnlen)420)];
lstwin[(i__2 = i__ + 6) < 1006 && 0 <= i__2 ? i__2 : s_rnge(
"lstwin", i__2, "disply_", (ftnlen)421)] = filwin[(
i__4 = i__ + 6) < 1006 && 0 <= i__4 ? i__4 : s_rnge(
"filwin", i__4, "disply_", (ftnlen)421)];
}
objnxt_(obj, objlis, objn, &fnd);
objrem_(obj, objlis);
obj[0] = objn[0];
obj[1] = objn[1];
while(fnd) {
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
objget_(obj, objlis, object);
prname_(object, &sobj, p1, wd, p2, &size, kertyp, line, (
ftnlen)8, (ftnlen)8, (ftnlen)8, kertyp_len, (ftnlen)
132);
maknam_(object, &sobj, obnam, kertyp, name__, kertyp_len, (
ftnlen)64);
sygetd_(name__, winsym, winptr, winval, &n2, &filwin[6], &
found, (ftnlen)64, winsym_len);
if (n2 == n1) {
same = TRUE_;
i__ = 1;
while(same && i__ <= n1) {
same = filwin[(i__1 = i__ + 5) < 1006 && 0 <= i__1 ?
i__1 : s_rnge("filwin", i__1, "disply_", (
ftnlen)445)] == lstwin[(i__2 = i__ + 5) <
1006 && 0 <= i__2 ? i__2 : s_rnge("lstwin",
i__2, "disply_", (ftnlen)445)];
++i__;
}
} else {
same = FALSE_;
}
if (same) {
i__1 = s + 11;
s_copy(line + i__1, "Same coverage as previous object ",
132 - i__1, (ftnlen)33);
writit_(line, (ftnlen)132);
}
objnxt_(obj, objlis, objn, &fnd);
if (same) {
objrem_(obj, objlis);
}
obj[0] = objn[0];
obj[1] = objn[1];
}
objnth_(objlis, &c__1, obj, &found);
}
} else {
objnth_(objlis, &c__1, obj, &found);
while(found) {
ssizec_(&c_b78, names, (ftnlen)64);
objget_(obj, objlis, object);
prname_(object, &sobj, p1, wd, p2, &size, kertyp, name__, (ftnlen)
8, (ftnlen)8, (ftnlen)8, kertyp_len, (ftnlen)64);
appndc_(name__, names, (ftnlen)64, (ftnlen)64);
/* Look up the window associated with this object. */
maknam_(object, &sobj, obnam, kertyp, name__, kertyp_len, (ftnlen)
64);
sygetd_(name__, winsym, winptr, winval, &n1, &lstwin[6], &fnd, (
ftnlen)64, winsym_len);
/* Fetch the next object. */
objnxt_(obj, objlis, objn, &fnd);
objrem_(obj, objlis);
obj[0] = objn[0];
obj[1] = objn[1];
while(fnd) {
objget_(obj, objlis, object);
maknam_(object, &sobj, obnam, kertyp, name__, kertyp_len, (
ftnlen)64);
sygetd_(name__, winsym, winptr, winval, &n2, &filwin[6], &fnd,
(ftnlen)64, winsym_len);
/* See if this window is the same as the current */
/* window under considerations. */
if (n1 == n2) {
same = TRUE_;
i__ = 1;
while(same && i__ <= n1) {
same = filwin[(i__1 = i__ + 5) < 1006 && 0 <= i__1 ?
i__1 : s_rnge("filwin", i__1, "disply_", (
ftnlen)520)] == lstwin[(i__2 = i__ + 5) <
1006 && 0 <= i__2 ? i__2 : s_rnge("lstwin",
i__2, "disply_", (ftnlen)520)];
++i__;
}
} else {
same = FALSE_;
}
objnxt_(obj, objlis, objn, &fnd);
if (same) {
objrem_(obj, objlis);
prname_(object, &sobj, p1, wd, p2, &size, kertyp, name__,
(ftnlen)8, (ftnlen)8, (ftnlen)8, kertyp_len, (
ftnlen)64);
appndc_(name__, names, (ftnlen)64, (ftnlen)64);
}
obj[0] = objn[0];
obj[1] = objn[1];
}
ngroup = cardc_(names, (ftnlen)64);
if (ngroup == 1) {
if (s_cmp(kertyp, "SPK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Body: ", (ftnlen)132, (ftnlen)6);
start = 7;
} else if (s_cmp(kertyp, "PCK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Frame: ", (ftnlen)132, (ftnlen)7);
start = 8;
} else {
s_copy(line, "ID: ", (ftnlen)132, (ftnlen)4);
start = 5;
}
} else {
if (s_cmp(kertyp, "SPK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Bodies: ", (ftnlen)132, (ftnlen)8);
start = 9;
} else if (s_cmp(kertyp, "PCK", kertyp_len, (ftnlen)3) == 0) {
s_copy(line, "Frames: ", (ftnlen)132, (ftnlen)8);
start = 9;
} else {
s_copy(line, "IDs: ", (ftnlen)132, (ftnlen)5);
start = 6;
}
}
npline = (80 - widest - start) / (widest + 2) + 1;
rmaini_(&ngroup, &npline, &nlines, &remain);
if (remain != 0) {
++nlines;
}
i__1 = nlines;
for (j = 1; j <= i__1; ++j) {
b = start;
i__2 = ngroup;
i__4 = nlines;
for (i__ = j; i__4 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
i__4) {
s_copy(line + (b - 1), names + (((i__5 = i__ + 5) <
100006 && 0 <= i__5 ? i__5 : s_rnge("names", i__5,
"disply_", (ftnlen)580)) << 6), 132 - (b - 1), (
ftnlen)64);
b = b + widest + 2;
}
writit_(line, (ftnlen)132);
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
}
s = start;
e = start + 36;
s_copy(header, " ", (ftnlen)132, (ftnlen)1);
s_copy(header + 132, " ", (ftnlen)132, (ftnlen)1);
/* Writing concatenation */
i__3[0] = 19, a__1[0] = "Start of Interval (";
i__3[1] = rtrim_(timlbl, (ftnlen)8), a__1[1] = timlbl;
i__3[2] = 1, a__1[2] = ")";
s_cat(header + (s - 1), a__1, i__3, &c__3, 132 - (s - 1));
/* Writing concatenation */
i__3[0] = 17, a__1[0] = "End of Interval (";
i__3[1] = rtrim_(timlbl, (ftnlen)8), a__1[1] = timlbl;
i__3[2] = 1, a__1[2] = ")";
s_cat(header + (e - 1), a__1, i__3, &c__3, 132 - (e - 1));
s_copy(header + (s + 131), "-----------------------------", 132 -
(s - 1), (ftnlen)29);
s_copy(header + (e + 131), "-----------------------------", 132 -
(e - 1), (ftnlen)29);
writit_(header, (ftnlen)132);
writit_(header + 132, (ftnlen)132);
i__1 = n1;
for (i__ = 1; i__ <= i__1; i__ += 2) {
s_copy(line, " ", (ftnlen)132, (ftnlen)1);
distim_(timtyp, &lstwin[(i__4 = i__ + 5) < 1006 && 0 <= i__4 ?
i__4 : s_rnge("lstwin", i__4, "disply_", (ftnlen)608)
], timlbl, line + (s - 1), timtyp_len, (ftnlen)8, 132
- (s - 1));
distim_(timtyp, &lstwin[(i__4 = i__ + 6) < 1006 && 0 <= i__4 ?
i__4 : s_rnge("lstwin", i__4, "disply_", (ftnlen)609)
], timlbl, line + (e - 1), timtyp_len, (ftnlen)8, 132
- (e - 1));
writit_(line, (ftnlen)132);
}
writit_(" ", (ftnlen)1);
objnth_(objlis, &c__1, obj, &found);
}
}
/* All done. */
chkout_("DISPLY", (ftnlen)6);
return 0;
} /* disply_ */
/* $Procedure DAFA2B ( DAF, ASCII to binary ) */
/* Subroutine */ int dafa2b_(char *ascii, char *binary, integer *resv, ftnlen
ascii_len, ftnlen binary_len)
{
/* System generated locals */
cllist cl__1;
/* Builtin functions */
integer f_clos(cllist *);
/* Local variables */
integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen), daft2b_(integer *,
char *, integer *, ftnlen);
extern logical failed_(void);
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int txtopr_(char *, integer *, ftnlen);
/* $ Abstract */
/* Convert an ASCII (text) DAF to an equivalent binary DAF. */
/* (Obsolete, maintained for backward compatibility only.) */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAF */
/* $ Keywords */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ASCII I Name of an existing ASCII (text) DAF. */
/* BINARY I Name of a binary DAF to be created. */
/* RESV I Number of records to reserve. */
/* $ Detailed_Input */
/* ASCII is the name of an existing ASCII (text) DAF. */
/* BINARY is the name of the binary DAF to be created. */
/* The binary DAF contains the same data as the */
/* ASCII DAF, but in a form more suitable for use */
/* by application programs. */
/* RESV is the number of records to be reserved in the */
/* binary DAF. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Files */
/* See arguments ASCII, BINARY. */
/* $ Exceptions */
/* None. */
/* Errors are detected and signalled by routines called by this */
/* routine. */
/* $ Particulars */
/* This routine has been made obsolete by the new DAF text to binary */
/* conversion routine DAFTB. This routine remains available for */
/* reasons of backward compatibility. We strongly recommend that the */
/* conversion routine DAFTB be used for any new software development. */
/* Please see the header of the routine DAFTB for details. */
/* This routine is used for converting older DAF text files, which */
/* use a decimal format for numbers, into their equivalent binary */
/* formats. Note that the routine DAFTB makes use of a text file */
/* format that is incompatible with the text file format expected by */
/* the routines called by this routine. */
/* Note that you must select the number of records to be reserved */
/* in the binary DAF. The contents of reserved records are ignored */
/* by the normal transfer process. */
/* $ Examples */
/* DAFB2A and DAFA2B are typically used to transfer files. */
/* If file A.DAF is a binary DAF in environment 1, it */
/* can be transferred to environment 2 in three steps. */
/* 1) Convert it to ASCII, */
/* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */
/* 2) Transfer the ASCII file, using FTP, Kermit, or some other */
/* file transfer utility, */
/* ftp> put a.ascii */
/* 3) Convert it to binary on the new machine, */
/* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */
/* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */
/* environment. */
/* $ Restrictions */
/* DAFA2B cannot be executed while any other DAF is open */
/* for writing. */
/* $ Literature_References */
/* NAIF Document 167.0, "Double Precision Array Files (DAF) */
/* Specification and User's Guide" */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 30-SEP-1993 (KRG) */
/* This routine was completely rewritten to make use of the */
/* routines DAFT2B and TXTOPR, for converting a text file to */
/* binary and opening a text file. It now simply calls the */
/* routine DAFT2B after opening the text file. */
/* Added a statement to the $ Particulars section to the effect */
/* that this routine has been made obsolete by the introduction of */
/* the routine DAFTB, and that the use of the new routine is */
/* strongly recommended for new software development. */
/* Modified the $ Abstract section to reflect the fact that this */
/* routine is obsolete. */
/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* ascii daf to binary */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 30-SEP-1993 (KRG) */
/* This routine was completely rewritten to make use of the */
/* routines DAFT2B and TXTOPR, for converting a text file to */
/* binary and opening a text file. It now simply calls the */
/* routine DAFT2B after opening the text file. */
/* Added a statement to the $ Particulars section to the effect */
/* that this routine has been made obsolete by the introduction of */
/* the routine DAFTB, and that the use of the new routine is */
/* strongly recommended for new software development. */
/* Modified the $ Abstract section to reflect the fact that this */
/* routine is obsolete. */
/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DAFA2B", (ftnlen)6);
}
/* Open the ASCII file for reading. If an error occurs, then check */
/* out and return. An appropriate error message will have already */
/* been set. */
txtopr_(ascii, &unit, ascii_len);
if (failed_()) {
chkout_("DAFA2B", (ftnlen)6);
return 0;
}
/* Call DAFT2B to perform the conversion. If it fails, then just */
/* check out and return, as an appropriate error message should have */
/* already been set. Also close the text file that we opened. */
daft2b_(&unit, binary, resv, binary_len);
if (failed_()) {
cl__1.cerr = 0;
cl__1.cunit = unit;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("DAFA2B", (ftnlen)6);
return 0;
}
/* Close the file. */
cl__1.cerr = 0;
cl__1.cunit = unit;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("DAFA2B", (ftnlen)6);
return 0;
} /* dafa2b_ */
/* $Procedure ZZGFDIQ ( GF, return distance between objects ) */
/* Subroutine */ int zzgfdiq_(integer *targid, doublereal *et, char *abcorr,
integer *obsid, doublereal *dist, ftnlen abcorr_len)
{
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern doublereal vnorm_(doublereal *);
extern logical failed_(void);
doublereal lt;
extern /* Subroutine */ int chkout_(char *, ftnlen), spkezp_(integer *,
doublereal *, char *, char *, integer *, doublereal *, doublereal
*, ftnlen, ftnlen);
extern logical return_(void);
doublereal pos[3];
/* $ 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 distance between two ephemeris objects, optionally */
/* corrected for 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 */
/* GF */
/* NAIF_IDS */
/* SPK */
/* TIME */
/* $ Keywords */
/* DISTANCE */
/* EPHEMERIS */
/* GEOMETRY */
/* SEARCH */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* TARGID I Target body. */
/* ET I Observer epoch. */
/* ABCORR I Aberration correction flag. */
/* OBSID I Observing body. */
/* DIST O Distance between target and observer. */
/* $ Detailed_Input */
/* TARGID is the NAIF ID code for a target body. The target and */
/* observer define a position vector that 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. */
/* 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. Any */
/* aberration correction accepted by SPKEZR may be used. */
/* $ Detailed_Output */
/* DIST is the norm (magnitude) of the specified Cartesian */
/* 3-vector representing the position of the target body */
/* relative to the specified observer, where the */
/* position is corrected for the specified aberrations. */
/* The position vector points from the observer's */
/* location at ET to the aberration-corrected location */
/* of the target. */
/* Units are km. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) 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 */
/* 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 for the */
/* input epoch 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. */
/* - If non-inertial reference frames are used, then PCK */
/* files, frame kernels, C-kernels, and SCLK kernels may be */
/* needed. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine centralizes distance computations performed by */
/* entry points in the GF distance utility package ZZGFDIU. */
/* $ Examples */
/* See the entry point ZZGFDIGQ in ZZGFDIU. */
/* $ Restrictions */
/* This is a SPICELIB private routine; it should not be called by */
/* user applications. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.S. Elson (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */
/* -& */
/* $ Index_Entries */
/* compute the apparent distance between two objects */
/* -& */
/* SPICELIB functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFDIQ", (ftnlen)7);
/* Get the position of the target relative to the observer. */
spkezp_(targid, et, "J2000", abcorr, obsid, pos, <, (ftnlen)5,
abcorr_len);
if (failed_()) {
chkout_("ZZGFDIQ", (ftnlen)7);
return 0;
}
*dist = vnorm_(pos);
chkout_("ZZGFDIQ", (ftnlen)7);
return 0;
} /* zzgfdiq_ */
/* $Procedure DGEODR ( Derivative of geodetic w.r.t. rectangular ) */
/* Subroutine */ int dgeodr_(doublereal *x, doublereal *y, doublereal *z__,
doublereal *re, doublereal *f, doublereal *jacobi)
{
doublereal long__;
extern /* Subroutine */ int chkin_(char *, ftnlen), vpack_(doublereal *,
doublereal *, doublereal *, doublereal *), errdp_(char *,
doublereal *, ftnlen);
doublereal injacb[9] /* was [3][3] */;
extern /* Subroutine */ int recgeo_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), drdgeo_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal rectan[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int invort_(doublereal *, doublereal *);
doublereal lat, alt;
/* $ Abstract */
/* This routine computes the Jacobian of the transformation from */
/* rectangular to geodetic coordinates. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* COORDINATES */
/* DERIVATIVES */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* X I X-coordinate of point. */
/* Y I Y-coordinate of point. */
/* Z I Z-coordinate of point. */
/* RE I Equatorial radius of the reference spheroid. */
/* F I Flattening coefficient. */
/* JACOBI O Matrix of partial derivatives. */
/* $ Detailed_Input */
/* X, */
/* Y, */
/* Z are the rectangular coordinates of the point at */
/* which the Jacobian of the map from rectangular */
/* to geodetic coordinates is desired. */
/* RE Equatorial radius of the reference spheroid. */
/* F Flattening coefficient = (RE-RP) / RE, where RP is */
/* the polar radius of the spheroid. (More importantly */
/* RP = RE*(1-F).) */
/* $ Detailed_Output */
/* JACOBI is the matrix of partial derivatives of the conversion */
/* between rectangular and geodetic coordinates. It */
/* has the form */
/* .- -. */
/* | DLONG/DX DLONG/DY DLONG/DZ | */
/* | DLAT/DX DLAT/DY DLAT/DZ | */
/* | DALT/DX DALT/DY DALT/DZ | */
/* `- -' */
/* evaluated at the input values of X, Y, and Z. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input point is on the z-axis (X and Y = 0), the */
/* Jacobian is undefined. The error SPICE(POINTONZAXIS) */
/* will be signaled. */
/* 2) If the flattening coefficient is greater than or equal to */
/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */
/* 3) If the equatorial radius is not positive, the error */
/* SPICE(BADRADIUS) is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* When performing vector calculations with velocities it is */
/* usually most convenient to work in rectangular coordinates. */
/* However, once the vector manipulations have been performed, */
/* it is often desirable to convert the rectangular representations */
/* into geodetic coordinates to gain insights about phenomena */
/* in this coordinate frame. */
/* To transform rectangular velocities to derivatives of coordinates */
/* in a geodetic system, one uses the Jacobian of the transformation */
/* between the two systems. */
/* Given a state in rectangular coordinates */
/* ( x, y, z, dx, dy, dz ) */
/* the velocity in geodetic coordinates is given by the matrix */
/* equation: */
/* t | t */
/* (dlon, dlat, dalt) = JACOBI| * (dx, dy, dz) */
/* |(x,y,z) */
/* This routine computes the matrix */
/* | */
/* JACOBI| */
/* |(x, y, z) */
/* $ Examples */
/* Suppose one is given the bodyfixed rectangular state of an object */
/* (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. */
/* To find the derivatives of the coordinates of the object in */
/* bodyfixed geodetic coordinates, one simply multiplies the */
/* Jacobian of the transformation from rectangular to geodetic */
/* coordinates (evaluated at x(t), y(t), z(t)) by the rectangular */
/* velocity vector of the object at time t. */
/* In code this looks like: */
/* C */
/* C Load the rectangular velocity vector vector RECV. */
/* C */
/* RECV(1) = DX_DT ( T ) */
/* RECV(2) = DY_DT ( T ) */
/* RECV(3) = DZ_DT ( T ) */
/* C */
/* C Determine the Jacobian of the transformation from */
/* C rectangular to geodetic coordinates at the rectangular */
/* C coordinates at time T. */
/* C */
/* CALL DGEODR ( X(T), Y(T), Z(T), RE, F, JACOBI ) */
/* C */
/* C Multiply the Jacobian on the right by the rectangular */
/* C velocity to obtain the geodetic coordinate derivatives */
/* C GEOV. */
/* C */
/* CALL MXV ( JACOBI, RECV, GEOV ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-JUL-2001 (WLT) */
/* -& */
/* $ Index_Entries */
/* Jacobian of geodetic w.r.t. rectangular coordinates */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DGEODR", (ftnlen)6);
}
/* If the flattening coefficient is greater than one, the polar */
/* radius computed below is negative. If it's equal to one, the */
/* polar radius is zero. Either case is a problem, so signal an */
/* error and check out. */
if (*f >= 1.) {
setmsg_("Flattening coefficient was *.", (ftnlen)29);
errdp_("*", f, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DGEODR", (ftnlen)6);
return 0;
}
if (*re <= 0.) {
setmsg_("Equatorial Radius <= 0.0D0. RE = *", (ftnlen)34);
errdp_("*", re, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("DGEODR", (ftnlen)6);
return 0;
}
/* There is a singularity of the Jacobian for points on the z-axis. */
if (*x == 0. && *y == 0.) {
setmsg_("The Jacobian of the transformation from rectangular to geod"
"etic coordinates is not defined for points on the z-axis.", (
ftnlen)116);
sigerr_("SPICE(POINTONZAXIS)", (ftnlen)19);
chkout_("DGEODR", (ftnlen)6);
return 0;
}
/* We will get the Jacobian of rectangular to geodetic by */
/* implicit differentiation. */
/* First move the X,Y and Z coordinates into a vector. */
vpack_(x, y, z__, rectan);
/* Convert from rectangular to geodetic coordinates. */
recgeo_(rectan, re, f, &long__, &lat, &alt);
/* Get the Jacobian of the transformation from geodetic to */
/* rectangular coordinates at LONG, LAT, ALT. */
drdgeo_(&long__, &lat, &alt, re, f, injacb);
/* Now invert INJACB to get the Jacobian of the transformation */
/* from rectangular to geodetic coordinates. */
invort_(injacb, jacobi);
chkout_("DGEODR", (ftnlen)6);
return 0;
} /* dgeodr_ */
/* $Procedure PARCML ( Parse command line) */
/* Subroutine */ int parcml_(char *line, integer *maxkey, char *clkeys,
logical *clflag, char *clvals, logical *found, ftnlen line_len,
ftnlen clkeys_len, ftnlen clvals_len)
{
/* System generated locals */
address a__1[2];
integer i__1, i__2[2];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static char hkey[1024];
static integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static char hline[1024];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
static integer clidx;
static char uline[1024], lngwd[1024];
extern integer rtrim_(char *, ftnlen);
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
static integer begpos, pclidx;
static char hlngwd[1024];
static integer endpos;
extern /* Subroutine */ int chkout_(char *, ftnlen), nextwd_(char *, char
*, char *, ftnlen, ftnlen, ftnlen);
extern logical return_(void);
extern integer pos_(char *, char *, integer *, ftnlen, ftnlen);
/* $ Abstract */
/* This routine parses "command-line" looking line and returns */
/* values of requested keys. */
/* $ 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 */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* LINE I Input line. */
/* MAXKEY I Number of keys. */
/* CLKEYS I Keys. */
/* CLFLAG O "Key-found" flags. */
/* CLVALS O Key values. */
/* FOUND O Flag indicating that at least one key was found. */
/* $ Detailed_Input */
/* LINE Input line in a format "-key value -key value ..." */
/* MAXKEY Total number of keys to look for. */
/* CLKEYS Keys to look for; uppercased. */
/* $ Detailed_Output */
/* CLFLAG Flags set TRUE if corresponding key was found. */
/* CLVALS Values key; if key wasn't found, value set to */
/* blank string. */
/* FOUND .TRUE. if at least one key was found. */
/* Otherwise -- .FALSE. */
/* $ Parameters */
/* TBD. */
/* $ Exceptions */
/* TBD */
/* $ Files */
/* None. */
/* $ Particulars */
/* TBD */
/* $ Examples */
/* Let CLKEYS be */
/* CLKEYS(1) = '-SETUP' */
/* CLKEYS(2) = '-TO' */
/* CLKEYS(3) = '-FROM' */
/* CLKEYS(4) = '-HELP' */
/* then: */
/* line '-setup my.file -from utc -to sclk' */
/* will be parsed as */
/* CLFLAG(1) = .TRUE. CLVALS(1) = 'my.file' */
/* CLFLAG(2) = .TRUE. CLVALS(2) = 'utc' */
/* CLFLAG(3) = .TRUE. CLVALS(3) = 'sclk' */
/* CLFLAG(4) = .FALSE. CLVALS(4) = ' ' */
/* FOUND = .TRUE. */
/* line '-setup my.file -setup your.file' */
/* will be parsed as */
/* CLFLAG(1) = .TRUE. CLVALS(1) = 'your.file' */
/* CLFLAG(2) = .FALSE. CLVALS(2) = ' ' */
/* CLFLAG(3) = .FALSE. CLVALS(3) = ' ' */
/* CLFLAG(4) = .FALSE. CLVALS(4) = ' ' */
/* FOUND = .TRUE. */
/* line '-setup my.file -SeTuP your.file' */
/* will be parsed as */
/* CLFLAG(1) = .TRUE. CLVALS(1) = 'your.file' */
/* CLFLAG(2) = .FALSE. CLVALS(2) = ' ' */
/* CLFLAG(3) = .FALSE. CLVALS(3) = ' ' */
/* CLFLAG(4) = .FALSE. CLVALS(4) = ' ' */
/* FOUND = .TRUE. */
/* line '-help' */
/* will be parsed as */
/* CLFLAG(1) = .FALSE. CLVALS(1) = ' ' */
/* CLFLAG(2) = .FALSE. CLVALS(2) = ' ' */
/* CLFLAG(3) = .FALSE. CLVALS(3) = ' ' */
/* CLFLAG(4) = .TRUE. CLVALS(4) = ' ' */
/* FOUND = .TRUE. */
/* and so on. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - Alpha Version 1.0.0, 12-SEP-2008 (BVS) */
/* -& */
/* Save everything to prevent potential memory problems in f2c'ed */
/* version. */
/* SPICELIB functions. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("PARCML", (ftnlen)6);
}
/* Command line parse loop. Set initial values to blanks. */
i__1 = *maxkey;
for (i__ = 1; i__ <= i__1; ++i__) {
clflag[i__ - 1] = FALSE_;
s_copy(clvals + (i__ - 1) * clvals_len, " ", clvals_len, (ftnlen)1);
}
*found = FALSE_;
s_copy(hline, line, (ftnlen)1024, line_len);
pclidx = 0;
clidx = 0;
while(s_cmp(hline, " ", (ftnlen)1024, (ftnlen)1) != 0) {
/* Get next word, uppercase it. */
nextwd_(hline, lngwd, hline, (ftnlen)1024, (ftnlen)1024, (ftnlen)1024)
;
ucase_(lngwd, hlngwd, (ftnlen)1024, (ftnlen)1024);
clidx = isrchc_(hlngwd, maxkey, clkeys, (ftnlen)1024, clkeys_len);
/* Is the token that we found a command line key? */
if (clidx != 0) {
/* Is it the first key that we have found? */
if (pclidx != 0) {
/* It's not. Save value of the previous key. Compute begin */
/* and end position of substring that contains this */
/* value. */
ucase_(line, uline, line_len, (ftnlen)1024);
begpos = pos_(uline, clkeys + (pclidx - 1) * clkeys_len, &
c__1, (ftnlen)1024, rtrim_(clkeys + (pclidx - 1) *
clkeys_len, clkeys_len)) + rtrim_(clkeys + (pclidx -
1) * clkeys_len, clkeys_len);
/* Writing concatenation */
i__2[0] = 1, a__1[0] = " ";
i__2[1] = rtrim_(clkeys + (clidx - 1) * clkeys_len,
clkeys_len), a__1[1] = clkeys + (clidx - 1) *
clkeys_len;
s_cat(hkey, a__1, i__2, &c__2, (ftnlen)1024);
endpos = pos_(uline, hkey, &begpos, (ftnlen)1024, rtrim_(hkey,
(ftnlen)1024) + 1);
/* Extract the value, left-justify and RTRIM it. Set */
/* "value present" flag to .TRUE. */
s_copy(clvals + (pclidx - 1) * clvals_len, line + (begpos - 1)
, clvals_len, endpos - (begpos - 1));
ljust_(clvals + (pclidx - 1) * clvals_len, clvals + (pclidx -
1) * clvals_len, clvals_len, clvals_len);
s_copy(clvals + (pclidx - 1) * clvals_len, clvals + (pclidx -
1) * clvals_len, clvals_len, rtrim_(clvals + (pclidx
- 1) * clvals_len, clvals_len));
clflag[pclidx - 1] = TRUE_;
/* Check whether we already parsed the whole line. */
if (s_cmp(hline, " ", (ftnlen)1024, (ftnlen)1) != 0) {
/* We are not at the end of the command line. There is */
/* more stuff to parse and we put this stuff to */
/* the HLINE. */
i__1 = endpos + 1 + rtrim_(clkeys + (clidx - 1) *
clkeys_len, clkeys_len) - 1;
s_copy(hline, line + i__1, (ftnlen)1024, line_len - i__1);
}
/* Now reset our line and previous index. */
i__1 = endpos;
s_copy(line, line + i__1, line_len, line_len - i__1);
}
/* Save current key index in as previous. */
pclidx = clidx;
}
}
/* We need to save the last value. */
if (pclidx != 0) {
*found = TRUE_;
/* Save the last value. */
clflag[pclidx - 1] = TRUE_;
if (rtrim_(line, line_len) > rtrim_(clkeys + (pclidx - 1) *
clkeys_len, clkeys_len)) {
/* Compute begin position of, extract, left justify and */
/* RTRIM the last value. */
ucase_(line, uline, line_len, (ftnlen)1024);
begpos = pos_(uline, clkeys + (pclidx - 1) * clkeys_len, &c__1, (
ftnlen)1024, rtrim_(clkeys + (pclidx - 1) * clkeys_len,
clkeys_len)) + rtrim_(clkeys + (pclidx - 1) * clkeys_len,
clkeys_len);
s_copy(clvals + (pclidx - 1) * clvals_len, line + (begpos - 1),
clvals_len, line_len - (begpos - 1));
ljust_(clvals + (pclidx - 1) * clvals_len, clvals + (pclidx - 1) *
clvals_len, clvals_len, clvals_len);
s_copy(clvals + (pclidx - 1) * clvals_len, clvals + (pclidx - 1) *
clvals_len, clvals_len, rtrim_(clvals + (pclidx - 1) *
clvals_len, clvals_len));
} else {
/* The key is the last thing on the line. So, it's value */
/* is blank. */
s_copy(clvals + (pclidx - 1) * clvals_len, " ", clvals_len, (
ftnlen)1);
}
}
chkout_("PARCML", (ftnlen)6);
return 0;
} /* parcml_ */
/* $Procedure ENCHAR ( Encode a character string ) */
/* Subroutine */ int enchar_0_(int n__, integer *number, char *string, ftnlen
string_len)
{
/* Builtin functions */
integer i_len(char *, ftnlen);
/* Local variables */
integer base, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer chbase_(void);
integer remain;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
extern logical return_(void);
integer num;
/* $ Abstract */
/* Encode a nonnegative integer number into a character string */
/* as the expansion of the number in base CHBASE (a function of */
/* the size of the available character set). */
/* $ 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 */
/* CELLS, CHARACTER */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NUMBER I Number to be encoded. */
/* STRING O Encoded string. */
/* MINLEN P Minimum length of string. */
/* $ Detailed_Input */
/* NUMBER is an arbitrary nonnegative integer. */
/* $ Detailed_Output */
/* STRING is the character string implied by the ASCII */
/* interpretation of NUMBER when converted to its */
/* base CHBASE representation. */
/* Let L be the declared length of STRING, and let */
/* NUMBER be given by */
/* 0 1 L-1 */
/* NUMBER = a CHBASE + a CHBASE + ... + a CHBASE */
/* 1 2 L */
/* Then */
/* STRING(i:i) = CHAR(a ) for i = 1, L */
/* i */
/* Note that, just as for any other "numbers", */
/* the "digits" in STRING are arranged from right */
/* to left in order of increasing significance. */
/* The string is, in effect, "padded with nulls" */
/* on the left. */
/* $ Parameters */
/* MINLEN is the minimum length of a string into which a */
/* number may be encoded. In order to avoid padding */
/* long strings with hundreds, possibly thousands */
/* of null characters, only the first MINLEN characters */
/* of the string are actually used. Note that this */
/* also allows the encoded number to be preserved */
/* during assignments, */
/* STR1 = STR2 */
/* so long as both strings are of length MINLEN or */
/* greater. */
/* $ Exceptions */
/* 1) If the length of the output string is less than MINLEN, */
/* the error 'SPICE(INSUFFLEN)' is signalled. */
/* 2) If the number to be encoded is negative, the error */
/* 'SPICE(OUTOFRANGE)' is signalled. */
/* MINLEN */
/* 3) If the number to be encoded is larger than CHBASE - 1, */
/* the error 'SPICE(OUTOFRANGE)' is signalled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The value of CHBASE, which varies from machine to machine, is */
/* returned by a constant function of the same name. */
/* $ Examples */
/* See: SCARDC, SSIZEC. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 31-JAN-2008 (BVS) */
/* Changed header section title '$C Revision' to '$C Revisions'. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* encode a character_string */
/* -& */
/* $ Revisions */
/* - Beta Version 2.0.0, 13-JAN-1989 (IMU) */
/* Only the first MINLEN characters of the string are now */
/* used to encode the value. Also, negative values are now */
/* treated as errors. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
switch(n__) {
case 1:
goto L_dechar;
}
if (return_()) {
return 0;
} else if (i_len(string, string_len) < 5) {
chkin_("ENCHAR", (ftnlen)6);
sigerr_("SPICE(INSUFFLEN)", (ftnlen)16);
chkout_("ENCHAR", (ftnlen)6);
return 0;
} else if (*number < 0) {
chkin_("ENCHAR", (ftnlen)6);
sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17);
chkout_("ENCHAR", (ftnlen)6);
return 0;
}
/* Generate the digits from right to left. */
base = chbase_();
num = *number;
for (i__ = 5; i__ >= 1; --i__) {
remain = num % base;
*(unsigned char *)&string[i__ - 1] = (char) remain;
num /= base;
}
/* More error handling. */
if (num > 0) {
chkin_("ENCHAR", (ftnlen)6);
sigerr_("SPICE(OUTOFRANGE)", (ftnlen)17);
chkout_("ENCHAR", (ftnlen)6);
}
return 0;
/* $Procedure DECHAR ( Decode a character string ) */
L_dechar:
/* $ Abstract */
/* Decode a character string encoded by ENCHAR. */
/* $ 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 */
/* CHARACTER */
/* $ Declarations */
/* CHARACTER*(*) STRING */
/* INTEGER NUMBER */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* STRING I Encoded character string. */
/* NUMBER O Decoded number. */
/* $ Detailed_Input */
/* STRING is a character string previously encoded by ENCHAR. */
/* This contains an integer in base CHBASE notation, */
/* where CHBASE is a function of the size of the */
/* available character set. See ENCHAR for details */
/* about the format of STRING. */
/* $ Detailed_Output */
/* NUMBER is the integer encoded in the input string. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the length of the input string is less than MINLEN, */
/* the error 'SPICE(INSUFFLEN)' is signalled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* DECHAR is the inverse of ENCHAR. In the example below, */
/* CALL ENCHAR ( I, STRING ) */
/* CALL DECHAR ( STRING, J ) */
/* IF ( I .EQ. J ) THEN */
/* . */
/* . */
/* END IF */
/* the logical test (I .EQ. J) is always true. */
/* $ Examples */
/* See: CARDC, SIZEC. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 31-JAN-2008 (BVS) */
/* Changed header section title '$C Revision' to '$C Revisions'. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* decode a character_string */
/* -& */
/* $ Revisions */
/* - Beta Version 2.0.0, 13-JAN-1989 (IMU) */
/* Changed to reflect changes in ENCHAR. In particular, */
/* it now checks the length of the input string. It is */
/* also an entry point of ENCHAR, to make sure they always */
/* have the same value of MINLEN. (Also, if CHBASE is */
/* changed, ENCHAR and DECHAR will always be recompiled */
/* simultaneously.) */
/* -& */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else if (i_len(string, string_len) < 5) {
chkin_("DECHAR", (ftnlen)6);
sigerr_("SPICE(INSUFFLEN)", (ftnlen)16);
chkout_("DECHAR", (ftnlen)6);
return 0;
}
/* Sum the products of the 'digits' and the corresponding powers */
/* of NDCHAR, just like any other base conversion. */
base = chbase_();
*number = 0;
for (i__ = 1; i__ <= 5; ++i__) {
*number = base * *number + *(unsigned char *)&string[i__ - 1];
}
return 0;
} /* enchar_ */
/* $Procedure ZZSPKGP1 ( S/P Kernel, geometric position ) */
/* Subroutine */ int zzspkgp1_(integer *targ, doublereal *et, char *ref,
integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
extern /* Subroutine */ int zzrefch1_(integer *, integer *, doublereal *,
doublereal *), vadd_(doublereal *, doublereal *, doublereal *);
integer cobs, legs;
doublereal sobs[6];
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *), zznamfrm_(integer *, char *,
integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer
*);
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
char oname[40];
doublereal descr[5];
integer ctarg[20];
char ident[40], tname[40];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
moved_(doublereal *, integer *, doublereal *);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal starg[120] /* was [6][20] */;
logical nofrm;
static char svref[32];
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
static integer svctr1[2];
extern logical failed_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
integer handle, cframe;
extern doublereal clight_(void);
integer tframe[20];
extern integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svrefi;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
integer tmpfrm;
extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *),
spksfs_(integer *, doublereal *, integer *, doublereal *, char *,
logical *, ftnlen);
extern integer frstnp_(char *, ftnlen);
extern logical return_(void);
doublereal psxfrm[9] /* was [3][3] */;
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), intstr_(integer *, char *,
ftnlen);
integer nct;
doublereal rot[9] /* was [3][3] */;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
char tstring[80];
/* $ Abstract */
/* 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. */
/* Compute the geometric position of a target body relative to an */
/* observing body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* This file contains the number of inertial reference */
/* frames that are currently known by the SPICE toolkit */
/* software. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* FRAMES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NINERT P Number of known inertial reference frames. */
/* $ Parameters */
/* NINERT is the number of recognized inertial reference */
/* frames. This value is needed by both CHGIRF */
/* ZZFDAT, and FRAMEX. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */
/* -& */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* OBS I Observing body. */
/* POS O Position of target. */
/* LT O Light time. */
/* $ Detailed_Input */
/* TARG is the standard NAIF ID code for a target body. */
/* ET is the epoch (ephemeris time) at which the position */
/* of the target body is to be computed. */
/* REF is the name of the reference frame to */
/* which the vectors returned by the routine should */
/* be rotated. This may be any frame supported by */
/* the SPICELIB subroutine ZZREFCH1. */
/* OBS is the standard NAIF ID code for an observing body. */
/* $ Detailed_Output */
/* POS contains the position of the target */
/* body, relative to the observing body. This vector is */
/* rotated into the specified reference frame. Units */
/* are always km. */
/* LT is the one-way light time from the observing body */
/* to the geometric position of the target body at the */
/* specified epoch. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If insufficient ephemeris data has been loaded to compute */
/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */
/* signalled. */
/* $ Files */
/* See: $Restrictions. */
/* $ Particulars */
/* ZZSPKGP1 computes the geometric position, T(t), of the target */
/* body and the geometric position, O(t), of the observing body */
/* relative to the first common center of motion. Subtracting */
/* O(t) from T(t) gives the geometric position of the target */
/* body relative to the observer. */
/* CENTER ----- O(t) */
/* | / */
/* | / */
/* | / */
/* | / T(t) - O(t) */
/* | / */
/* T(t) */
/* The one-way light time, tau, is given by */
/* | T(t) - O(t) | */
/* tau = ----------------- */
/* c */
/* For example, if the observing body is -94, the Mars Observer */
/* spacecraft, and the target body is 401, Phobos, then the */
/* first common center is probably 4, the Mars Barycenter. */
/* O(t) is the position of -94 relative to 4 and T(t) is the */
/* position of 401 relative to 4. */
/* The center could also be the Solar System Barycenter, body 0. */
/* For example, if the observer is 399, Earth, and the target */
/* is 299, Venus, then O(t) would be the position of 399 relative */
/* to 0 and T(t) would be the position of 299 relative to 0. */
/* Ephemeris data from more than one segment may be required */
/* to determine the positions of the target body and observer */
/* relative to a common center. ZZSPKGP1 reads as many segments */
/* as necessary, from as many files as necessary, using files */
/* that have been loaded by previous calls to SPKLEF (load */
/* ephemeris file). */
/* ZZSPKGP1 is similar to SPKGEO but returns geometric positions */
/* only. */
/* $ Examples */
/* The following code example computes the geometric */
/* position of the moon with respect to the earth and */
/* then prints the distance of the moon from the */
/* the earth at a number of epochs. */
/* Assume the SPK file SAMPLE.BSP contains ephemeris data */
/* for the moon relative to earth over the time interval */
/* from BEGIN to END. */
/* INTEGER EARTH */
/* PARAMETER ( EARTH = 399 ) */
/* INTEGER MOON */
/* PARAMETER ( MOON = 301 ) */
/* INTEGER N */
/* PARAMETER ( N = 100 ) */
/* INTEGER I */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL FURNSH ( 'SAMPLE.BSP' ) */
/* . */
/* . */
/* . */
/* C */
/* C Divide the interval of coverage [BEGIN,END] into */
/* C N steps. At each step, compute the position, and */
/* C print out the epoch in UTC time and position norm. */
/* C */
/* DELTA = ( END - BEGIN ) / N */
/* DO I = 0, N */
/* ET = BEGIN + I*DELTA */
/* CALL ZZSPKGP1 ( MOON, ET, 'J2000', EARTH, POS, LT ) */
/* CALL ET2UTC ( ET, 'C', 0, UTC ) */
/* WRITE (*,*) UTC, VNORM ( POS ) */
/* END DO */
/* $ Restrictions */
/* 1) SPICE Private routine. */
/* 2) The ephemeris files to be used by ZZSPKGP1 must be loaded */
/* by SPKLEF before ZZSPKGP1 is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* Updated to map the input frame name to its ID by first calling */
/* ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/* change is that now the frame with the fixed name 'DEFAULT' */
/* that can be associated with any code via CHGIRF's entry point */
/* IRFDEF will be fully masked by a frame with indentical name */
/* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/* frame masked the text kernel frame with the same name. */
/* Replaced SPKLEF with FURNSH and fixed errors in Examples. */
/* - SPICELIB Version 1.1.0, 09-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */
/* Based on SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* geometric position of one body relative to another */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 09-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* -& */
/* This is the idea: */
/* Every body moves with respect to some center. The center */
/* is itself a body, which in turn moves about some other */
/* center. If we begin at the target body (T), follow */
/* the chain, */
/* T */
/* \ */
/* SSB \ */
/* \ C[1] */
/* \ / */
/* \ / */
/* \ / */
/* \ / */
/* C[3]-----------C[2] */
/* and avoid circular definitions (A moves about B, and B moves */
/* about A), eventually we get the position relative to the solar */
/* system barycenter (which, for our purposes, doesn't move). */
/* Thus, */
/* T = T + C[1] + C[2] + ... + C[n] */
/* SSB C[1] C[2] [C3] SSB */
/* where */
/* X */
/* Y */
/* is the position of body X relative to body Y. */
/* However, we don't want to follow each chain back to the SSB */
/* if it isn't necessary. Instead we will just follow the chain */
/* of the target body and follow the chain of the observing body */
/* until we find a common node in the tree. */
/* In the example below, C is the first common node. We compute */
/* the position of TARG relative to C and the position of OBS */
/* relative to C, then subtract the two positions. */
/* TARG */
/* \ */
/* SSB \ */
/* \ A */
/* \ / OBS */
/* \ / | */
/* \ / | */
/* \ / | */
/* B-------------C-----------------D */
/* SPICELIB functions */
/* Local parameters */
/* CHLEN is the maximum length of a chain. That is, */
/* it is the maximum number of bodies in the chain from */
/* the target or observer to the SSB. */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZSPKGP1", (ftnlen)8);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* We take care of the obvious case first. It TARG and OBS are the */
/* same we can just fill in zero. */
if (*targ == *obs) {
*lt = 0.;
cleard_(&c__3, pos);
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
/* CTARG contains the integer codes of the bodies in the */
/* target body chain, beginning with TARG itself and then */
/* the successive centers of motion. */
/* STARG(1,I) is the position of the target body relative */
/* to CTARG(I). The id-code of the frame of this position is */
/* stored in TFRAME(I). */
/* COBS and SOBS will contain the centers and positions of the */
/* observing body. (They are single elements instead of arrays */
/* because we only need the current center and position of the */
/* observer relative to it.) */
/* First, we construct CTARG and STARG. CTARG(1) is */
/* just the target itself, and STARG(1,1) is just a zero */
/* vector, that is, the position of the target relative */
/* to itself. */
/* Then we follow the chain, filling up CTARG and STARG */
/* as we go. We use SPKSFS to search through loaded */
/* files to find the first segment applicable to CTARG(1) */
/* and time ET. Then we use SPKPVN to compute the position */
/* of the body CTARG(1) at ET in the segment that was found */
/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */
/* We repeat the process for CTARG(2) and so on, until */
/* there is no data found for some CTARG(I) or until we */
/* reach the SSB. */
/* Next, we find centers and positions in a similar manner */
/* for the observer. It's a similar construction as */
/* described above, but I is always 1. COBS and SOBS */
/* are overwritten with each new center and position, */
/* beginning at OBS. However, we stop when we encounter */
/* a common center of motion, that is when COBS is equal */
/* to CTARG(I) for some I. */
/* Finally, we compute the desired position of the target */
/* relative to the observer by subtracting the position of */
/* the observing body relative to the common node from */
/* the position of the target body relative to the common */
/* node. */
/* CTPOS is the position in CTARG of the common node. */
/* Since the upgrade to use hashes and counter bypass ZZNAMFRM */
/* became more efficient in looking up frame IDs than IRFNUM. So the */
/* original order of calls "IRFNUM first, NAMFRM second" was */
/* switched to "ZZNAMFRM first, IRFNUM second". */
/* The call to IRFNUM, now redundant for built-in inertial frames, */
/* was preserved to for a sole reason -- to still support the */
/* ancient and barely documented ability for the users to associate */
/* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/* frame code via CHGIRF's entry point IRFDEF. */
/* Note that in the case of ZZNAMFRM's failure to resolve name and */
/* IRFNUM's success to do so, the code returned by IRFNUM for */
/* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/* should it change between the calls. */
zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
if (refid == 0) {
irfnum_(ref, &refid, ref_len);
}
if (refid == 0) {
if (frstnp_(ref, ref_len) > 0) {
setmsg_("The string supplied to specify the reference frame, ('#"
"') contains non-printing characters. The two most commo"
"n causes for this kind of error are: 1. an error in the "
"call to ZZSPKGP1; 2. an uninitialized variable. ", (
ftnlen)215);
errch_("#", ref, (ftnlen)1, ref_len);
} else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) {
setmsg_("The string supplied to specify the reference frame is b"
"lank. The most common cause for this kind of error is a"
"n uninitialized variable. ", (ftnlen)137);
} else {
setmsg_("The string supplied to specify the reference frame was "
"'#'. This frame is not recognized. Possible causes for "
"this error are: 1. failure to load the frame definition "
"into the kernel pool; 2. An out-of-date edition of the t"
"oolkit. ", (ftnlen)231);
errch_("#", ref, (ftnlen)1, ref_len);
}
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
}
/* Fill in CTARG and STARG until no more data is found */
/* or until we reach the SSB. If the chain gets too */
/* long to fit in CTARG, that is if I equals CHLEN, */
/* then overwrite the last elements of CTARG and STARG. */
/* Note the check for FAILED in the loop. If SPKSFS */
/* or SPKPVN happens to fail during execution, and the */
/* current error handling action is to NOT abort, then */
/* FOUND may be stuck at TRUE, CTARG(I) will never */
/* become zero, and the loop will execute indefinitely. */
/* Construct CTARG and STARG. Begin by assigning the */
/* first elements: TARG and the position of TARG relative */
/* to itself. */
i__ = 1;
ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1,
"zzspkgp1_", (ftnlen)610)] = *targ;
found = TRUE_;
cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)613)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "zzspkgp1_", (ftnlen)615)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "zzspkgp1_", (ftnlen)615)] != 0) {
/* Find a file and segment that has position */
/* data for CTARG(I). */
spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"ctarg", i__1, "zzspkgp1_", (ftnlen)624)], et, &handle, descr,
ident, &found, (ftnlen)40);
if (found) {
/* Get the position of CTARG(I) relative to some */
/* center of motion. This new center goes in */
/* CTARG(I+1) and the position is called STEMP. */
++i__;
spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <=
i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen)
634)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)634)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "zzspkgp1_", (ftnlen)634)]);
/* Here's what we have. STARG is the position of CTARG(I-1) */
/* relative to CTARG(I) in reference frame TFRAME(I) */
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
}
}
tframe[0] = tframe[1];
/* If the loop above ended because we ran out of */
/* room in the arrays CTARG and STARG, then we */
/* continue finding positions but we overwrite the */
/* last elements of CTARG and STARG. */
/* If, as a result, the first common node is */
/* overwritten, we'll just have to settle for */
/* the last common node. This will cause a small */
/* loss of precision, but it's better than other */
/* alternatives. */
if (i__ == 20) {
while(found && ctarg[19] != 0 && ctarg[19] != *obs) {
/* Find a file and segment that has position */
/* data for CTARG(CHLEN). */
spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
;
if (found) {
/* Get the position of CTARG(CHLEN) relative to */
/* some center of motion. The new center */
/* overwrites the old. The position is called */
/* STEMP. */
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);
/* Add STEMP to the position of TARG relative to */
/* the old center to get the position of TARG */
/* relative to the new center. Overwrite */
/* the last element of STARG. */
if (tframe[19] == tmpfrm) {
moved_(&starg[114], &c__3, vtemp);
} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 &&
tframe[19] <= 21) {
irfrot_(&tframe[19], &tmpfrm, rot);
mxv_(rot, &starg[114], vtemp);
} else {
zzrefch1_(&tframe[19], &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
mxv_(psxfrm, &starg[114], vtemp);
}
vadd_(vtemp, stemp, &starg[114]);
tframe[19] = tmpfrm;
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
}
}
}
nct = i__;
/* NCT is the number of elements in CTARG, */
/* the chain length. We have in hand the following information */
/* STARG(1...3,K) position of body */
/* CTARG(K-1) relative to body CTARG(K) in the frame */
/* TFRAME(K) */
/* For K = 2,..., NCT. */
/* CTARG(1) = TARG */
/* STARG(1...3,1) = ( 0, 0, 0 ) */
/* TFRAME(1) = TFRAME(2) */
/* Now follow the observer's chain. Assign */
/* the first values for COBS and SOBS. */
cobs = *obs;
cleard_(&c__6, sobs);
/* Perhaps we have a common node already. */
/* If so it will be the last node on the */
/* list CTARG. */
/* We let CTPOS will be the position of the common */
/* node in CTARG if one is found. It will */
/* be zero if COBS is not found in CTARG. */
if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg",
i__1, "zzspkgp1_", (ftnlen)769)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "zzspkgp1_", (ftnlen)771)];
} else {
ctpos = 0;
}
/* Repeat the same loop as above, but each time */
/* we encounter a new center of motion, check to */
/* see if it is a common node. (When CTPOS is */
/* not zero, CTARG(CTPOS) is the first common node.) */
/* Note that we don't need a centers array nor a */
/* positions array, just a single center and position */
/* is sufficient --- we just keep overwriting them. */
/* When the common node is found, we have everything */
/* we need in that one center (COBS) and position */
/* (SOBS-position of the target relative to COBS). */
found = TRUE_;
nofrm = TRUE_;
legs = 0;
while(found && cobs != 0 && ctpos == 0) {
/* Find a file and segment that has position */
/* data for COBS. */
spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
if (found) {
/* Get the position of COBS; call it STEMP. */
/* The center of motion of COBS becomes the */
/* new COBS. */
if (legs == 0) {
spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs);
} else {
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs);
}
if (nofrm) {
nofrm = FALSE_;
cframe = tmpfrm;
}
/* Add STEMP to the position of OBS relative to */
/* the old COBS to get the position of OBS */
/* relative to the new COBS. */
if (cframe == tmpfrm) {
/* On the first leg of the position of the observer, we */
/* don't have to add anything, the position of the */
/* observer is already in SOBS. We only have to add when */
/* the number of legs in the observer position is one or */
/* greater. */
if (legs > 0) {
vadd_(sobs, stemp, vtemp);
vequ_(vtemp, sobs);
}
} else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <=
21) {
irfrot_(&cframe, &tmpfrm, rot);
mxv_(rot, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
} else {
zzrefch1_(&cframe, &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
mxv_(psxfrm, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
}
/* Check failed. We don't want to loop */
/* indefinitely. */
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
/* We now have one more leg of the path for OBS. Set */
/* LEGS to reflect this. Then see if the new center */
/* is a common node. If not, repeat the loop. */
++legs;
ctpos = isrchi_(&cobs, &nct, ctarg);
}
}
/* If CTPOS is zero at this point, it means we */
/* have not found a common node though we have */
/* searched through all the available data. */
if (ctpos == 0) {
bodc2n_(targ, tname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40);
repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40)
;
} else {
intstr_(targ, tname, (ftnlen)40);
}
bodc2n_(obs, oname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40);
repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40);
} else {
intstr_(obs, oname, (ftnlen)40);
}
setmsg_("Insufficient ephemeris data has been loaded to compute the "
"position of TARG relative to OBS at the ephemeris epoch #. ",
(ftnlen)118);
etcal_(et, tstring, (ftnlen)80);
errch_("TARG", tname, (ftnlen)4, (ftnlen)40);
errch_("OBS", oname, (ftnlen)3, (ftnlen)40);
errch_("#", tstring, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20);
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
/* If CTPOS is not zero, then we have reached a */
/* common node, specifically, */
/* CTARG(CTPOS) = COBS = CENTER */
/* (in diagram below). The POSITION of the target */
/* (TARG) relative to the observer (OBS) is just */
/* STARG(1,CTPOS) - SOBS. */
/* SOBS */
/* CENTER ---------------->OBS */
/* | . */
/* | . N */
/* S | . O */
/* T | . I */
/* A | . T */
/* R | . I */
/* G | . S */
/* | . O */
/* | . P */
/* V L */
/* TARG */
/* And the light-time between them is just */
/* | POSITION | */
/* LT = --------- */
/* c */
/* Compute the position of the target relative to CTARG(CTPOS) */
if (ctpos == 1) {
tframe[0] = cframe;
}
i__1 = ctpos - 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe"
, i__2, "zzspkgp1_", (ftnlen)967)] == tframe[(i__3 = i__) <
20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgp1_", (
ftnlen)967)]) {
vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)969)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "zzspkgp1_", (ftnlen)969)], stemp);
moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", (
ftnlen)970)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "zzspkgp1_", (ftnlen)972)] > 0 && tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3,
"zzspkgp1_", (ftnlen)972)] <= 21 && tframe[(i__2 = i__ - 1) <
20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgp1_", (
ftnlen)972)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2
? i__2 : s_rnge("tframe", i__2, "zzspkgp1_", (ftnlen)972)] <=
21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "zzspkgp1_", (ftnlen)974)], &
tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "zzspkgp1_", (ftnlen)974)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)975)], stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)976)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", (
ftnlen)977)]);
} else {
zzrefch1_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "zzspkgp1_", (ftnlen)981)], &
tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "zzspkgp1_", (ftnlen)981)], et, psxfrm);
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)988)],
stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "zzspkgp1_", (ftnlen)989)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgp1_", (
ftnlen)990)]);
}
}
/* To avoid unnecessary frame transformations we'll do */
/* a bit of extra decision making here. It's a lot */
/* faster to make logical checks than it is to compute */
/* frame transformations. */
if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe",
i__1, "zzspkgp1_", (ftnlen)1003)] == cframe) {
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)1005)], sobs, pos);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "zzspkgp1_", (ftnlen)1007)] == refid) {
/* If the last frame associated with the target is already */
/* in the requested output frame, we convert the position of */
/* the observer to that frame and then subtract the position */
/* of the observer from the position of the target. */
if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
irfrot_(&cframe, &refid, rot);
mxv_(rot, sobs, stemp);
} else {
zzrefch1_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
mxv_(psxfrm, sobs, stemp);
}
/* We've now transformed SOBS into the requested reference frame. */
/* Set CFRAME to reflect this. */
cframe = refid;
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)1038)], stemp, pos)
;
} else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen)
1041)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen)1041)] <= 21) {
/* If both frames are inertial we use IRFROT instead of */
/* ZZREFCH1 to get things into a common frame. */
irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "zzspkgp1_", (ftnlen)1047)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)1048)], stemp);
vsub_(stemp, sobs, pos);
} else {
/* Use the more general routine ZZREFCH1 to make the */
/* transformation. */
zzrefch1_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "zzspkgp1_", (ftnlen)1056)], &cframe,
et, psxfrm);
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgp1_", (ftnlen)1063)], stemp);
vsub_(stemp, sobs, pos);
}
/* Finally, rotate as needed into the requested frame. */
if (cframe == refid) {
/* We don't have to do anything in this case. */
} else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
/* Since both frames are inertial, we use the more direct */
/* routine IRFROT to get the transformation to REFID. */
irfrot_(&cframe, &refid, rot);
mxv_(rot, pos, stemp);
moved_(stemp, &c__3, pos);
} else {
zzrefch1_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
}
mxv_(psxfrm, pos, stemp);
moved_(stemp, &c__3, pos);
}
*lt = vnorm_(pos) / clight_();
chkout_("ZZSPKGP1", (ftnlen)8);
return 0;
} /* zzspkgp1_ */
/* $Procedure DASUDI ( DAS, update data, integer ) */
/* Subroutine */ int dasudi_(integer *handle, integer *first, integer *last,
integer *data)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer lastc, lastd, recno, lasti;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int daslla_(integer *, integer *, integer *,
integer *), dasuri_(integer *, integer *, integer *, integer *,
integer *);
integer clsize;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
integer wordno, numint;
extern logical return_(void);
integer nwritn;
/* $ Abstract */
/* Update data in a specified range of integer addresses in a DAS */
/* 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 */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* FIRST, */
/* LAST I Range of integer addresses to write to. */
/* DATA I An array of integers. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* FIRST, */
/* LAST are the first and last of a range of DAS logical */
/* addresses of integers. These addresses satisfy the */
/* inequality */
/* 1 < FIRST < LAST < LASTI */
/* _ - - */
/* where LASTI is the last integer logical address in */
/* use in the DAS file designated by HANDLE. */
/* DATA is an array of integers. The array elements */
/* DATA(1) through DATA(N) will be written to the */
/* indicated DAS file, where N is LAST - FIRST + 1. */
/* $ Detailed_Output */
/* See $Particulars for a description of the effect of this routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) Only logical addresses that already contain data may be */
/* updated: if either FIRST or LAST are outside the range */
/* [ 1, LASTI ] */
/* where LASTI is the last integer logical address that */
/* currently contains data in the indicated DAS file, the error */
/* SPICE(INVALIDADDRESS) is signalled. The DAS file will not be */
/* modified. */
/* 3) If FIRST > LAST but both addresses are valid, this routine */
/* will not modify the indicated DAS file. No error will be */
/* signalled. */
/* 4) If an I/O error occurs during the data update attempted */
/* by this routine, the error will be diagnosed by routines */
/* called by this routine. FIRST and LAST will not be modified. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine replaces the integer data in the specified range of */
/* logical addresses within a DAS file with the contents of the */
/* input array DATA. */
/* The actual physical write operations that update the indicated */
/* DAS file with the contents of the input array DATA may not take */
/* place before this routine returns, since the DAS system buffers */
/* data that is written as well as data that is read. In any case, */
/* the data will be flushed to the file at the time the file is */
/* closed, if not earlier. A physical write of all buffered */
/* records can be forced by calling the SPICELIB routine DASWUR */
/* ( DAS, write updated records ). */
/* In order to append integer data to a DAS file, filling in a range */
/* of integer logical addresses that starts immediately after the */
/* last integer logical address currently in use, the SPICELIB */
/* routine DASADI ( DAS add data, integer ) should be used. */
/* $ Examples */
/* 1) Write to addresses 1 through 500 in a DAS file in */
/* random-access fashion by updating the file. Recall */
/* that data must be present in the file before it can */
/* be updated. */
/* PROGRAM UP */
/* CHARACTER*(4) TYPE */
/* INTEGER DATA ( 500 ) */
/* INTEGER HANDLE */
/* INTEGER I */
/* C */
/* C Open the new DAS file RAND.DAS. Use the file name */
/* C as the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Append 500 integers to the file; after the data is */
/* C present, we're free to update it in any order we */
/* C please. (CLEARI zeros out an integer array.) */
/* C */
/* CALL CLEARI ( 500, DATA ) */
/* CALL DASADI ( HANDLE, 500, DATA ) */
/* C */
/* C Now the integer logical addresses 1:500 can be */
/* C written to in random-access fashion. We'll fill them */
/* C in in reverse order. */
/* C */
/* DO I = 500, 1, -1 */
/* CALL DASUDI ( HANDLE, I, I, I ) */
/* END DO */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now make sure that we updated the file properly. */
/* C Open the file for reading and dump the contents */
/* C of the integer logical addresses 1:500. */
/* C */
/* CALL DASOPR ( 'RAND.DAS', HANDLE ) */
/* CALL CLEARI ( 500, DATA ) */
/* CALL DASRDI ( HANDLE, 1, 500, DATA ) */
/* WRITE (*,*) 'Contents of RAND.DAS:' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) DATA */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination conditions. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* update integer data in a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. Without */
/* this test, an infinite loop could result if DASA2L or DASURI */
/* signaled an error inside the loop. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASUDI", (ftnlen)6);
}
/* Get the last logical addresses in use in this DAS file. */
daslla_(handle, &lastc, &lastd, &lasti);
/* Validate the input addresses. */
if (*first < 1 || *first > lasti || *last < 1 || *last > lasti) {
setmsg_("FIRST was #. LAST was #. Valid range is [1,#].", (ftnlen)46);
errint_("#", first, (ftnlen)1);
errint_("#", last, (ftnlen)1);
errint_("#", &lasti, (ftnlen)1);
sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21);
chkout_("DASUDI", (ftnlen)6);
return 0;
}
/* Let N be the number of addresses to update. */
n = *last - *first + 1;
/* We will use the variables RECNO and OFFSET to determine where to */
/* write data in the DAS file. RECNO will be the record containing */
/* the physical location to write to; WORDNO will be the word */
/* location that we will write to next. */
/* Find the first location to write to. CLBASE and CLSIZE are the */
/* base record number and size of the cluster of integer records that */
/* the address FIRST lies within. */
dasa2l_(handle, &c__3, first, &clbase, &clsize, &recno, &wordno);
/* Set the number of integer words already written. Keep */
/* writing to the file until this number equals the number of */
/* elements in DATA. */
/* Note that if N is non-positive, the loop doesn't get exercised. */
nwritn = 0;
while(nwritn < n && ! failed_()) {
/* Write as much data as we can (or need to) into the current */
/* record. We assume that CLBASE, RECNO, WORDNO, and NWRITN have */
/* been set correctly at this point. */
/* Find out how many words to write into the current record. */
/* There may be no space left in the current record. */
/* Computing MIN */
i__1 = n - nwritn, i__2 = 256 - wordno + 1;
numint = min(i__1,i__2);
if (numint > 0) {
/* Write NUMINT words into the current record. */
i__1 = wordno + numint - 1;
dasuri_(handle, &recno, &wordno, &i__1, &data[nwritn]);
nwritn += numint;
wordno += numint;
} else {
/* It's time to start on a new record. If the record we */
/* just finished writing to (or just attempted writing to, */
/* if it was full) was not the last of the cluster, the next */
/* record to write to is the immediate successor of the last */
/* one. Otherwise, we'll have to look up the location of the */
/* next integer logical address. */
if (recno < clbase + clsize - 1) {
++recno;
wordno = 1;
} else {
i__1 = *first + nwritn;
dasa2l_(handle, &c__3, &i__1, &clbase, &clsize, &recno, &
wordno);
}
}
}
chkout_("DASUDI", (ftnlen)6);
return 0;
} /* dasudi_ */
/* $Procedure SYPOPC ( Pop a value from a particular symbol ) */
/* Subroutine */ int sypopc_(char *name__, char *tabsym, integer *tabptr,
char *tabval, char *value, logical *found, ftnlen name_len, ftnlen
tabsym_len, ftnlen tabval_len, ftnlen value_len)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer nval, nptr, nsym;
extern integer cardc_(char *, ftnlen), cardi_(integer *);
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sumai_(integer *, integer *);
extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), remlac_(
integer *, integer *, char *, integer *, ftnlen);
extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int scardi_(integer *, integer *), remlai_(
integer *, integer *, integer *, integer *);
integer locval;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Pop a value associated with a particular symbol in a character */
/* symbol table. The first value associated with the symbol is */
/* removed, and subsequent values are moved forward. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose associated value is to be */
/* popped. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I/O Components of the symbol table. */
/* VALUE O Value that was popped. */
/* FOUND O True if the symbol exists, false if it does not. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose associated value is to */
/* be popped. If NAME is not in the symbol table, FOUND */
/* is false. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of a character symbol table. */
/* $ Detailed_Output */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of a character symbol table. */
/* The value is removed from the symbol table, and the */
/* remaining values associated with the symbol are moved */
/* forward in the value table. If no other values are */
/* associated with the symbol, the symbol is removed from */
/* the symbol table. */
/* VALUE is the value that was popped. This value was the first */
/* value in the symbol table that was associated with the */
/* symbol NAME. */
/* FOUND is true if NAME is in the symbol table, otherwise */
/* it is false. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* If there are no remaining values associated with the symbol */
/* after VALUE has been popped, the symbol is removed from the */
/* symbol table. */
/* $ Examples */
/* The contents of the symbol table are: */
/* BOHR --> HYDROGEN ATOM */
/* EINSTEIN --> SPECIAL RELATIVITY */
/* PHOTOELECTRIC EFFECT */
/* BROWNIAN MOTION */
/* FERMI --> NUCLEAR FISSION */
/* The call, */
/* CALL SYPOPC ( 'EINSTEIN', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */
/* modifies the contents of the symbol table to be: */
/* BOHR --> HYDROGEN ATOM */
/* EINSTEIN --> PHOTOELECTRIC EFFECT */
/* BROWNIAN MOTION */
/* FERMI --> NUCLEAR FISSION */
/* FOUND is TRUE, and VALUE is 'SPECIAL RELATIVITY'. */
/* The next call, */
/* CALL SYPOPC ( 'FERMI', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */
/* modifies the contents of the symbol table to be: */
/* BOHR --> HYDROGEN ATOM */
/* EINSTEIN --> SPECIAL RELATIVITY */
/* PHOTOELECTRIC EFFECT */
/* BROWNIAN MOTION */
/* FOUND is TRUE, and VALUE is 'NUCLEAR FISSION'. Note that because */
/* "FERMI" had only one value associated with it, it was removed */
/* from the symbol table. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* pop a value from a particular symbol */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYPOPC", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
nptr = cardi_(tabptr);
nval = cardc_(tabval, tabval_len);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
/* If it's not in the table, it's definitely a problem. */
if (locsym == 0) {
*found = FALSE_;
/* If it is in the table, we can proceed without fear of overflow. */
} else {
*found = TRUE_;
/* Begin by saving and removing the initial value for this */
/* symbol from the value table. */
i__1 = locsym - 1;
locval = sumai_(&tabptr[6], &i__1) + 1;
s_copy(value, tabval + (locval + 5) * tabval_len, value_len,
tabval_len);
remlac_(&c__1, &locval, tabval + tabval_len * 6, &nval, tabval_len);
scardc_(&nval, tabval, tabval_len);
/* If this was the sole value for the symbol, remove the */
/* symbol from the name and pointer tables. Otherwise just */
/* decrement the dimension. */
if (tabptr[locsym + 5] == 1) {
remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym,
tabsym_len);
scardc_(&nsym, tabsym, tabsym_len);
remlai_(&c__1, &locsym, &tabptr[6], &nptr);
scardi_(&nptr, tabptr);
} else {
--tabptr[locsym + 5];
}
}
chkout_("SYPOPC", (ftnlen)6);
return 0;
} /* sypopc_ */
