/* $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_ */