/* $Procedure KPLFRM ( Kernel pool frame IDs ) */
/* Subroutine */ int kplfrm_(integer *frmcls, integer *idset)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer i__, l, m, n, w;
extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
extern integer sizei_(integer *);
integer idcode, to;
extern /* Subroutine */ int scardi_(integer *, integer *);
char frname[32];
extern /* Subroutine */ int validi_(integer *, integer *, integer *);
char kvcode[32];
integer fclass;
char kvname[32], kvbuff[32*100], kvclas[32];
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen), gipool_(char *, integer *,
integer *, integer *, integer *, logical *, ftnlen);
char tmpnam[32];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
char kvtemp[32];
extern /* Subroutine */ int gnpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Return a SPICE set containing the frame IDs of all reference */
/* frames of a given class having specifications 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 */
/* CELLS */
/* FRAMES */
/* KERNEL */
/* NAIF_IDS */
/* SETS */
/* $ Keywords */
/* FRAME */
/* SET */
/* UTILITY */
/* $ 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 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 file contains the number of non-inertial reference */
/* frames that are currently built into 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 built-in non-inertial reference frames. */
/* $ Parameters */
/* NINERT is the number of built-in non-inertial reference */
/* frames. This value is needed by both ZZFDAT, and */
/* FRAMEX. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.5.0, 11-OCT-2011 (BVS) */
/* Increased the number of non-inertial frames from 100 to 105 */
/* in order to accomodate the following PCK based frames: */
/* IAU_CERES */
/* IAU_PALLAS */
/* IAU_LUTETIA */
/* IAU_DAVIDA */
/* IAU_STEINS */
/* - SPICELIB Version 1.4.0, 11-MAY-2010 (BVS) */
/* Increased the number of non-inertial frames from 96 to 100 */
/* in order to accomodate the following PCK based frames: */
/* IAU_BORRELLY */
/* IAU_TEMPEL_1 */
/* IAU_VESTA */
/* IAU_ITOKAWA */
/* - SPICELIB Version 1.3.0, 12-DEC-2002 (BVS) */
/* Increased the number of non-inertial frames from 85 to 96 */
/* in order to accomodate the following PCK based frames: */
/* IAU_CALLIRRHOE */
/* IAU_THEMISTO */
/* IAU_MAGACLITE */
/* IAU_TAYGETE */
/* IAU_CHALDENE */
/* IAU_HARPALYKE */
/* IAU_KALYKE */
/* IAU_IOCASTE */
/* IAU_ERINOME */
/* IAU_ISONOE */
/* IAU_PRAXIDIKE */
/* - SPICELIB Version 1.2.0, 02-AUG-2002 (FST) */
/* Increased the number of non-inertial frames from 81 to 85 */
/* in order to accomodate the following PCK based frames: */
/* IAU_PAN */
/* IAU_GASPRA */
/* IAU_IDA */
/* IAU_EROS */
/* - SPICELIB Version 1.1.0, 20-FEB-1997 (WLT) */
/* Increased the number of non-inertial frames from 79 to 81 */
/* in order to accomodate the following earth rotation */
/* models: */
/* ITRF93 */
/* EARTH_FIXED */
/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */
/* -& */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* FRMCLS I Frame class. */
/* IDSET O Set of ID codes of frames of the specified class. */
/* $ Detailed_Input */
/* FRMCLS is an integer code specifying the frame class or */
/* classes for which frame ID codes are requested. */
/* The applicable reference frames are those having */
/* specifications present in the kernel pool. */
/* FRMCLS may designate a single class or "all */
/* classes." */
/* The include file frmtyp.inc declares parameters */
/* identifying frame classes. The supported values */
/* and corresponding meanings of FRMCLS are */
/* Parameter Value Meaning */
/* ========= ===== ================= */
/* ALL -1 All frame classes */
/* specified in the */
/* kernel pool. Class 1 */
/* is not included. */
/* INERTL 1 Built-in inertial. */
/* No frames will be */
/* returned in the */
/* output set. */
/* PCK 2 PCK-based frame */
/* CK 3 CK-based frame */
/* TK 4 Fixed rotational */
/* offset ("text */
/* kernel") frame */
/* DYN 5 Dynamic frame */
/* $ Detailed_Output */
/* IDSET is a SPICE set containing the ID codes of all */
/* reference frames having specifications present in */
/* the kernel pool and belonging to the specified */
/* class or classes. */
/* Note that if FRMCLS is set to INERTL, IDSET */
/* will be empty on output. */
/* $ Parameters */
/* See the INCLUDE file frmtyp.inc. */
/* $ Exceptions */
/* 1) If the input frame class argument is not defined in */
/* frmtyp.inc, the error SPICE(BADFRAMECLASS) is signaled. */
/* 2) If the size of IDSET is too small to hold the requested frame */
/* ID set, the error SPICE(SETTOOSMALL) is signaled. */
/* 3) Frames of class 1 may not be specified in the kernel pool. */
/* However, for the convenience of users, this routine does not */
/* signal an error if the input class is set to INERTL. In this */
/* case the output set will be empty. */
/* 4) This routine relies on the presence of just three kernel */
/* variable assignments for a reference frame in order to */
/* determine that that reference frame has been specified: */
/* FRAME_<frame name> = <ID code> */
/* FRAME_<ID code>_NAME = <frame name> */
/* and either */
/* FRAME_<ID code>_CLASS = <class> */
/* or */
/* FRAME_<frame name>_CLASS = <class> */
/* It is possible for the presence of an incomplete frame */
/* specification to trick this routine into incorrectly */
/* deciding that a frame has been specified. This routine */
/* does not attempt to diagnose this problem. */
/* $ Files */
/* 1) Reference frame specifications for frames that are not */
/* built in are typically established by loading frame kernels. */
/* $ Particulars */
/* This routine enables SPICE-based applications to conveniently */
/* find the frame ID codes of reference frames having specifications */
/* present in the kernel pool. Such frame specifications are */
/* introduced into the kernel pool either by loading frame kernels */
/* or by means of calls to the kernel pool "put" API routines */
/* PCPOOL */
/* PDPOOL */
/* PIPOOL */
/* Given a reference frame's ID code, other attributes of the */
/* frame can be obtained via calls to entry points of the */
/* umbrella routine FRAMEX: */
/* FRMNAM {Return a frame's name} */
/* FRINFO {Return a frame's center, class, and class ID} */
/* This routine has a counterpart */
/* BLTFRM */
/* which fetches the frame IDs of all built-in reference frames. */
/* $ Examples */
/* 1) Display the IDs and names of all reference frames having */
/* specifications present in the kernel pool. Group the outputs */
/* by frame class. Also fetch and display the entire set of IDs */
/* and names using the parameter ALL. */
/* The meta-kernel used for this example is shown below. The */
/* Rosetta kernels referenced by the meta-kernel are available */
/* in the path */
/* pub/naif/ROSETTA/kernels/fk */
/* on the NAIF server. Older, but officially archived versions */
/* of these kernels are available in the path */
/* pub/naif/pds/data/ros-e_m_a_c-spice-6-v1.0/ */
/* rossp_1000/DATA/FK */
/* The referenced PCK is available from the pck path under the */
/* generic_kernels path on the same server. */
/* KPL/MK */
/* \begindata */
/* KERNELS_TO_LOAD = ( 'pck00010.tpc' */
/* 'EARTHFIXEDITRF93.TF' */
/* 'ROS_LUTETIA_RSOC_V03.TF' */
/* 'ROS_V18.TF' */
/* 'RSSD0002.TF' ) */
/* \begintext */
/* Program source code: */
/* PROGRAM EX1 */
/* IMPLICIT NONE */
/* INCLUDE 'frmtyp.inc' */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER CARDI */
/* C */
/* C Local parameters */
/* C */
/* CHARACTER*(*) META */
/* PARAMETER ( META = 'kplfrm.tm' ) */
/* INTEGER NFRAME */
/* PARAMETER ( NFRAME = 1000 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER FRNMLN */
/* PARAMETER ( FRNMLN = 32 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FRNMLN) FRNAME */
/* CHARACTER*(LNSIZE) OUTLIN */
/* INTEGER I */
/* INTEGER IDSET ( LBCELL : NFRAME ) */
/* INTEGER J */
/* C */
/* C Initialize the frame set. */
/* C */
/* CALL SSIZEI ( NFRAME, IDSET ) */
/* C */
/* C Load kernels that contain frame specifications. */
/* C */
/* CALL FURNSH ( META ) */
/* C */
/* C Fetch and display the frames of each class. */
/* C */
/* DO I = 1, 6 */
/* IF ( I .LT. 6 ) THEN */
/* C */
/* C Fetch the frames of class I. */
/* C */
/* CALL KPLFRM ( I, IDSET ) */
/* OUTLIN = 'Number of frames of class #: #' */
/* CALL REPMI ( OUTLIN, '#', I, OUTLIN ) */
/* CALL REPMI ( OUTLIN, '#', CARDI(IDSET), OUTLIN ) */
/* ELSE */
/* C */
/* C Fetch IDs of all frames specified in the kernel */
/* C pool. */
/* C */
/* CALL KPLFRM ( ALL, IDSET ) */
/* OUTLIN = 'Number of frames in the kernel pool: #' */
/* CALL REPMI ( OUTLIN, '#', CARDI(IDSET), OUTLIN ) */
/* END IF */
/* CALL TOSTDO ( ' ' ) */
/* CALL TOSTDO ( OUTLIN ) */
/* CALL TOSTDO ( ' Frame IDs and names' ) */
/* DO J = 1, CARDI(IDSET) */
/* CALL FRMNAM ( IDSET(J), FRNAME ) */
/* WRITE (*,*) IDSET(J), ' ', FRNAME */
/* END DO */
/* END DO */
/* END */
/* The output from the program, when the program was linked */
/* against the N0064 SPICE Toolkit, is shown below. The output */
/* shown here has been abbreviated. */
/* Number of frames of class 1: 0 */
/* Frame IDs and names */
/* Number of frames of class 2: 3 */
/* Frame IDs and names */
/* 1000012 67P/C-G_FIXED */
/* 2000021 LUTETIA_FIXED */
/* 2002867 STEINS_FIXED */
/* Number of frames of class 3: 7 */
/* Frame IDs and names */
/* -226570 ROS_RPC_BOOM2 */
/* -226215 ROS_VIRTIS-M_SCAN */
/* -226072 ROS_HGA_AZ */
/* -226071 ROS_HGA_EL */
/* -226025 ROS_SA-Y */
/* -226015 ROS_SA+Y */
/* -226000 ROS_SPACECRAFT */
/* Number of frames of class 4: 64 */
/* Frame IDs and names */
/* -2260021 ROS_LUTETIA */
/* -226999 ROSLND_LOCAL_LEVEL */
/* -226900 ROSLND_LANDER */
/* -226560 ROS_RPC_BOOM1 */
/* ... */
/* -226030 ROS_MGA-S */
/* -226020 ROS_SA-Y_ZERO */
/* -226010 ROS_SA+Y_ZERO */
/* 1502010 HCI */
/* 1502301 LME2000 */
/* 1503299 VME2000 */
/* 1503499 MME2000 */
/* Number of frames of class 5: 19 */
/* Frame IDs and names */
/* -226967 2867/STEINS_CSO */
/* -226945 45P/H-M-P_CSO */
/* -226921 21/LUTETIA_CSO */
/* -226920 21/LUTETIA_CSEQ */
/* -226912 67P/C-G_CSO */
/* -226910 67P/C-G_CSEQ */
/* 1500010 HEE */
/* 1500299 VSO */
/* 1500301 LSE */
/* 1500399 GSE */
/* 1500499 MME */
/* 1501010 HEEQ */
/* 1501299 VME */
/* 1501301 LME */
/* 1501399 EME */
/* 1501499 MME_IAU2000 */
/* 1502399 GSEQ */
/* 1502499 MSO */
/* 1503399 ECLIPDATE */
/* Number of frames in the kernel pool: 93 */
/* Frame IDs and names */
/* -2260021 ROS_LUTETIA */
/* -226999 ROSLND_LOCAL_LEVEL */
/* -226967 2867/STEINS_CSO */
/* -226945 45P/H-M-P_CSO */
/* -226921 21/LUTETIA_CSO */
/* ... */
/* 1503299 VME2000 */
/* 1503399 ECLIPDATE */
/* 1503499 MME2000 */
/* 2000021 LUTETIA_FIXED */
/* 2002867 STEINS_FIXED */
/* $ Restrictions */
/* 1) This routine will work correctly if the kernel pool */
/* contains no invalid frame specifications. See the */
/* description of exception 4 above. Users must ensure */
/* that no invalid frame specifications are introduced */
/* into the kernel pool, either by loaded kernels or */
/* by means of the kernel pool "put" APIs. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 22-MAY-2012 (NJB) */
/* -& */
/* $ Index_Entries */
/* fetch IDs of reference_frames from the kernel_pool */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
if (return_()) {
return 0;
}
chkin_("KPLFRM", (ftnlen)6);
/* The output set starts out empty. */
scardi_(&c__0, idset);
/* Check the input frame class. */
/* This block of code must be kept in sync with frmtyp.inc. */
if (*frmcls > 5 || *frmcls == 0 || *frmcls < -1) {
setmsg_("Frame class specifier FRMCLS was #; this value is not suppo"
"rted.", (ftnlen)64);
errint_("#", frmcls, (ftnlen)1);
sigerr_("SPICE(BADFRAMECLASS)", (ftnlen)20);
chkout_("KPLFRM", (ftnlen)6);
return 0;
}
/* Initialize the output buffer index. The */
/* index is to be incremented prior to each */
/* write to the buffer. */
to = 0;
/* Find all of the kernel variables having names */
/* that could correspond to frame name assignments. */
/* We expect that all frame specifications will */
/* include assignments of the form */
/* FRAME_<ID code>_NAME = <frame name> */
/* We may pick up some additional assignments that are not part of */
/* frame specifications; we plan to filter out as many as possible */
/* by looking the corresponding frame ID and frame class */
/* assignments. */
s_copy(kvtemp, "FRAME_*_NAME", (ftnlen)32, (ftnlen)12);
gnpool_(kvtemp, &c__1, &c__100, &n, kvbuff, &found, (ftnlen)32, (ftnlen)
32);
while(n > 0) {
/* At least one kernel variable was found by the last */
/* GNPOOL call. Each of these variables is a possible */
/* frame name. Look up each of these candidate names. */
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Attempt to fetch the right hand side value for */
/* the Ith kernel variable found on the previous */
/* GNPOOL call. */
gcpool_(kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 :
s_rnge("kvbuff", i__2, "kplfrm_", (ftnlen)523)) << 5), &
c__1, &c__1, &m, frname, &found, (ftnlen)32, (ftnlen)32);
if (found) {
/* We found a possible frame name. Attempt to look */
/* up an ID code variable for the name. The assignment */
/* for the ID code, if present, will have the form */
/* FRAME_<name> = <ID code> */
/* Create the kernel variable name on the left hand */
/* side of the assignment. */
s_copy(kvcode, "FRAME_<name>", (ftnlen)32, (ftnlen)12);
repmc_(kvcode, "<name>", frname, kvcode, (ftnlen)32, (ftnlen)
6, (ftnlen)32, (ftnlen)32);
/* Try to fetch the ID code. */
gipool_(kvcode, &c__1, &c__1, &l, &idcode, &found, (ftnlen)32)
;
if (found) {
/* We found an integer on the right hand side */
/* of the assignment. We probably have a */
/* frame specification at this point. Check that */
/* the variable */
/* FRAME_<ID code>_NAME */
/* is present in the kernel pool and maps to */
/* the name FRNAME. */
s_copy(kvname, "FRAME_<code>_NAME", (ftnlen)32, (ftnlen)
17);
repmi_(kvname, "<code>", &idcode, kvname, (ftnlen)32, (
ftnlen)6, (ftnlen)32);
gcpool_(kvname, &c__1, &c__1, &w, tmpnam, &found, (ftnlen)
32, (ftnlen)32);
if (found) {
/* Try to look up the frame class using a */
/* kernel variable name of the form */
/* FRAME_<integer ID code>_CLASS */
/* Create the kernel variable name on the left */
/* hand side of the frame class assignment. */
s_copy(kvclas, "FRAME_<integer>_CLASS", (ftnlen)32, (
ftnlen)21);
repmi_(kvclas, "<integer>", &idcode, kvclas, (ftnlen)
32, (ftnlen)9, (ftnlen)32);
/* Look for the frame class. */
gipool_(kvclas, &c__1, &c__1, &w, &fclass, &found, (
ftnlen)32);
if (! found) {
/* Try to look up the frame class using a kernel */
/* variable name of the form */
/* FRAME_<frame name>_CLASS */
s_copy(kvclas, "FRAME_<name>_CLASS", (ftnlen)32, (
ftnlen)18);
repmc_(kvclas, "<name>", frname, kvclas, (ftnlen)
32, (ftnlen)6, (ftnlen)32, (ftnlen)32);
gipool_(kvclas, &c__1, &c__1, &w, &fclass, &found,
(ftnlen)32);
}
/* At this point FOUND indicates whether we found */
/* the frame class. */
if (found) {
/* Check whether the frame class is one */
/* we want. */
if (*frmcls == -1 || *frmcls == fclass) {
/* We have a winner. Add it to the output set. */
/* First make sure the set is large enough to */
/* hold another element. */
if (to == sizei_(idset)) {
setmsg_("Frame ID set argument IDSET has"
" size #; required size is at lea"
"st #. Make sure that the caller "
"of this routine has initialized "
"IDSET via SSIZEI.", (ftnlen)144);
i__2 = sizei_(idset);
errint_("#", &i__2, (ftnlen)1);
i__2 = to + 1;
errint_("#", &i__2, (ftnlen)1);
sigerr_("SPICE(SETTOOSMALL)", (ftnlen)18);
chkout_("KPLFRM", (ftnlen)6);
return 0;
}
++to;
idset[to + 5] = idcode;
}
/* End of IF block for processing a frame having */
/* a frame class matching the request. */
}
/* End of IF block for finding the frame class. */
}
/* End of IF block for finding the frame name. */
}
/* End of IF block for finding the frame ID. */
}
/* End of IF block for finding string value corresponding to */
/* the Ith kernel variable matching the name template. */
}
/* End of loop for processing last batch of potential */
/* frame names. */
/* Fetch next batch of potential frame names. */
i__1 = n + 1;
gnpool_(kvtemp, &i__1, &c__100, &n, kvbuff, &found, (ftnlen)32, (
ftnlen)32);
}
/* At this point all kernel variables that matched the frame name */
/* keyword template have been processed. All frames of the specified */
/* class or classes have had their ID codes appended to IDSET. In */
/* general IDSET is not yet a SPICELIB set, since it's not sorted */
/* and it may contain duplicate values. */
/* Turn IDSET into a set. VALIDI sorts and removes duplicates. */
i__1 = sizei_(idset);
validi_(&i__1, &to, idset);
chkout_("KPLFRM", (ftnlen)6);
return 0;
} /* kplfrm_ */
/* $Procedure ZZBODKER ( Private --- Process Body-Name Kernel Pool Maps ) */
/* Subroutine */ int zzbodker_(char *names, char *nornam, integer *codes,
integer *nvals, integer *ordnom, integer *ordcod, integer *nocds,
logical *extker, ftnlen names_len, ftnlen nornam_len)
{
/* Initialized data */
static char nbc[32] = "NAIF_BODY_CODE ";
static char nbn[32] = "NAIF_BODY_NAME ";
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
logical drop[2000];
char type__[1*2];
integer nsiz[2];
extern /* Subroutine */ int zzbodini_(char *, char *, integer *, integer *
, integer *, integer *, integer *, ftnlen, ftnlen);
integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
logical plfind[2];
extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen),
gcpool_(char *, integer *, integer *, integer *, char *, logical
*, ftnlen, ftnlen), gipool_(char *, integer *, integer *, integer
*, integer *, logical *, ftnlen), sigerr_(char *, ftnlen);
logical remdup;
extern /* Subroutine */ int chkout_(char *, ftnlen), dtpool_(char *,
logical *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen), cmprss_(char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen);
extern logical return_(void);
integer num[2];
/* $ 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 routine processes the kernel pool vectors NAIF_BODY_NAME */
/* and NAIF_BODY_CODE into the formatted lists required by ZZBODTRN */
/* to successfully compute code-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 */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* NAMES O Array of kernel pool assigned names. */
/* NORNAM O Array of normalized kernel pool assigned names. */
/* CODES O Array of ID codes for NAMES/NORNAM. */
/* NVALS O Length of NAMES, NORNAM, CODES, and ORDNOM arrays. */
/* ORDNOM O Order vector for NORNAM. */
/* ORDCOD O Modified order vector for CODES. */
/* NOCDS O Length of ORDCOD array. */
/* EXTKER O Logical indicating presence of kernel pool names. */
/* MAXL P Maximum length of body name strings. */
/* NROOM P Maximum length of kernel pool data vectors. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* NAMES the array of highest precedent names extracted */
/* from the kernel pool vector NAIF_BODY_NAME. This */
/* array is parallel to NORNAM and CODES. */
/* NORNAM the array of highest precedent names extracted */
/* from the kernel pool vector NAIF_BODY_NAME. After */
/* extraction, each entry is converted to uppercase, */
/* and groups of spaces are compressed to a single */
/* space. This represents the canonical member of the */
/* equivalence class each parallel entry in NAMES */
/* belongs. */
/* CODES the array of highest precedent codes extracted */
/* from the kernel pool vector NAIF_BODY_CODE. This */
/* array is parallel to NAMES and NORNAM. */
/* NVALS the number of items contained in NAMES, NORNAM, */
/* CODES and ORDNOM. */
/* ORDNOM the order vector of indexes for NORNAM. The set */
/* of values NORNAM( ORDNOM(1) ), NORNAM( ORDNOM(2) ), */
/* ... forms an increasing list of name values. */
/* ORDCOD the modified ordering vector of indexes into */
/* CODES. The list CODES( ORDCOD(1) ), */
/* CODES( ORDCOD(2) ), ... , CODES( ORDCOD(NOCDS) ) */
/* forms an increasing non-repeating list of integers. */
/* Moreover, every value in CODES is listed exactly */
/* once in this sequence. */
/* NOCDS the number of indexes listed in ORDCOD. This */
/* value will never exceed NVALS. */
/* EXTKER is a logical that indicates to the caller whether */
/* any kernel pool name-code maps have been defined. */
/* If EXTKER is .FALSE., then the kernel pool variables */
/* NAIF_BODY_CODE and NAIF_BODY_NAME are empty and */
/* only the built-in and ZZBODDEF code-name mappings */
/* need consideration. If .TRUE., then the values */
/* returned by this module need consideration. */
/* $ Parameters */
/* MAXL is the maximum length of a body name. Defined in */
/* the include file 'zzbodtrn.inc'. */
/* NROOM is the maximum number of kernel pool data items */
/* that can be processed from the NAIF_BODY_CODE */
/* and NAIF_BODY_NAME lists. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) The error SPICE(MISSINGKPV) is signaled when one of the */
/* NAIF_BODY_CODE and NAIF_BODY_NAME keywords is present in the */
/* kernel pool and the other is not. */
/* 2) The error SPICE(KERVARTOOBIG) is signaled if one or both of */
/* the NAIF_BODY_CODE and NAIF_BODY_NAME kernel pool vectors */
/* have a cardinality that exceeds NROOM. */
/* 3) The error SPICE(BADDIMENSIONS) is signaled if the cardinality */
/* of the NAIF_BODY_CODE and NAIF_BODY_NAME kernel pool vectors do */
/* not match. */
/* 4) The error SPICE(BLANKNAMEASSIGNED) is signaled if an entry */
/* in the NAIF_BODY_NAME kernel pool vector is a blank string. */
/* ID codes may not be assigned to a blank string. */
/* $ Particulars */
/* This routine examines the contents of the kernel pool, ingests */
/* the contents of the NAIF_BODY_CODE and NAIF_BODY_NAME keywords, */
/* and produces the order vectors and name/code lists that ZZBODTRN */
/* requires to resolve code to name and name to code mappings. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 23-AUG-2002 (EDW) (FST) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Local Variables */
/* Saved Variables */
/* Data Statements */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZBODKER", (ftnlen)8);
}
/* Until the code below proves otherwise, we shall assume */
/* we lack kernel pool name/code mappings. */
*extker = FALSE_;
/* Check for the external body ID variables in the kernel pool. */
gcpool_(nbn, &c__1, &c__2000, num, names, plfind, (ftnlen)32, (ftnlen)36);
gipool_(nbc, &c__1, &c__2000, &num[1], codes, &plfind[1], (ftnlen)32);
/* Examine PLFIND(1) and PLFIND(2) for problems. */
if (plfind[0] != plfind[1]) {
/* If they are not both present or absent, signal an error. */
setmsg_("The kernel pool vector, #, used in mapping between names an"
"d ID-codes is absent, while # is not. This is often due to "
"an improperly constructed text kernel. Check loaded kernels"
" for these keywords.", (ftnlen)199);
if (plfind[0]) {
errch_("#", nbc, (ftnlen)1, (ftnlen)32);
errch_("#", nbn, (ftnlen)1, (ftnlen)32);
} else {
errch_("#", nbn, (ftnlen)1, (ftnlen)32);
errch_("#", nbc, (ftnlen)1, (ftnlen)32);
}
sigerr_("SPICE(MISSINGKPV)", (ftnlen)17);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
} else if (! plfind[0]) {
/* Return if both keywords are absent. */
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* If we reach here, then both kernel pool variables are present. */
/* Perform some simple sanity checks on their lengths. */
dtpool_(nbn, &found, nsiz, type__, (ftnlen)32, (ftnlen)1);
dtpool_(nbc, &found, &nsiz[1], type__ + 1, (ftnlen)32, (ftnlen)1);
if (nsiz[0] > 2000 || nsiz[1] > 2000) {
setmsg_("The kernel pool vectors used to define the names/ID-codes m"
"appingexceeds the max size. The size of the NAME vector is #"
"1. The size of the CODE vector is #2. The max number allowed"
" of elements is #3.", (ftnlen)198);
errint_("#1", nsiz, (ftnlen)2);
errint_("#2", &nsiz[1], (ftnlen)2);
errint_("#3", &c__2000, (ftnlen)2);
sigerr_("SPICE(KERVARTOOBIG)", (ftnlen)19);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
} else if (nsiz[0] != nsiz[1]) {
setmsg_("The kernel pool vectors used for mapping between names and "
"ID-codes are not the same size. The size of the name vector"
", NAIF_BODY_NAME is #. The size of the ID-code vector, NAIF_"
"BODY_CODE is #. You need to examine the ID-code kernel you l"
"oaded and correct the mismatch.", (ftnlen)270);
errint_("#", nsiz, (ftnlen)1);
errint_("#", &nsiz[1], (ftnlen)1);
sigerr_("SPICE(BADDIMENSIONS)", (ftnlen)20);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* Compute the canonical member of the equivalence class of NAMES, */
/* NORNAM. This normalization compresses groups of spaces into a */
/* single space, left justifies the string, and uppercases the */
/* contents. While passing through the NAMES array, look for any */
/* blank strings and signal an appropriate error. */
*nvals = num[0];
i__1 = *nvals;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Check for blank strings. */
if (s_cmp(names + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 :
s_rnge("names", i__2, "zzbodker_", (ftnlen)345)) * 36, " ", (
ftnlen)36, (ftnlen)1) == 0) {
setmsg_("An attempt to assign the code, #, to a blank string was"
" made. Check loaded text kernels for a blank string in "
"the NAIF_BODY_NAME array.", (ftnlen)136);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(BLANKNAMEASSIGNED)", (ftnlen)24);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* Compute the canonical member of the equivalence class. */
ljust_(names + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge(
"names", i__2, "zzbodker_", (ftnlen)361)) * 36, nornam + ((
i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("nornam",
i__3, "zzbodker_", (ftnlen)361)) * 36, (ftnlen)36, (ftnlen)36)
;
ucase_(nornam + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge(
"nornam", i__2, "zzbodker_", (ftnlen)362)) * 36, nornam + ((
i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("nornam",
i__3, "zzbodker_", (ftnlen)362)) * 36, (ftnlen)36, (ftnlen)36)
;
cmprss_(" ", &c__1, nornam + ((i__2 = i__ - 1) < 2000 && 0 <= i__2 ?
i__2 : s_rnge("nornam", i__2, "zzbodker_", (ftnlen)363)) * 36,
nornam + ((i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 :
s_rnge("nornam", i__3, "zzbodker_", (ftnlen)363)) * 36, (
ftnlen)1, (ftnlen)36, (ftnlen)36);
}
/* Determine a preliminary order vector for NORNAM. */
orderc_(nornam, nvals, ordnom, (ftnlen)36);
/* We are about to remove duplicates. Make some initial */
/* assumptions, no duplicates exist in NORNAM. */
i__1 = *nvals;
for (i__ = 1; i__ <= i__1; ++i__) {
drop[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge("drop",
i__2, "zzbodker_", (ftnlen)377)] = FALSE_;
}
remdup = FALSE_;
/* ORDERC clusters duplicate entries in NORNAM together. */
/* Use this fact to locate duplicates on one pass through */
/* NORNAM. */
i__1 = *nvals - 1;
for (i__ = 1; i__ <= i__1; ++i__) {
if (s_cmp(nornam + ((i__3 = ordnom[(i__2 = i__ - 1) < 2000 && 0 <=
i__2 ? i__2 : s_rnge("ordnom", i__2, "zzbodker_", (ftnlen)389)
] - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("nornam", i__3,
"zzbodker_", (ftnlen)389)) * 36, nornam + ((i__5 = ordnom[(
i__4 = i__) < 2000 && 0 <= i__4 ? i__4 : s_rnge("ordnom",
i__4, "zzbodker_", (ftnlen)389)] - 1) < 2000 && 0 <= i__5 ?
i__5 : s_rnge("nornam", i__5, "zzbodker_", (ftnlen)389)) * 36,
(ftnlen)36, (ftnlen)36) == 0) {
/* We have at least one duplicate to remove. */
remdup = TRUE_;
/* If the normalized entries are equal, drop the one with */
/* the lower index in the NAMES array. Entries defined */
/* later in the kernel pool have higher precedence. */
if (ordnom[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge(
"ordnom", i__2, "zzbodker_", (ftnlen)401)] < ordnom[(i__3
= i__) < 2000 && 0 <= i__3 ? i__3 : s_rnge("ordnom", i__3,
"zzbodker_", (ftnlen)401)]) {
drop[(i__3 = ordnom[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ?
i__2 : s_rnge("ordnom", i__2, "zzbodker_", (ftnlen)
402)] - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge("drop",
i__3, "zzbodker_", (ftnlen)402)] = TRUE_;
} else {
drop[(i__3 = ordnom[(i__2 = i__) < 2000 && 0 <= i__2 ? i__2 :
s_rnge("ordnom", i__2, "zzbodker_", (ftnlen)404)] - 1)
< 2000 && 0 <= i__3 ? i__3 : s_rnge("drop", i__3,
"zzbodker_", (ftnlen)404)] = TRUE_;
}
}
}
/* If necessary, remove duplicates. */
if (remdup) {
/* Sweep through the DROP array, compressing off any elements */
/* that are to be dropped. */
j = 0;
i__1 = *nvals;
for (i__ = 1; i__ <= i__1; ++i__) {
if (! drop[(i__2 = i__ - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge(
"drop", i__2, "zzbodker_", (ftnlen)423)]) {
++j;
s_copy(names + ((i__2 = j - 1) < 2000 && 0 <= i__2 ? i__2 :
s_rnge("names", i__2, "zzbodker_", (ftnlen)425)) * 36,
names + ((i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3
: s_rnge("names", i__3, "zzbodker_", (ftnlen)425)) *
36, (ftnlen)36, (ftnlen)36);
s_copy(nornam + ((i__2 = j - 1) < 2000 && 0 <= i__2 ? i__2 :
s_rnge("nornam", i__2, "zzbodker_", (ftnlen)426)) *
36, nornam + ((i__3 = i__ - 1) < 2000 && 0 <= i__3 ?
i__3 : s_rnge("nornam", i__3, "zzbodker_", (ftnlen)
426)) * 36, (ftnlen)36, (ftnlen)36);
codes[(i__2 = j - 1) < 2000 && 0 <= i__2 ? i__2 : s_rnge(
"codes", i__2, "zzbodker_", (ftnlen)427)] = codes[(
i__3 = i__ - 1) < 2000 && 0 <= i__3 ? i__3 : s_rnge(
"codes", i__3, "zzbodker_", (ftnlen)427)];
}
}
/* Adjust NVALS to compensate for the number of elements that */
/* were compressed off the list. */
*nvals = j;
}
/* Compute the order vectors that ZZBODTRN requires. */
zzbodini_(names, nornam, codes, nvals, ordnom, ordcod, nocds, (ftnlen)36,
(ftnlen)36);
/* We're on the home stretch if we make it to this point. */
/* Set EXTKER to .TRUE., check out and return. */
*extker = TRUE_;
chkout_("ZZBODKER", (ftnlen)8);
return 0;
} /* zzbodker_ */
/* $Procedure TKFRAM (Text kernel frame transformation ) */
/* Subroutine */ int tkfram_(integer *id, doublereal *rot, integer *frame,
logical *found)
{
/* Initialized data */
static integer at = 0;
static logical first = TRUE_;
/* System generated locals */
address a__1[2];
integer i__1, i__2[2], i__3;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static char name__[32];
static integer tail;
static char spec[32], item[32*14];
static integer idnt[1], axes[3];
static logical full;
static integer pool[52] /* was [2][26] */;
extern doublereal vdot_(doublereal *, doublereal *);
static char type__[1];
static doublereal qtmp[4];
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
static integer i__, n, r__;
static doublereal buffd[180] /* was [9][20] */;
static integer buffi[20] /* was [1][20] */, oldid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static char agent[32];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
ident_(doublereal *), errch_(char *, char *, ftnlen, ftnlen);
static doublereal tempd;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, vhatg_(doublereal *, integer *, doublereal *);
extern integer lnktl_(integer *, integer *);
static char idstr[32];
extern integer rtrim_(char *, ftnlen);
static char versn[8], units[32];
static integer ar;
extern logical failed_(void), badkpv_(char *, char *, char *, integer *,
integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
static char frname[32];
static doublereal angles[3];
static char oldagt[32];
static logical buffrd;
extern /* Subroutine */ int locati_(integer *, integer *, integer *,
integer *, integer *, logical *), frmnam_(integer *, char *,
ftnlen), namfrm_(char *, integer *, ftnlen);
static logical update;
static char altnat[32];
extern /* Subroutine */ int lnkini_(integer *, integer *);
extern integer lnknfn_(integer *);
static integer idents[20] /* was [1][20] */;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen), gdpool_(char *, integer *,
integer *, integer *, doublereal *, logical *, ftnlen), sigerr_(
char *, ftnlen), gipool_(char *, integer *, integer *, integer *,
integer *, logical *, ftnlen), chkout_(char *, ftnlen), sharpr_(
doublereal *), dtpool_(char *, logical *, integer *, char *,
ftnlen, ftnlen), setmsg_(char *, ftnlen);
static doublereal matrix[9] /* was [3][3] */;
extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), dwpool_(
char *, ftnlen), errint_(char *, integer *, ftnlen), vsclip_(
doublereal *, doublereal *);
static doublereal quatrn[4];
extern /* Subroutine */ int convrt_(doublereal *, char *, char *,
doublereal *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int q2m_(doublereal *, doublereal *), intstr_(
integer *, char *, ftnlen), swpool_(char *, integer *, char *,
ftnlen, ftnlen);
static logical fnd;
static char alt[32*14];
/* $ Abstract */
/* This routine returns the rotation from the input frame */
/* specified by ID to the associated frame given by FRAME. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* FRAMES */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ---------------------------------------------- */
/* ID I Class identification code for the instrument */
/* ROT O The rotation from ID to FRAME. */
/* FRAME O The integer code of some reference frame. */
/* FOUND O TRUE if the rotation could be determined. */
/* $ Detailed_Input */
/* ID The identification code used to specify an */
/* instrument in the SPICE system. */
/* $ Detailed_Output */
/* ROT is a rotation matrix that gives the transformation */
/* from the frame specified by ID to the frame */
/* specified by FRAME. */
/* FRAME is the id code of the frame used to define the */
/* orientation of the frame given by ID. ROT gives */
/* the transformation from the IF frame to */
/* the frame specified by FRAME. */
/* FOUND is a logical indicating whether or not a frame */
/* definition for frame ID was constructed from */
/* kernel pool data. If ROT and FRAME were constructed */
/* FOUND will be returned with the value TRUE. */
/* Otherwise it will be returned with the value FALSE. */
/* $ Parameters */
/* BUFSIZ is the number of rotation, frame id pairs that */
/* can have their instance data buffered for the */
/* sake of improving run-time performance. This */
/* value MUST be positive and should probably be */
/* at least 10. */
/* $ Exceptions */
/* 1) If some instance value associated with this frame */
/* cannot be located, or does not have the proper type */
/* or dimension, the error will be diagnosed by the */
/* routine BADKPV. In such a case FOUND will be set to .FALSE. */
/* 2) If the input ID has the value 0, the error */
/* SPICE(ZEROFRAMEID) will be signaled. FOUND will be set */
/* to FALSE. */
/* 3) If the name of the frame corresponding to ID cannot be */
/* determined, the error 'SPICE(INCOMPLETEFRAME)' is signaled. */
/* 4) If the frame given by ID is defined relative to a frame */
/* that is unrecognized, the error SPICE(BADFRAMESPEC) */
/* will be signaled. FOUND will be set to FALSE. */
/* 5) If the kernel pool specification for ID is not one of */
/* MATRIX, ANGLES, or QUATERNION, then the error */
/* SPICE(UNKNOWNFRAMESPEC) will be signaled. FOUND will be */
/* set to FALSE. */
/* $ Files */
/* This routine makes use of the loaded text kernels to */
/* determine the rotation from a constant offset frame */
/* to its defining frame. */
/* $ Particulars */
/* This routine is used to construct the rotation from some frame */
/* that is a constant rotation offset from some other reference */
/* frame. This rotation is derived from data stored in the kernel */
/* pool. */
/* It is considered to be an low level routine that */
/* will need to be called directly only by persons performing */
/* high volume processing. */
/* $ Examples */
/* This is intended to be used as a low level routine by */
/* the frame system software. However, you could use this */
/* routine to directly retrieve the rotation from an offset */
/* frame to its relative frame. One instance in which you */
/* might do this is if you have a properly specified topocentric */
/* frame for some site on earth and you wish to determine */
/* the geodetic latitude and longitude of the site. Here's how. */
/* Suppose the name of the topocentric frame is: 'MYTOPO'. */
/* First we get the id-code of the topocentric frame. */
/* CALL NAMFRM ( 'MYTOPO', FRCODE ) */
/* Next get the rotation from the topocentric frame to */
/* the bodyfixed frame. */
/* CALL TKFRAM ( FRCODE, ROT, FRAME, FOUND ) */
/* Make sure the topoframe is relative to one of the earth */
/* fixed frames. */
/* CALL FRMNAM( FRAME, TEST ) */
/* IF ( TEST .NE. 'IAU_EARTH' */
/* . .AND. TEST .NE. 'EARTH_FIXED' */
/* . .AND. TEST .NE. 'ITRF93' ) THEN */
/* WRITE (*,*) 'The frame MYTOPO does not appear to be ' */
/* WRITE (*,*) 'defined relative to an earth fixed frame.' */
/* STOP */
/* END IF */
/* Things look ok. Get the location of the Z-axis in the */
/* topocentric frame. */
/* Z(1) = ROT(1,3) */
/* Z(2) = ROT(2,3) */
/* Z(3) = ROT(3,3) */
/* Convert the Z vector to latitude longitude and radius. */
/* CALL RECLAT ( Z, LAT, LONG, RAD ) */
/* WRITE (*,*) 'The geodetic coordinates of the center of' */
/* WRITE (*,*) 'the topographic frame are: ' */
/* WRITE (*,*) */
/* WRITE (*,*) 'Latitude (deg): ', LAT *DPR() */
/* WRITE (*,*) 'Longitude (deg): ', LONG*DPR() */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.0, 23-APR-2009 (NJB) */
/* Bug fix: watch is deleted only for frames */
/* that are deleted from the buffer. */
/* - SPICELIB Version 2.0.0, 19-MAR-2009 (NJB) */
/* Bug fix: this routine now deletes watches set on */
/* kernel variables of frames that are discarded from */
/* the local buffering system. */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* - SPICELIB Version 1.1.0, 21-NOV-2001 (FST) */
/* Updated this routine to dump the buffer of frame ID codes */
/* it saves when it or one of the modules in its call tree signals */
/* an error. This fixes a bug where a frame's ID code is */
/* buffered, but the matrix and kernel pool watcher were not set */
/* properly. */
/* - SPICELIB Version 1.0.0, 18-NOV-1996 (WLT) */
/* -& */
/* $ Index_Entries */
/* Fetch the rotation and frame of a text kernel frame */
/* Fetch the rotation and frame of a constant offset frame */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Local Variables */
/* Saved variables */
/* Initial values */
/* Programmer's note: this routine makes use of the *implementation* */
/* of LOCATI. If that routine is changed, the logic this routine */
/* uses to locate buffered, old frame IDs may need to change as well. */
/* Before we even check in, if N is less than 1 we can */
/* just return. */
/* Perform any initializations that might be needed for this */
/* routine. */
if (first) {
first = FALSE_;
s_copy(versn, "1.0.0", (ftnlen)8, (ftnlen)5);
lnkini_(&c__20, pool);
}
/* Now do the standard SPICE error handling. Sure this is */
/* a bit unconventional, but nothing will be hurt by doing */
/* the stuff above first. */
if (return_()) {
return 0;
}
chkin_("TKFRAM", (ftnlen)6);
/* So far, we've not FOUND the rotation to the specified frame. */
*found = FALSE_;
/* Check the ID to make sure it is non-zero. */
if (*id == 0) {
lnkini_(&c__20, pool);
setmsg_("Frame identification codes are required to be non-zero. Yo"
"u've specified a frame with ID value zero. ", (ftnlen)102);
sigerr_("SPICE(ZEROFRAMEID)", (ftnlen)18);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Find out whether our linked list pool is already full. */
/* We'll use this information later to decide whether we're */
/* going to have to delete a watcher. */
full = lnknfn_(pool) == 0;
if (full) {
/* If the input frame ID is not buffered, we'll need to */
/* overwrite an existing buffer entry. In this case */
/* the call to LOCATI we're about to make will overwrite */
/* the ID code in the slot we're about to use. We need */
/* this ID code, so extract it now while we have the */
/* opportunity. The old ID sits at the tail of the list */
/* whose head node is AT. */
tail = lnktl_(&at, pool);
oldid = idents[(i__1 = tail - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"idents", i__1, "tkfram_", (ftnlen)413)];
/* Create the name of the agent associated with the old */
/* frame. */
s_copy(oldagt, "TKFRAME_#", (ftnlen)32, (ftnlen)9);
repmi_(oldagt, "#", &oldid, oldagt, (ftnlen)32, (ftnlen)1, (ftnlen)32)
;
}
/* Look up the address of the instance data. */
idnt[0] = *id;
locati_(idnt, &c__1, idents, pool, &at, &buffrd);
if (full && ! buffrd) {
/* Since the buffer is already full, we'll delete the watcher for */
/* the kernel variables associated with OLDID, since there's no */
/* longer a need for that watcher. */
/* First clear the update status of the old agent; DWPOOL won't */
/* delete an agent with a unchecked update. */
cvpool_(oldagt, &update, (ftnlen)32);
dwpool_(oldagt, (ftnlen)32);
}
/* Until we have better information we put the identity matrix */
/* into the output rotation and set FRAME to zero. */
ident_(rot);
*frame = 0;
/* If we have to look up the data for our frame, we do */
/* it now and perform any conversions and computations that */
/* will be needed when it's time to convert coordinates to */
/* directions. */
/* Construct the name of the agent associated with the */
/* requested frame. (Each frame has its own agent). */
intstr_(id, idstr, (ftnlen)32);
frmnam_(id, frname, (ftnlen)32);
if (s_cmp(frname, " ", (ftnlen)32, (ftnlen)1) == 0) {
lnkini_(&c__20, pool);
setmsg_("The Text Kernel (TK) frame with id-code # does not have a r"
"ecognized name. ", (ftnlen)75);
errint_("#", id, (ftnlen)1);
sigerr_("SPICE(INCOMPLETFRAME)", (ftnlen)21);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = idstr;
s_cat(agent, a__1, i__2, &c__2, (ftnlen)32);
r__ = rtrim_(agent, (ftnlen)32);
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = frname;
s_cat(altnat, a__1, i__2, &c__2, (ftnlen)32);
ar = rtrim_(altnat, (ftnlen)32);
/* If the frame is buffered, we check the kernel pool to */
/* see if there has been an update to this frame. */
if (buffrd) {
cvpool_(agent, &update, r__);
} else {
/* If the frame is not buffered we definitely need to update */
/* things. */
update = TRUE_;
}
if (! update) {
/* Just look up the rotation matrix and relative-to */
/* information from the local buffer. */
rot[0] = buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)506)];
rot[1] = buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)507)];
rot[2] = buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)508)];
rot[3] = buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)509)];
rot[4] = buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)510)];
rot[5] = buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)511)];
rot[6] = buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)512)];
rot[7] = buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)513)];
rot[8] = buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)514)];
*frame = buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"buffi", i__1, "tkfram_", (ftnlen)516)];
} else {
/* Determine how the frame is specified and what it */
/* is relative to. The variables that specify */
/* how the frame is represented and what it is relative to */
/* are TKFRAME_#_SPEC and TKFRAME_#_RELATIVE where # is */
/* replaced by the text value of ID or the frame name. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(alt, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(alt + 32, a__1, i__2, &c__2, (ftnlen)32);
/* See if the friendlier version of the kernel pool variables */
/* are available. */
for (i__ = 1; i__ <= 2; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)537)) << 5), found,
&n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("item", i__1, "tkfram_", (ftnlen)540)) << 5),
alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ? i__3 :
s_rnge("alt", i__3, "tkfram_", (ftnlen)540)) << 5), (
ftnlen)32, (ftnlen)32);
}
}
/* If either the SPEC or RELATIVE frame are missing from */
/* the kernel pool, we simply return. */
if (badkpv_("TKFRAM", item, "=", &c__1, &c__1, "C", (ftnlen)6, (
ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM", item +
32, "=", &c__1, &c__1, "C", (ftnlen)6, (ftnlen)32, (ftnlen)1,
(ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* If we make it this far, look up the SPEC and RELATIVE frame. */
gcpool_(item, &c__1, &c__1, &n, spec, &fnd, (ftnlen)32, (ftnlen)32);
gcpool_(item + 32, &c__1, &c__1, &n, name__, &fnd, (ftnlen)32, (
ftnlen)32);
/* Look up the id-code for this frame. */
namfrm_(name__, frame, (ftnlen)32);
if (*frame == 0) {
lnkini_(&c__20, pool);
setmsg_("The frame to which frame # is relatively defined is not"
" recognized. The kernel pool specification of the relati"
"ve frame is '#'. This is not a recognized frame. ", (
ftnlen)161);
errint_("#", id, (ftnlen)1);
errch_("#", name__, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BADFRAMESPEC)", (ftnlen)19);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Convert SPEC to upper case so that we can easily check */
/* to see if this is one of the expected specification types. */
ucase_(spec, spec, (ftnlen)32, (ftnlen)32);
if (s_cmp(spec, "MATRIX", (ftnlen)32, (ftnlen)6) == 0) {
/* This is the easiest case. Just grab the matrix */
/* from the kernel pool (and polish it up a bit just */
/* to make sure we have a rotation matrix). */
/* We give preference to the kernel pool variable */
/* TKFRAME_<name>_MATRIX if it is available. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__9, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* The variable meets current expectations, look it up */
/* from the kernel pool. */
gdpool_(item + 64, &c__1, &c__9, &n, matrix, &fnd, (ftnlen)32);
/* In this case the full transformation matrix has been */
/* specified. We simply polish it up a bit. */
moved_(matrix, &c__9, rot);
sharpr_(rot);
/* The matrix might not be right-handed, so correct */
/* the sense of the second and third columns if necessary. */
if (vdot_(&rot[3], &matrix[3]) < 0.) {
vsclip_(&c_b95, &rot[3]);
}
if (vdot_(&rot[6], &matrix[6]) < 0.) {
vsclip_(&c_b95, &rot[6]);
}
} else if (s_cmp(spec, "ANGLES", (ftnlen)32, (ftnlen)6) == 0) {
/* Look up the angles, their units and axes for the */
/* frame specified by ID. (Note that UNITS are optional). */
/* As in the previous case we give preference to the */
/* form TKFRAME_<name>_<item> over TKFRAME_<id>_<item>. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(alt + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(alt + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Again, we give preference to the more friendly form */
/* of TKFRAME specification. */
for (i__ = 3; i__ <= 5; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)668)) << 5),
found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1
: s_rnge("item", i__1, "tkfram_", (ftnlen)671)) <<
5), alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ?
i__3 : s_rnge("alt", i__3, "tkfram_", (ftnlen)671)
) << 5), (ftnlen)32, (ftnlen)32);
}
}
if (badkpv_("TKFRAM", item + 64, "=", &c__3, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM",
item + 96, "=", &c__3, &c__1, "N", (ftnlen)6, (ftnlen)32,
(ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
s_copy(units, "RADIANS", (ftnlen)32, (ftnlen)7);
gdpool_(item + 64, &c__1, &c__3, &n, angles, &fnd, (ftnlen)32);
gipool_(item + 96, &c__1, &c__3, &n, axes, &fnd, (ftnlen)32);
gcpool_(item + 128, &c__1, &c__1, &n, units, &fnd, (ftnlen)32, (
ftnlen)32);
/* Convert angles to radians. */
for (i__ = 1; i__ <= 3; ++i__) {
convrt_(&angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("angles", i__1, "tkfram_", (ftnlen)700)],
units, "RADIANS", &tempd, (ftnlen)32, (ftnlen)7);
angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"angles", i__1, "tkfram_", (ftnlen)701)] = tempd;
}
if (failed_()) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Compute the rotation from instrument frame to CK frame. */
eul2m_(angles, &angles[1], &angles[2], axes, &axes[1], &axes[2],
rot);
} else if (s_cmp(spec, "QUATERNION", (ftnlen)32, (ftnlen)10) == 0) {
/* Look up the quaternion and convert it to a rotation */
/* matrix. Again there are two possible variables that */
/* may point to the quaternion. We give preference to */
/* the form TKFRAME_<name>_Q over the form TKFRAME_<id>_Q. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__4, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* In this case we have the quaternion representation. */
/* Again, we do a small amount of polishing of the input. */
gdpool_(item + 64, &c__1, &c__4, &n, quatrn, &fnd, (ftnlen)32);
vhatg_(quatrn, &c__4, qtmp);
q2m_(qtmp, rot);
} else {
/* We don't recognize the SPEC for this frame. Say */
/* so. Also note that perhaps the user needs to upgrade */
/* the toolkit. */
lnkini_(&c__20, pool);
setmsg_("The frame specification \"# = '#'\" is not one of the r"
"econized means of specifying a text-kernel constant offs"
"et frame (as of version # of the routine TKFRAM). This m"
"ay reflect a typographical error or may indicate that yo"
"u need to consider updating your version of the SPICE to"
"olkit. ", (ftnlen)284);
errch_("#", item, (ftnlen)1, (ftnlen)32);
errch_("#", spec, (ftnlen)1, (ftnlen)32);
errch_("#", versn, (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(UNKNOWNFRAMESPEC)", (ftnlen)23);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Buffer the identifier, relative frame and rotation matrix. */
buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)784)] = rot[0];
buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)785)] = rot[1];
buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)786)] = rot[2];
buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)787)] = rot[3];
buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)788)] = rot[4];
buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)789)] = rot[5];
buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)790)] = rot[6];
buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)791)] = rot[7];
buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)792)] = rot[8];
buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("buffi", i__1,
"tkfram_", (ftnlen)794)] = *frame;
/* If these were not previously buffered, we need to set */
/* a watch on the various items that might be used to define */
/* this frame. */
if (! buffrd) {
/* Immediately check for an update so that we will */
/* not redundantly look for this item the next time this */
/* routine is called. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 160, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 192, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 224, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 256, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 288, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 320, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 352, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 384, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 416, a__1, i__2, &c__2, (ftnlen)32);
swpool_(agent, &c__14, item, (ftnlen)32, (ftnlen)32);
cvpool_(agent, &update, (ftnlen)32);
}
}
if (failed_()) {
lnkini_(&c__20, pool);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* All errors cause the routine to exit before we get to this */
/* point. If we reach this point we didn't have an error and */
/* hence did find the rotation from ID to FRAME. */
*found = TRUE_;
/* That's it */
chkout_("TKFRAM", (ftnlen)6);
return 0;
} /* tkfram_ */
/* $Procedure ZZBODKER ( Private --- Process Body-Name Kernel Pool Maps ) */
/* Subroutine */ int zzbodker_(char *names, char *nornam, integer *codes,
integer *nvals, logical *extker, integer *bnmlst, integer *bnmpol,
char *bnmnms, integer *bnmidx, integer *bidlst, integer *bidpol,
integer *bidids, integer *bididx, ftnlen names_len, ftnlen nornam_len,
ftnlen bnmnms_len)
{
/* Initialized data */
static char nbc[32] = "NAIF_BODY_CODE ";
static char nbn[32] = "NAIF_BODY_NAME ";
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Local variables */
char type__[1*2];
integer nsiz[2];
extern /* Subroutine */ int zzbodini_(char *, char *, integer *, integer *
, integer *, integer *, integer *, char *, integer *, integer *,
integer *, integer *, integer *, ftnlen, ftnlen, ftnlen);
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
extern logical failed_(void);
logical plfind[2];
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen), gipool_(char *, integer *,
integer *, integer *, integer *, logical *, ftnlen), chkout_(char
*, ftnlen), sigerr_(char *, ftnlen), dtpool_(char *, logical *,
integer *, char *, ftnlen, ftnlen), setmsg_(char *, ftnlen),
errint_(char *, integer *, ftnlen), ljucrs_(integer *, char *,
char *, ftnlen, ftnlen);
extern logical return_(void);
integer num[2];
/* $ 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 routine processes the kernel pool vectors NAIF_BODY_NAME */
/* and NAIF_BODY_CODE into the lists and hashes required by ZZBODTRN */
/* to successfully compute code-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 */
/* $ 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. */
/* $ Parameters */
/* MAXL is the maximum length of a body name. */
/* MAXP is the maximum number of additional names that may */
/* be added via the ZZBODDEF interface. */
/* NPERM is the count of the mapping assignments built into */
/* SPICE. */
/* MAXE is the size of the lists and hashes storing combined */
/* built-in and ZZBODDEF-defined name/ID mappings. To */
/* ensure efficient hashing this size is the set to the */
/* first prime number greater than ( MAXP + NPERM ). */
/* NROOM is the size of the lists and hashes storing the */
/* POOL-defined name/ID mappings. To ensure efficient */
/* hashing and to provide the ability to store nearly as */
/* many names as can fit in the POOL, this size is */
/* set to the first prime number less than MAXLIN */
/* defined in the POOL umbrella routine. */
/* $ Required_Reading */
/* naif_ids.req */
/* $ Keywords */
/* BODY */
/* CONVERSION */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 07-MAY-2014 (BVS)(EDW) */
/* Increased NROOM to 14983. Added a comment note explaining */
/* NROOM and MAXE */
/* - SPICELIB Version 1.0.0, 20-MAY-2010 (EDW) */
/* N0064 version with MAXP = 150, NPERM = 563, */
/* MAXE = MAXP + NPERM, and NROOM = 2000. */
/* 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 */
/* Maximum number of additional names that may be added via the */
/* ZZBODDEF interface. */
/* Count of default SPICE mapping assignments. */
/* Size of the lists and hashes storing the built-in and */
/* ZZBODDEF-defined name/ID mappings. To ensure efficient hashing */
/* this size is the set to the first prime number greater than */
/* ( MAXP + NPERM ). */
/* Size of the lists and hashes storing the POOL-defined name/ID */
/* mappings. To ensure efficient hashing and to provide the ability */
/* to store nearly as many names as can fit in the POOL, this size */
/* is set to the first prime number less than MAXLIN defined in */
/* the POOL umbrella routine. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* NAMES O Array of kernel pool assigned names. */
/* NORNAM O Array of normalized kernel pool assigned names. */
/* CODES O Array of ID codes for NAMES/NORNAM. */
/* NVALS O Length of NAMES, NORNAM, and CODES arrays. */
/* EXTKER O Logical indicating presence of kernel pool names. */
/* BNMLST O Body name-based hash head node pointer list */
/* BNMPOL O Body name-based hash node collision list */
/* BNMNMS O Body name-based hash item list */
/* BNMIDX O Body name-based hash index storage array */
/* BIDLST O Body ID-based hash head node pointer list */
/* BIDPOL O Body ID-based hash node collision list */
/* BIDIDS O Body ID-based hash item list */
/* BIDIDX O Body ID-based hash index storage array */
/* LBPOOL P Lower bound of hash pool arrays */
/* MAXL P Maximum length of body name strings. */
/* NROOM P Maximum length of kernel pool data vectors. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* NAMES is the array of names extracted from the kernel pool */
/* vector NAIF_BODY_NAME. This array is parallel to */
/* NORNAM and CODES. */
/* NORNAM the array of names extracted from the kernel pool */
/* vector NAIF_BODY_NAME. After extraction, each entry is */
/* converted to uppercase, and groups of spaces are */
/* compressed to a single space. This represents the */
/* canonical member of the equivalence class each parallel */
/* entry in NAMES belongs. */
/* CODES the array of codes extracted from the kernel pool */
/* vector NAIF_BODY_CODE. This array is parallel to NAMES */
/* and NORNAM. */
/* NVALS the number of items contained in NAMES, NORNAM, and */
/* CODES. */
/* EXTKER is a logical that indicates to the caller whether any */
/* kernel pool name-code maps have been defined. If EXTKER */
/* is .FALSE., then the kernel pool variables */
/* NAIF_BODY_CODE and NAIF_BODY_NAME are empty and only */
/* the built-in and ZZBODDEF code-name mappings need */
/* consideration. If .TRUE., then the values returned by */
/* this module need consideration. */
/* BNMLST */
/* BNMPOL */
/* BNMNMS are the body name-based hash head node pointer, node */
/* collision, and item lists. Together they return the */
/* index of the element in the BNMIDX index storage array */
/* that stores the index of the body items in the NAMES, */
/* NORNAM, and CODES arrays. */
/* BNMIDX is the body name-based hash index storage array */
/* containing at the index determined by the hash for a */
/* given normalized name the index corresponding to this */
/* name in the NAMES, NORNAM, and CODES arrays. */
/* BIDLST */
/* BIDPOL */
/* BIDIDS are the body ID-based hash head node pointer, node */
/* collision, and item lists. Together they return the */
/* index of the element in the BNMIDX index storage array */
/* that stores the index of the body items in the */
/* NAMES, NORNAM, and CODES arrays. */
/* BIDIDX is the body ID-based hash index storage array */
/* containing at the index determined by the hash for a */
/* given ID the index corresponding to this ID in the */
/* NAMES, NORNAM, and CODES arrays. */
/* $ Parameters */
/* LBPOOL is the lower bound of the hashes' collision list array. */
/* MAXL is the maximum length of a body name. Defined in the */
/* include file 'zzbodtrn.inc'. */
/* NROOM is the maximum number of kernel pool data items that */
/* can be processed from the NAIF_BODY_CODE and */
/* NAIF_BODY_NAME lists. */
/* $ Exceptions */
/* 1) The error SPICE(MISSINGKPV) is signaled when one of the */
/* NAIF_BODY_CODE and NAIF_BODY_NAME keywords is present in the */
/* kernel pool and the other is not. */
/* 2) The error SPICE(KERVARTOOBIG) is signaled if one or both of */
/* the NAIF_BODY_CODE and NAIF_BODY_NAME kernel pool vectors */
/* have a cardinality that exceeds NROOM. */
/* 3) The error SPICE(BADDIMENSIONS) is signaled if the cardinality */
/* of the NAIF_BODY_CODE and NAIF_BODY_NAME kernel pool vectors do */
/* not match. */
/* 4) The error SPICE(BLANKNAMEASSIGNED) is signaled if an entry */
/* in the NAIF_BODY_NAME kernel pool vector is a blank string. */
/* ID codes may not be assigned to a blank string. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine examines the contents of the kernel pool, ingests */
/* the contents of the NAIF_BODY_CODE and NAIF_BODY_NAME keywords, */
/* and produces name/code lists and hashes that ZZBODTRN requires to */
/* resolve code to name and name to code mappings. */
/* The NAMES and CODES arrays stored all values provided in the */
/* corresponding POOL variables. No attempt to remove duplicates, */
/* change order, or do any other alterations to these arrays is made */
/* by this routine. */
/* The order of mapping in the NAMES, NORNAM, and CODES arrays */
/* determines the priority, with the mapping with the lowest */
/* priority being first and the mapping with the highest priority */
/* being last. */
/* If more than one entry with a particular normalized name is */
/* present in the NORNAM array, only the latest entry is registered */
/* in the name-based hash. */
/* If more than one entry with a particular ID is present in the */
/* CODES array, only the latest entry that maps to a not-yet */
/* registered normalized name is registered in the ID-based hash. */
/* Registering IDs only for not-yet registered names achieves masking */
/* all IDs with the lower priority in cases when a single normalized */
/* name maps to more than one ID. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 16-SEP-2013 (BVS) */
/* Changed routine's calling sequence by dropping name and ID */
/* order vectors and adding name- and ID-based hashes and */
/* modified it to initialize hashes instead of the order arrays. */
/* - SPICELIB Version 1.0.0, 23-AUG-2002 (EDW) (FST) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Local Variables */
/* Saved Variables */
/* Data Statements */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZBODKER", (ftnlen)8);
}
/* Until the code below proves otherwise, we shall assume */
/* we lack kernel pool name/code mappings. */
*extker = FALSE_;
/* Check for the external body ID variables in the kernel pool. */
gcpool_(nbn, &c__1, &c__14983, num, names, plfind, (ftnlen)32, (ftnlen)36)
;
gipool_(nbc, &c__1, &c__14983, &num[1], codes, &plfind[1], (ftnlen)32);
if (failed_()) {
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* Examine PLFIND(1) and PLFIND(2) for problems. */
if (plfind[0] != plfind[1]) {
/* If they are not both present or absent, signal an error. */
setmsg_("The kernel pool vector, #, used in mapping between names an"
"d ID-codes is absent, while # is not. This is often due to "
"an improperly constructed text kernel. Check loaded kernels"
" for these keywords.", (ftnlen)199);
if (plfind[0]) {
errch_("#", nbc, (ftnlen)1, (ftnlen)32);
errch_("#", nbn, (ftnlen)1, (ftnlen)32);
} else {
errch_("#", nbn, (ftnlen)1, (ftnlen)32);
errch_("#", nbc, (ftnlen)1, (ftnlen)32);
}
sigerr_("SPICE(MISSINGKPV)", (ftnlen)17);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
} else if (! plfind[0]) {
/* Return if both keywords are absent. */
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* If we reach here, then both kernel pool variables are present. */
/* Perform some simple sanity checks on their lengths. */
dtpool_(nbn, &found, nsiz, type__, (ftnlen)32, (ftnlen)1);
dtpool_(nbc, &found, &nsiz[1], type__ + 1, (ftnlen)32, (ftnlen)1);
if (failed_()) {
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
if (nsiz[0] > 14983 || nsiz[1] > 14983) {
setmsg_("The kernel pool vectors used to define the names/ID-codes m"
"appingexceeds the max size. The size of the NAME vector is #"
"1. The size of the CODE vector is #2. The max number allowed"
" of elements is #3.", (ftnlen)198);
errint_("#1", nsiz, (ftnlen)2);
errint_("#2", &nsiz[1], (ftnlen)2);
errint_("#3", &c__14983, (ftnlen)2);
sigerr_("SPICE(KERVARTOOBIG)", (ftnlen)19);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
} else if (nsiz[0] != nsiz[1]) {
setmsg_("The kernel pool vectors used for mapping between names and "
"ID-codes are not the same size. The size of the name vector"
", NAIF_BODY_NAME is #. The size of the ID-code vector, NAIF_"
"BODY_CODE is #. You need to examine the ID-code kernel you l"
"oaded and correct the mismatch.", (ftnlen)270);
errint_("#", nsiz, (ftnlen)1);
errint_("#", &nsiz[1], (ftnlen)1);
sigerr_("SPICE(BADDIMENSIONS)", (ftnlen)20);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* Compute the canonical member of the equivalence class of NAMES, */
/* NORNAM. This normalization compresses groups of spaces into a */
/* single space, left justifies the string, and upper-cases the */
/* contents. While passing through the NAMES array, look for any */
/* blank strings and signal an appropriate error. */
*nvals = num[0];
i__1 = *nvals;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Check for blank strings. */
if (s_cmp(names + ((i__2 = i__ - 1) < 14983 && 0 <= i__2 ? i__2 :
s_rnge("names", i__2, "zzbodker_", (ftnlen)403)) * 36, " ", (
ftnlen)36, (ftnlen)1) == 0) {
setmsg_("An attempt to assign the code, #, to a blank string was"
" made. Check loaded text kernels for a blank string in "
"the NAIF_BODY_NAME array.", (ftnlen)136);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(BLANKNAMEASSIGNED)", (ftnlen)24);
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* Compute the canonical member of the equivalence class. */
ljucrs_(&c__1, names + ((i__2 = i__ - 1) < 14983 && 0 <= i__2 ? i__2 :
s_rnge("names", i__2, "zzbodker_", (ftnlen)419)) * 36,
nornam + ((i__3 = i__ - 1) < 14983 && 0 <= i__3 ? i__3 :
s_rnge("nornam", i__3, "zzbodker_", (ftnlen)419)) * 36, (
ftnlen)36, (ftnlen)36);
}
/* Populate hashes required by ZZBODTRN. */
zzbodini_(names, nornam, codes, nvals, &c__14983, bnmlst, bnmpol, bnmnms,
bnmidx, bidlst, bidpol, bidids, bididx, (ftnlen)36, (ftnlen)36, (
ftnlen)36);
if (failed_()) {
chkout_("ZZBODKER", (ftnlen)8);
return 0;
}
/* We're on the home stretch if we make it to this point. Set EXTKER */
/* to .TRUE., check out and return. */
*extker = TRUE_;
chkout_("ZZBODKER", (ftnlen)8);
return 0;
} /* zzbodker_ */
/* $Procedure ZZDYNBID ( Fetch body ID kernel variable ) */
/* Subroutine */ int zzdynbid_(char *frname, integer *frcode, char *item,
integer *idcode, ftnlen frname_len, ftnlen item_len)
{
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen,
ftnlen, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
char dtype[1];
extern integer rtrim_(char *, ftnlen);
extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
extern logical failed_(void);
char bodnam[36];
integer codeln, nameln;
char kvname[32], cdestr[32];
integer itemln, reqnam;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
integer reqnum;
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_(
char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen), gcpool_(char *, integer *, integer *, integer *, char
*, logical *, ftnlen, ftnlen), gipool_(char *, integer *, integer
*, integer *, integer *, logical *, ftnlen);
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Look up a frame definition kernel variable whose associated value */
/* is a body name or body ID code. The returned value is always an */
/* ID code. The frame name or frame ID may be used as part of the */
/* variable's name. */
/* If the kernel variable is not present, or if the variable */
/* is not a body name or a numeric value, signal an error. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* FRAMES */
/* KERNEL */
/* PRIVATE */
/* UTILITY */
/* $ Declarations */
/* $ Abstract */
/* This include file lists the parameter collection */
/* defining the number of SPICE ID -> NAME mappings. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* naif_ids.req */
/* $ Keywords */
/* Body mappings. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* $ Version */
/* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */
/* A script generates this file. Do not edit by hand. */
/* Edit the creation script to modify the contents of */
/* ZZBODTRN.INC. */
/* Maximum size of a NAME string */
/* Count of default SPICE mapping assignments. */
/* $ Abstract */
/* Include file zzdyn.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters defined below are used by the SPICELIB dynamic */
/* frame subsystem. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* This file declares parameters required by the dynamic */
/* frame routines of the SPICELIB frame subsystem. */
/* $ Restrictions */
/* The parameter BDNMLN is this routine must be kept */
/* consistent with the parameter MAXL defined in */
/* zzbodtrn.inc */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */
/* Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */
/* - SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */
/* -& */
/* String length parameters */
/* ======================== */
/* Kernel variable name length. This parameter must be */
/* kept consistent with the parameter MAXLEN used in the */
/* POOL umbrella routine. */
/* Length of a character kernel pool datum. This parameter must be */
/* kept consistent with the parameter MAXCHR used in the POOL */
/* umbrella routine. */
/* Reference frame name length. This parameter must be */
/* kept consistent with the parameter WDSIZE used in the */
/* FRAMEX umbrella routine. */
/* Body name length. This parameter is used to provide a level */
/* of indirection so the dynamic frame source code doesn't */
/* have to change if the name of this SPICELIB-scope parameter */
/* is changed. The value MAXL used here is defined in the */
/* INCLUDE file */
/* zzbodtrn.inc */
/* Current value of MAXL = 36 */
/* Numeric parameters */
/* =================================== */
/* The parameter MAXCOF is the maximum number of polynomial */
/* coefficients that may be used to define an Euler angle */
/* in an "Euler frame" definition */
/* The parameter LBSEP is the default angular separation limit for */
/* the vectors defining a two-vector frame. The angular separation */
/* of the vectors must differ from Pi and 0 by at least this amount. */
/* The parameter QEXP is used to determine the width of */
/* the interval DELTA used for the discrete differentiation */
/* of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */
/* recursive analogs. This parameter is appropriate for */
/* 64-bit IEEE double precision numbers; when SPICELIB */
/* is hosted on platforms where longer mantissas are supported, */
/* this parameter (and hence this INCLUDE file) will become */
/* platform-dependent. */
/* The choice of QEXP is based on heuristics. It's believed to */
/* be a reasonable choice obtainable without expensive computation. */
/* QEXP is the largest power of 2 such that */
/* 1.D0 + 2**QEXP = 1.D0 */
/* Given an epoch T0 at which a discrete derivative is to be */
/* computed, this choice provides a value of DELTA that usually */
/* contributes no round-off error in the computation of the function */
/* evaluation epochs */
/* T0 +/- DELTA */
/* while providing the largest value of DELTA having this form that */
/* causes the order of the error term O(DELTA**2) in the quadratric */
/* function approximation to round to zero. Note that the error */
/* itself will normally be small but doesn't necessarily round to */
/* zero. Note also that the small function approximation error */
/* is not a measurement of the error in the discrete derivative */
/* itself. */
/* For ET values T0 > 2**27 seconds past J2000, the value of */
/* DELTA will be set to */
/* T0 * 2**QEXP */
/* For smaller values of T0, DELTA should be set to 1.D0. */
/* Frame kernel parameters */
/* ======================= */
/* Parameters relating to kernel variable names (keywords) start */
/* with the letters */
/* KW */
/* Parameters relating to kernel variable values start with the */
/* letters */
/* KV */
/* Generic parameters */
/* --------------------------------- */
/* Token used to build the base frame keyword: */
/* Frame definition style parameters */
/* --------------------------------- */
/* Token used to build the frame definition style keyword: */
/* Token indicating parameterized dynamic frame. */
/* Freeze epoch parameters */
/* --------------------------------- */
/* Token used to build the freeze epoch keyword: */
/* Rotation state parameters */
/* --------------------------------- */
/* Token used to build the rotation state keyword: */
/* Token indicating rotating rotation state: */
/* Token indicating inertial rotation state: */
/* Frame family parameters */
/* --------------------------------- */
/* Token used to build the frame family keyword: */
/* Token indicating mean equator and equinox of date frame. */
/* Token indicating mean ecliptic and equinox of date frame. */
/* Token indicating true equator and equinox of date frame. */
/* Token indicating two-vector frame. */
/* Token indicating Euler frame. */
/* "Of date" frame family parameters */
/* --------------------------------- */
/* Token used to build the precession model keyword: */
/* Token used to build the nutation model keyword: */
/* Token used to build the obliquity model keyword: */
/* Mathematical models used to define "of date" frames will */
/* likely accrue over time. We will simply assign them */
/* numbers. */
/* Token indicating the Lieske earth precession model: */
/* Token indicating the IAU 1980 earth nutation model: */
/* Token indicating the IAU 1980 earth mean obliqity of */
/* date model. Note the name matches that of the preceding */
/* nutation model---this is intentional. The keyword */
/* used in the kernel variable definition indicates what */
/* kind of model is being defined. */
/* Two-vector frame family parameters */
/* --------------------------------- */
/* Token used to build the vector axis keyword: */
/* Tokens indicating axis values: */
/* Prefixes used for primary and secondary vector definition */
/* keywords: */
/* Token used to build the vector definition keyword: */
/* Token indicating observer-target position vector: */
/* Token indicating observer-target velocity vector: */
/* Token indicating observer-target near point vector: */
/* Token indicating constant vector: */
/* Token used to build the vector observer keyword: */
/* Token used to build the vector target keyword: */
/* Token used to build the vector frame keyword: */
/* Token used to build the vector aberration correction keyword: */
/* Token used to build the constant vector specification keyword: */
/* Token indicating rectangular coordinates used to */
/* specify constant vector: */
/* Token indicating latitudinal coordinates used to */
/* specify constant vector: */
/* Token indicating RA/DEC coordinates used to */
/* specify constant vector: */
/* Token used to build the cartesian vector literal keyword: */
/* Token used to build the constant vector latitude keyword: */
/* Token used to build the constant vector longitude keyword: */
/* Token used to build the constant vector right ascension keyword: */
/* Token used to build the constant vector declination keyword: */
/* Token used to build the angular separation tolerance keyword: */
/* See the section "Physical unit parameters" below for additional */
/* parameters applicable to two-vector frames. */
/* Euler frame family parameters */
/* --------------------------------- */
/* Token used to build the epoch keyword: */
/* Token used to build the Euler axis sequence keyword: */
/* Tokens used to build the Euler angle coefficients keywords: */
/* See the section "Physical unit parameters" below for additional */
/* parameters applicable to Euler frames. */
/* Physical unit parameters */
/* --------------------------------- */
/* Token used to build the units keyword: */
/* Token indicating radians: */
/* Token indicating degrees: */
/* End of include file zzdyn.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ------------------------------------------------- */
/* FRNAME I Frame name. */
/* FRCODE I Frame ID code. */
/* ITEM I Item associated with frame definition. */
/* IDCODE O Body ID code. */
/* $ Detailed_Input */
/* FRNAME is the name of the reference frame with which */
/* the requested variable is associated. */
/* FRCODE is the frame ID code of the reference frame with */
/* which the requested variable is associated. */
/* ITEM is a string identifying the specific datum */
/* to be fetched. The kernel variable name */
/* has the form */
/* FRAME_<frame ID code>_<ITEM> */
/* or */
/* FRAME_<frame name>_<ITEM> */
/* The former of the two names takes precedence: */
/* this routine will look for a numeric variable */
/* of that name first. */
/* The value associated with the kernel variable */
/* must be one of */
/* - a nbody ID code */
/* - a string representation of an integer, */
/* for example '5' */
/* - a body frame name */
/* $ Detailed_Output */
/* IDCODE is the requested body ID code. */
/* The kernel variable name of the form */
/* FRAME_<frame ID code>_<ITEM> */
/* will be looked up first; if this variable */
/* is found and has numeric type, the associated */
/* value will be returned. If this variable is */
/* found and has character type, the value will */
/* be converted to a body ID code, and that */
/* code will be returned. */
/* If this variable is not found, the variable */
/* FRAME_<frame name>_<ITEM> */
/* will be looked up. If this variable is found and */
/* has numeric type, the associated value will be */
/* returned. If this variable is found and has */
/* character type, the value will be converted to a */
/* body ID code, and that code will be returned. */
/* If a numeric value associated with the selected */
/* kernel variable is not integral, it will be */
/* rounded to the closest integer. */
/* $ Parameters */
/* See zzdyn.inc for definition of KVNMLN. */
/* $ Exceptions */
/* 1) If neither the frame-ID-based or frame-name-based form of the */
/* requested kernel variable name matches a kernel variable */
/* present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */
/* will be signaled. */
/* 2) If either the frame-ID-based or frame-name-based form of the */
/* requested kernel variable name has length greater than KVNMLN, */
/* that variable will not be searched for. */
/* 3) If both the frame-ID-based and frame-name-based forms of the */
/* requested kernel variable name have length greater than KVNMLN, */
/* the error SPICE(VARNAMETOOLONG) will be signaled. */
/* 4) If kernel variable matching one form of the requested kernel */
/* variable names is found, but that variable has more than 1 */
/* associated value, the error SPICE(BADVARIABLESIZE) will be */
/* signaled. */
/* 5) If a name match is found for a character kernel variable, but */
/* the value associated with the variable cannot be mapped to a */
/* body ID code, the error SPICE(NOTRANSLATION) will be */
/* signaled. */
/* 6) If a name match is found for a numeric kernel variable, */
/* but that variable has a value that cannot be rounded to an */
/* integer representable on the host platform, an error will */
/* be signaled by a routine in the call tree of this routine. */
/* $ Files */
/* 1) Kernel variables fetched by this routine are normally */
/* introduced into the kernel pool by loading one or more */
/* frame kernels. See the Frames Required Reading for */
/* details. */
/* $ Particulars */
/* This routine centralizes logic for kernel variable lookups that */
/* must be performed by the SPICELIB frame subsystem. Part of the */
/* functionality of this routine consists of handling error */
/* conditions such as the unavailability of required kernel */
/* variables; hence no "found" flag is returned to the caller. */
/* As indicated above, the requested kernel variable may have a name */
/* of the form */
/* FRAME_<frame ID code>_<ITEM> */
/* or */
/* FRAME_<frame name>_<ITEM> */
/* Because most frame definition keywords have the first form, this */
/* routine looks for a name of that form first. */
/* Note that although this routine considers the two forms of the */
/* names to be synonymous, from the point of view of the kernel pool */
/* access routines, these names are distinct. Hence kernel */
/* variables having names of both forms, but having possibly */
/* different attributes, can be simultaneously present in the kernel */
/* pool. Intentional use of this kernel pool feature is discouraged. */
/* $ Examples */
/* 1) See ZZDYNFRM. */
/* 2) Applications of this routine include finding ID codes of */
/* observer or target bodies serving to define two-vector dynamic */
/* frames. */
/* $ Restrictions */
/* 1) This is a SPICE private routine; the routine is subject */
/* to change without notice. User applications should not */
/* call this routine. */
/* 2) An array-valued kernel variable matching the "ID code form" */
/* of the requested kernel variable name could potentially */
/* mask a scalar-valued kernel variable matching the "name */
/* form" of the requested name. This problem can be prevented */
/* by sensible frame kernel design. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */
/* References to parameterized dynamic frames in long error */
/* messages were changed to references to "reference frames." */
/* This change was made to enable this utility to support */
/* kernel variable look-ups for non-dynamic frames. */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */
/* References to parameterized dynamic frames in long error */
/* messages were changed to references to "reference frames." */
/* This change was made to enable this utility to support */
/* kernel variable look-ups for non-dynamic frames. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* TEMPLN is the length of the keyword template, minus */
/* the sum of the lengths of the two substitution markers ('#'). */
/* Local variables */
if (return_()) {
return 0;
}
chkin_("ZZDYNBID", (ftnlen)8);
/* Prepare to check the name of the kernel variable we're about */
/* to look up. */
/* Convert the frame code to a string. */
intstr_(frcode, cdestr, (ftnlen)32);
if (failed_()) {
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Get the lengths of the input frame code, name and item. */
/* Compute the length of the ID-based kernel variable name; */
/* check this length against the maximum allowed value. If */
/* the name is too long, proceed to look up the form of the */
/* kernel variable name based on the frame name. */
codeln = rtrim_(cdestr, (ftnlen)32);
nameln = rtrim_(frname, frname_len);
itemln = rtrim_(item, item_len);
reqnum = codeln + itemln + 7;
if (reqnum <= 32) {
/* First try looking for a kernel variable including the frame ID */
/* code. */
/* Note the template is */
/* 'FRAME_#_#' */
repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, (
ftnlen)32);
repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
ftnlen)32);
dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
} else {
/* The ID-based name is too long. We can't find the variable if */
/* we can't look it up. */
found = FALSE_;
}
if (! found) {
/* We need to look up the frame name-based kernel variable. */
/* Determine the length of the name of this variable; make */
/* sure it's not too long. */
reqnam = nameln + itemln + 7;
if (reqnam > 32 && reqnum > 32) {
/* Both forms of the name are too long. */
setmsg_("Kernel variable FRAME_#_# has length #; kernel variable"
" FRAME_#_# has length #; maximum allowed length is #. N"
"either variable could be searched for in the kernel pool"
" due to these name length errors.", (ftnlen)200);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnum, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnam, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
} else if (reqnam > 32) {
/* We couldn't find the variable having the ID-based name, */
/* and the frame name-based variable name is too long to */
/* look up. */
/* Note that at this point KVNAME contains the ID-based */
/* kernel variable name. */
setmsg_("Kernel variable # was expected to be present in the ker"
"nel pool but was not found. The alternative form of ker"
"nel variable name FRAME_#_# was not searched for because"
" this name has excessive length (# characters vs allowed"
" maximum of #). One of these variables is needed to def"
"ine the reference frame #. Usually this type of problem"
" is due to a missing keyword assignment in a frame kerne"
"l. Another, less likely, possibility is that other erro"
"rs in a frame kernel have confused the frame subsystem i"
"nto wrongly deciding these variables are needed.", (
ftnlen)551);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnam, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Now try looking for a kernel variable including the frame */
/* name. */
repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1,
frname_len, (ftnlen)32);
repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
ftnlen)32);
dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
if (! found && reqnum > 32) {
/* The kernel variable's presence (in one form or the other) */
/* is mandatory: signal an error. The error message */
/* depends on which variables we were able to try to */
/* look up. In this case, we never tried to look up the */
/* frame ID-based name. */
/* Note that at this point KVNAME contains the name-based */
/* kernel variable name. */
setmsg_("Kernel variable # was expected to be present in the ker"
"nel pool but was not found. The alternative form of ker"
"nel variable name FRAME_#_# was not searched for because"
" this name has excessive length (# characters vs allowed"
" maximum of #). One of these variables is needed to def"
"ine the reference frame #. Usually this type of problem"
" is due to a missing keyword assignment in a frame kerne"
"l. Another, less likely, possibility is that other erro"
"rs in a frame kernel have confused the frame subsystem i"
"nto wrongly deciding these variables are needed.", (
ftnlen)551);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errint_("#", &reqnum, (ftnlen)1);
errint_("#", &c__32, (ftnlen)1);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
} else if (! found) {
/* We tried to look up both names and failed. */
setmsg_("At least one of the kernel variables FRAME_#_# or FRAME"
"_#_# was expected to be present in the kernel pool but n"
"either was found. One of these variables is needed to de"
"fine the reference frame #. Usually this type of proble"
"m is due to a missing keyword assignment in a frame kern"
"el. Another, less likely, possibility is that other err"
"ors in a frame kernel have confused the frame subsystem "
"into wrongly deciding these variables are needed.", (
ftnlen)440);
errint_("#", frcode, (ftnlen)1);
errch_("#", item, (ftnlen)1, item_len);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", item, (ftnlen)1, item_len);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
}
/* Getting to this point means we found a kernel variable. The name */
/* of the variable is KVNAME. The data type is DTYPE and the */
/* cardinality is N. */
if (*(unsigned char *)dtype == 'C') {
/* Rather than using BADKPV, we check the cardinality of the */
/* kernel variable in-line so we can create a more detailed error */
/* message if need be. */
if (n > 1) {
setmsg_("The kernel variable # has used to define frame # was ex"
"pected to have size not exceeding 1 but in fact has size"
" #. Usually this type of problem is due to an error in a"
" frame definition provided in a frame kernel.", (ftnlen)
212);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errint_("#", &n, (ftnlen)1);
sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Look up the kernel variable. */
gcpool_(kvname, &c__1, &c__1, &n, bodnam, &found, (ftnlen)32, (ftnlen)
36);
if (! found) {
setmsg_("Variable # not found after DTPOOL indicated it was pres"
"ent in pool.", (ftnlen)67);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Convert the body name to a body code. */
bods2c_(bodnam, idcode, &found, (ftnlen)36);
if (! found) {
setmsg_("Body name # could not be translated to an ID code.", (
ftnlen)50);
errch_("#", bodnam, (ftnlen)1, (ftnlen)36);
sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
} else {
/* The variable has numeric type. */
if (n > 1) {
setmsg_("The kernel variable # has used to define frame # was ex"
"pected to have size not exceeding 1 but in fact has size"
" #. Usually this type of problem is due to an error in a"
" frame definition provided in a frame kernel.", (ftnlen)
212);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errint_("#", &n, (ftnlen)1);
sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
/* Look up the kernel variable. */
gipool_(kvname, &c__1, &c__1, &n, idcode, &found, (ftnlen)32);
if (! found) {
setmsg_("Variable # not found after DTPOOL indicated it was pres"
"ent in pool.", (ftnlen)67);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
}
}
chkout_("ZZDYNBID", (ftnlen)8);
return 0;
} /* zzdynbid_ */
