/* $Procedure SPKLTC ( S/P Kernel, light time corrected state ) */ /* Subroutine */ int spkltc_(integer *targ, doublereal *et, char *ref, char * abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) { /* Initialized data */ static logical pass1 = TRUE_; static char prvcor[5] = " "; /* System generated locals */ doublereal d__1, d__2, d__3, d__4; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ doublereal dist; extern doublereal vdot_(doublereal *, doublereal *); static logical xmit; extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen); doublereal a, b, c__; integer i__, refid; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal epoch; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); static logical usecn; extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *, integer *, doublereal *); doublereal ssblt, lterr; static logical uselt; extern doublereal vnorm_(doublereal *); doublereal prvlt; extern logical failed_(void); extern doublereal clight_(void); logical attblk[15]; extern doublereal touchd_(doublereal *); extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); integer ltsign; extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_( char *, ftnlen); doublereal ssbtrg[6]; integer numitr; extern logical return_(void); logical usestl; /* $ Abstract */ /* Return the state (position and velocity) of a target body */ /* relative to an observer, optionally corrected for light time, */ /* expressed relative to an inertial reference 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 */ /* SPK */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ Abstract */ /* Include file zzabcorr.inc */ /* SPICE private file intended solely for the support of SPICE */ /* routines. Users should not include this file directly due */ /* to the volatile nature of this file */ /* The parameters below define the structure of an aberration */ /* correction attribute block. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Parameters */ /* An aberration correction attribute block is an array of logical */ /* flags indicating the attributes of the aberration correction */ /* specified by an aberration correction string. The attributes */ /* are: */ /* - Is the correction "geometric"? */ /* - Is light time correction indicated? */ /* - Is stellar aberration correction indicated? */ /* - Is the light time correction of the "converged */ /* Newtonian" variety? */ /* - Is the correction for the transmission case? */ /* - Is the correction relativistic? */ /* The parameters defining the structure of the block are as */ /* follows: */ /* NABCOR Number of aberration correction choices. */ /* ABATSZ Number of elements in the aberration correction */ /* block. */ /* GEOIDX Index in block of geometric correction flag. */ /* LTIDX Index of light time flag. */ /* STLIDX Index of stellar aberration flag. */ /* CNVIDX Index of converged Newtonian flag. */ /* XMTIDX Index of transmission flag. */ /* RELIDX Index of relativistic flag. */ /* The following parameter is not required to define the block */ /* structure, but it is convenient to include it here: */ /* CORLEN The maximum string length required by any aberration */ /* correction string */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ /* -& */ /* Number of aberration correction choices: */ /* Aberration correction attribute block size */ /* (number of aberration correction attributes): */ /* Indices of attributes within an aberration correction */ /* attribute block: */ /* Maximum length of an aberration correction string: */ /* End of include file zzabcorr.inc */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* TARG I Target body. */ /* ET I Observer epoch. */ /* REF I Inertial reference frame of output state. */ /* ABCORR I Aberration correction flag. */ /* STOBS I State of the observer relative to the SSB. */ /* STARG O State of target. */ /* LT O One way light time between observer and target. */ /* DLT O Derivative of light time with respect to time. */ /* $ Detailed_Input */ /* TARG is the NAIF ID code for a target body. The target */ /* and observer define a state vector whose position */ /* component points from the observer to the target. */ /* ET is the ephemeris time, expressed as seconds past */ /* J2000 TDB, at which the state of the target body */ /* relative to the observer is to be computed. ET */ /* refers to time at the observer's location. */ /* REF is the inertial reference frame with respect to which */ /* the input state STOBS and the output state STARG are */ /* expressed. REF must be recognized by the SPICE */ /* Toolkit. The acceptable frames are listed in the */ /* Frames Required Reading, as well as in the SPICELIB */ /* routine CHGIRF. */ /* Case and blanks are not significant in the string */ /* REF. */ /* ABCORR indicates the aberration corrections to be applied to */ /* the state of the target body to account for one-way */ /* light time. See the discussion in the Particulars */ /* section for recommendations on how to choose */ /* aberration corrections. */ /* If ABCORR includes the stellar aberration correction */ /* symbol '+S', this flag is simply ignored. Aside from */ /* the possible presence of this symbol, ABCORR may be */ /* any of the following: */ /* 'NONE' Apply no correction. Return the */ /* geometric state of the target body */ /* relative to the observer. */ /* The following values of ABCORR apply to the */ /* "reception" case in which photons depart from the */ /* target's location at the light-time corrected epoch */ /* ET-LT and *arrive* at the observer's location at ET: */ /* 'LT' Correct for one-way light time (also */ /* called "planetary aberration") using a */ /* Newtonian formulation. This correction */ /* yields the state of the target at the */ /* moment it emitted photons arriving at */ /* the observer at ET. */ /* The light time correction involves */ /* iterative solution of the light time */ /* equation (see Particulars for details). */ /* The solution invoked by the 'LT' option */ /* uses one iteration. */ /* 'CN' Converged Newtonian light time */ /* correction. In solving the light time */ /* equation, the 'CN' correction iterates */ /* until the solution converges (three */ /* iterations on all supported platforms). */ /* Whether the 'CN+S' solution is */ /* substantially more accurate than the */ /* 'LT' solution depends on the geometry */ /* of the participating objects and on the */ /* accuracy of the input data. In all */ /* cases this routine will execute more */ /* slowly when a converged solution is */ /* computed. See the Particulars section of */ /* SPKEZR for a discussion of precision of */ /* light time corrections. */ /* The following values of ABCORR apply to the */ /* "transmission" case in which photons *depart* from */ /* the observer's location at ET and arrive at the */ /* target's location at the light-time corrected epoch */ /* ET+LT: */ /* 'XLT' "Transmission" case: correct for */ /* one-way light time using a Newtonian */ /* formulation. This correction yields the */ /* state of the target at the moment it */ /* receives photons emitted from the */ /* observer's location at ET. */ /* 'XCN' "Transmission" case: converged */ /* Newtonian light time correction. */ /* Neither special nor general relativistic effects are */ /* accounted for in the aberration corrections applied */ /* by this routine. */ /* Case and blanks are not significant in the string */ /* ABCORR. */ /* STOBS is the geometric (uncorrected) state of the observer */ /* relative to the solar system barycenter at epoch ET. */ /* STOBS is a 6-vector: the first three components of */ /* STOBS represent a Cartesian position vector; the last */ /* three components represent the corresponding velocity */ /* vector. STOBS is expressed relative to the inertial */ /* reference frame designated by REF. */ /* Units are always km and km/sec. */ /* $ Detailed_Output */ /* STARG is a Cartesian state vector representing the position */ /* and velocity of the target body relative to the */ /* specified observer. STARG is corrected for the */ /* specified aberration, and is expressed with respect */ /* to the specified inertial reference frame. The first */ /* three components of STARG represent the x-, y- and */ /* z-components of the target's position; last three */ /* components form the corresponding velocity vector. */ /* The position component of STARG points from the */ /* observer's location at ET to the aberration-corrected */ /* location of the target. Note that the sense of the */ /* position vector is independent of the direction of */ /* radiation travel implied by the aberration */ /* correction. */ /* Units are always km and km/sec. */ /* LT is the one-way light time between the observer and */ /* target in seconds. If the target state is corrected */ /* for light time, then LT is the one-way light time */ /* between the observer and the light time-corrected */ /* target location. */ /* DLT is the derivative with respect to barycentric */ /* dynamical time of the one way light time between */ /* target and observer: */ /* DLT = d(LT)/d(ET) */ /* DLT can also be described as the rate of change of */ /* one way light time. DLT is unitless, since LT and */ /* ET both have units of TDB seconds. */ /* If the observer and target are at the same position, */ /* then DLT is set to zero. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) For the convenience of the caller, the input aberration */ /* correction flag can call for stellar aberration correction via */ /* inclusion of the '+S' suffix. This portion of the aberration */ /* correction flag is ignored if present. */ /* 2) If the value of ABCORR is not recognized, the error */ /* is diagnosed by a routine in the call tree of this */ /* routine. */ /* 3) If the reference frame requested is not a recognized */ /* inertial reference frame, the error SPICE(BADFRAME) */ /* is signaled. */ /* 4) If the state of the target relative to the solar system */ /* barycenter cannot be computed, the error will be diagnosed */ /* by routines in the call tree of this routine. */ /* 5) If the observer and target are at the same position, */ /* then DLT is set to zero. This situation could arise, */ /* for example, when the observer is Mars and the target */ /* is the Mars barycenter. */ /* 6) If a division by zero error would occur in the computation */ /* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */ /* $ Files */ /* This routine computes states using SPK files that have been */ /* loaded into the SPICE system, normally via the kernel loading */ /* interface routine FURNSH. Application programs typically load */ /* kernels once before this routine is called, for example during */ /* program initialization; kernels need not be loaded repeatedly. */ /* See the routine FURNSH and the SPK and KERNEL Required Reading */ /* for further information on loading (and unloading) kernels. */ /* If any of the ephemeris data used to compute STARG are expressed */ /* relative to a non-inertial frame in the SPK files providing those */ /* data, additional kernels may be needed to enable the reference */ /* frame transformations required to compute the state. Normally */ /* these additional kernels are PCK files or frame kernels. Any */ /* such kernels must already be loaded at the time this routine is */ /* called. */ /* $ Particulars */ /* This routine supports higher-level SPK API routines that can */ /* perform both light time and stellar aberration corrections. */ /* User applications normally will not need to call this routine */ /* directly. */ /* See the header of the routine SPKEZR for a detailed discussion */ /* of aberration corrections. */ /* $ Examples */ /* The numerical results shown for this example may differ across */ /* platforms. The results depend on the SPICE kernels used as */ /* input, the compiler and supporting libraries, and the machine */ /* specific arithmetic implementation. */ /* 1) Look up a sequence of states of the Moon as seen from the */ /* Earth. Use light time corrections. Compute the first state for */ /* the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at */ /* intervals of 1 hour. For each epoch, display the states, the */ /* one way light time between target and observer, and the rate of */ /* change of the one way light time. */ /* Use the following meta-kernel to specify the kernels to */ /* load: */ /* KPL/MK */ /* File name: spkltc.tm */ /* This meta-kernel is intended to support operation of SPICE */ /* example programs. The kernels shown here should not be */ /* assumed to contain adequate or correct versions of data */ /* required by SPICE-based user applications. */ /* In order for an application to use this meta-kernel, the */ /* kernels referenced here must be present in the user's */ /* current working directory. */ /* \begindata */ /* KERNELS_TO_LOAD = ( 'de421.bsp', */ /* 'pck00010.tpc', */ /* 'naif0010.tls' ) */ /* \begintext */ /* The code example follows: */ /* PROGRAM EX1 */ /* IMPLICIT NONE */ /* C */ /* C Local constants */ /* C */ /* C The meta-kernel name shown here refers to a file whose */ /* C contents are those shown above. This file and the kernels */ /* C it references must exist in your current working directory. */ /* C */ /* CHARACTER*(*) META */ /* PARAMETER ( META = 'spkltc.tm' ) */ /* C */ /* C Use a time step of 1 hour; look up 5 states. */ /* C */ /* DOUBLE PRECISION STEP */ /* PARAMETER ( STEP = 3600.0D0 ) */ /* INTEGER MAXITR */ /* PARAMETER ( MAXITR = 5 ) */ /* C */ /* C Local variables */ /* C */ /* DOUBLE PRECISION DLT */ /* DOUBLE PRECISION ET */ /* DOUBLE PRECISION ET0 */ /* DOUBLE PRECISION LT */ /* DOUBLE PRECISION STATE ( 6 ) */ /* DOUBLE PRECISION STOBS ( 6 ) */ /* INTEGER I */ /* C */ /* C Load the SPK and LSK kernels via the meta-kernel. */ /* C */ /* CALL FURNSH ( META ) */ /* C */ /* C Convert the start time to seconds past J2000 TDB. */ /* C */ /* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ /* C */ /* C Step through a series of epochs, looking up a */ /* C state vector at each one. */ /* C */ /* DO I = 1, MAXITR */ /* ET = ET0 + (I-1)*STEP */ /* C */ /* C Look up a state vector at epoch ET using the */ /* C following inputs: */ /* C */ /* C Target: Moon (NAIF ID code 301) */ /* C Reference frame: J2000 */ /* C Aberration correction: Light time ('LT') */ /* C Observer: Earth (NAIF ID code 399) */ /* C */ /* C Before we can execute this computation, we'll need the */ /* C geometric state of the observer relative to the solar */ /* C system barycenter at ET, expressed relative to the */ /* C J2000 reference frame: */ /* C */ /* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ /* C */ /* C Now compute the desired state vector: */ /* C */ /* CALL SPKLTC ( 301, ET, 'J2000', 'LT', */ /* . STOBS, STATE, LT, DLT ) */ /* WRITE (*,*) 'ET = ', ET */ /* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ /* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ /* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ /* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ /* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ /* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ /* WRITE (*,*) 'One-way light time (s): ', LT */ /* WRITE (*,*) 'Light time rate: ', DLT */ /* WRITE (*,*) ' ' */ /* END DO */ /* END */ /* On a PC/Linux/gfortran platform, the following output was */ /* produced: */ /* ET = 0.0000000000000000 */ /* J2000 x-position (km): -291569.26541282982 */ /* J2000 y-position (km): -266709.18647825718 */ /* J2000 z-position (km): -76099.155118763447 */ /* J2000 x-velocity (km/s): 0.64353061322177041 */ /* J2000 y-velocity (km/s): -0.66608181700820079 */ /* J2000 z-velocity (km/s): -0.30132283179625752 */ /* One-way light time (s): 1.3423106103251679 */ /* Light time rate: 1.07316908698977495E-007 */ /* ET = 3600.0000000000000 */ /* J2000 x-position (km): -289240.78128184378 */ /* J2000 y-position (km): -269096.44087958336 */ /* J2000 z-position (km): -77180.899725757539 */ /* J2000 x-velocity (km/s): 0.65006211520087476 */ /* J2000 y-velocity (km/s): -0.66016273921695667 */ /* J2000 z-velocity (km/s): -0.29964267390571342 */ /* One-way light time (s): 1.3426939548635302 */ /* Light time rate: 1.05652598952224259E-007 */ /* ET = 7200.0000000000000 */ /* J2000 x-position (km): -286888.88736709207 */ /* J2000 y-position (km): -271462.30170547962 */ /* J2000 z-position (km): -78256.555682137609 */ /* J2000 x-velocity (km/s): 0.65653599154284592 */ /* J2000 y-velocity (km/s): -0.65419657680401588 */ /* J2000 z-velocity (km/s): -0.29794027307420823 */ /* One-way light time (s): 1.3430713117337547 */ /* Light time rate: 1.03990456898758609E-007 */ /* ET = 10800.000000000000 */ /* J2000 x-position (km): -284513.79173691198 */ /* J2000 y-position (km): -273806.60031034052 */ /* J2000 z-position (km): -79326.043183274567 */ /* J2000 x-velocity (km/s): 0.66295190054599118 */ /* J2000 y-velocity (km/s): -0.64818380709706158 */ /* J2000 z-velocity (km/s): -0.29621577937090349 */ /* One-way light time (s): 1.3434426890693671 */ /* Light time rate: 1.02330665243423737E-007 */ /* ET = 14400.000000000000 */ /* J2000 x-position (km): -282115.70368389413 */ /* J2000 y-position (km): -276129.16976799071 */ /* J2000 z-position (km): -80389.282965712249 */ /* J2000 x-velocity (km/s): 0.66930950377548726 */ /* J2000 y-velocity (km/s): -0.64212490805688027 */ /* J2000 z-velocity (km/s): -0.29446934336246899 */ /* One-way light time (s): 1.3438080956559786 */ /* Light time rate: 1.00673403630050830E-007 */ /* $ Restrictions */ /* 1) The routine SPKGEO should be used instead of this routine */ /* to compute geometric states. SPKGEO introduces less */ /* round-off error when the observer and target have common */ /* center that is closer to both objects than is the solar */ /* system barycenter. */ /* 2) The kernel files to be used by SPKLTC must be loaded */ /* (normally by the SPICELIB kernel loader FURNSH) before */ /* this routine is called. */ /* 3) Unlike most other SPK state computation routines, this */ /* routine requires that the output state be relative to an */ /* inertial reference frame. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 04-JUL-2014 (NJB) */ /* Discussion of light time corrections was updated. Assertions */ /* that converged light time corrections are unlikely to be */ /* useful were removed. */ /* Last update was 02-MAY-2012 (NJB) */ /* Updated to ensure convergence when CN or XCN light time */ /* corrections are used. The new algorithm also terminates early */ /* (after fewer than three iterations) when convergence is */ /* attained. */ /* Call to ZZPRSCOR was replaced by a call to ZZVALCOR. */ /* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ /* -& */ /* $ Index_Entries */ /* low-level light time correction */ /* light-time corrected state from spk file */ /* get light-time corrected state */ /* -& */ /* $ Revisions */ /* None. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* TOL is the tolerance used for a division-by-zero test */ /* performed prior to computation of DLT. */ /* Convergence limit: */ /* Maximum number of light time iterations for any */ /* aberration correction: */ /* Local variables */ /* Saved variables */ /* Initial values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("SPKLTC", (ftnlen)6); } if (pass1 || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { /* The aberration correction flag differs from the value it */ /* had on the previous call, if any. Analyze the new flag. */ zzvalcor_(abcorr, attblk, abcorr_len); if (failed_()) { chkout_("SPKLTC", (ftnlen)6); return 0; } /* The aberration correction flag is recognized; save it. */ s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); /* Set logical flags indicating the attributes of the requested */ /* correction: */ /* XMIT is .TRUE. when the correction is for transmitted */ /* radiation. */ /* USELT is .TRUE. when any type of light time correction */ /* (normal or converged Newtonian) is specified. */ /* USECN indicates converged Newtonian light time correction. */ /* The above definitions are consistent with those used by */ /* ZZVALCOR. */ xmit = attblk[4]; uselt = attblk[1]; usecn = attblk[3]; usestl = attblk[2]; pass1 = FALSE_; } /* See if the reference frame is a recognized inertial frame. */ irfnum_(ref, &refid, ref_len); if (refid == 0) { setmsg_("The requested frame '#' is not a recognized inertial frame. " , (ftnlen)60); errch_("#", ref, (ftnlen)1, ref_len); sigerr_("SPICE(BADFRAME)", (ftnlen)15); chkout_("SPKLTC", (ftnlen)6); return 0; } /* Find the geometric state of the target body with respect to */ /* the solar system barycenter. Subtract the state of the */ /* observer to get the relative state. Use this to compute the */ /* one-way light time. */ spkgeo_(targ, et, ref, &c__0, ssbtrg, &ssblt, ref_len); if (failed_()) { chkout_("SPKLTC", (ftnlen)6); return 0; } vsubg_(ssbtrg, stobs, &c__6, starg); dist = vnorm_(starg); *lt = dist / clight_(); if (*lt == 0.) { /* This can happen only if the observer and target are at the */ /* same position. We don't consider this an error, but we're not */ /* going to compute the light time derivative. */ *dlt = 0.; chkout_("SPKLTC", (ftnlen)6); return 0; } if (! uselt) { /* This is a special case: we're not using light time */ /* corrections, so the derivative */ /* of light time is just */ /* (1/c) * d(VNORM(STARG))/dt */ *dlt = vdot_(starg, &starg[3]) / (dist * clight_()); /* LT and DLT are both set, so we can return. */ chkout_("SPKLTC", (ftnlen)6); return 0; } /* To correct for light time, find the state of the target body */ /* at the current epoch minus the one-way light time. Note that */ /* the observer remains where it is. */ /* Determine the sign of the light time offset. */ if (xmit) { ltsign = 1; } else { ltsign = -1; } /* Let NUMITR be the number of iterations we'll perform to */ /* compute the light time. */ if (usecn) { numitr = 5; } else { numitr = 1; } i__ = 0; lterr = 1.; while(i__ < numitr && lterr > 1e-17) { /* LT was set either prior to this loop or */ /* during the previous loop iteration. */ epoch = *et + ltsign * *lt; spkgeo_(targ, &epoch, ref, &c__0, ssbtrg, &ssblt, ref_len); if (failed_()) { chkout_("SPKLTC", (ftnlen)6); return 0; } vsubg_(ssbtrg, stobs, &c__6, starg); prvlt = *lt; d__1 = vnorm_(starg) / clight_(); *lt = touchd_(&d__1); /* LTERR is the magnitude of the change between the current */ /* estimate of light time and the previous estimate, relative to */ /* the previous light time corrected epoch. */ /* Computing MAX */ d__3 = 1., d__4 = abs(epoch); d__2 = (d__1 = *lt - prvlt, abs(d__1)) / max(d__3,d__4); lterr = touchd_(&d__2); ++i__; } /* At this point, STARG contains the light time corrected */ /* state of the target relative to the observer. */ /* Compute the derivative of light time with respect */ /* to time: dLT/dt. Below we derive the formula for */ /* this quantity for the reception case. Let */ /* POBS be the position of the observer relative to the */ /* solar system barycenter. */ /* VOBS be the velocity of the observer relative to the */ /* solar system barycenter. */ /* PTARG be the position of the target relative to the */ /* solar system barycenter. */ /* VTARG be the velocity of the target relative to the */ /* solar system barycenter. */ /* S be the sign of the light time correction. S is */ /* negative for the reception case. */ /* The light-time corrected position of the target relative to */ /* the observer at observation time ET, given the one-way */ /* light time LT is: */ /* PTARG(ET+S*LT) - POBS(ET) */ /* The light-time corrected velocity of the target relative to */ /* the observer at observation time ET is */ /* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */ /* We need to compute dLT/dt. Below, we use the facts that, */ /* for a time-dependent vector X(t), */ /* ||X|| = <X,X> ** (1/2) */ /* d(||X||)/dt = (1/2)<X,X>**(-1/2) * 2 * <X,dX/dt> */ /* = <X,X>**(-1/2) * <X,dX/dt> */ /* = <X,dX/dt> / ||X|| */ /* Newtonian light time equation: */ /* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */ /* Differentiate both sides: */ /* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* * < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */ /* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* * ( < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT) - VOBS(ET) > */ /* + < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */ /* Let */ /* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */ /* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */ /* Then */ /* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */ /* which implies */ /* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */ a = 1. / (clight_() * vnorm_(starg)); b = vdot_(starg, &starg[3]); c__ = vdot_(starg, &ssbtrg[3]); /* For physically realistic target velocities, S*C*A cannot equal 1. */ /* We'll check for this case anyway. */ if (ltsign * c__ * a > .99999999989999999) { setmsg_("Target range rate magnitude is approximately the speed of l" "ight. The light time derivative cannot be computed.", (ftnlen) 110); sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); chkout_("SPKLTC", (ftnlen)6); return 0; } /* Compute DLT: the rate of change of light time. */ *dlt = a * b / (1. - ltsign * c__ * a); /* Overwrite the velocity portion of the output state */ /* with the light-time corrected velocity. */ d__1 = ltsign * *dlt + 1.; vlcom_(&d__1, &ssbtrg[3], &c_b19, &stobs[3], &starg[3]); chkout_("SPKLTC", (ftnlen)6); return 0; } /* spkltc_ */
/* $Procedure REFCHG (Reference frame Change) */ /* Subroutine */ int refchg_(integer *frame1, integer *frame2, doublereal *et, doublereal *rotate) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5, i__6, i__7; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ integer node; logical done; integer cent, this__; extern /* Subroutine */ int zznofcon_(doublereal *, integer *, integer *, integer *, integer *, char *, ftnlen); integer i__, j, frame[10]; extern /* Subroutine */ int chkin_(char *, ftnlen), ident_(doublereal *); integer class__; logical found; integer relto; extern /* Subroutine */ int xpose_(doublereal *, doublereal *), zzrxr_( doublereal *, integer *, doublereal *); extern logical failed_(void); integer cmnode; extern integer isrchi_(integer *, integer *, integer *); integer clssid; extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, integer *, logical *); logical gotone; char errmsg[1840]; extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), rotget_(integer *, doublereal *, doublereal *, integer *, logical *); extern logical return_(void); doublereal tmprot[9] /* was [3][3] */; integer inc, get; doublereal rot[126] /* was [3][3][14] */; integer put; doublereal rot2[18] /* was [3][3][2] */; /* $ Abstract */ /* Return the transformation matrix from one */ /* frame to another. */ /* $ 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 */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include File: SPICELIB Error Handling Parameters */ /* errhnd.inc Version 2 18-JUN-1997 (WLT) */ /* The size of the long error message was */ /* reduced from 25*80 to 23*80 so that it */ /* will be accepted by the Microsoft Power Station */ /* FORTRAN compiler which has an upper bound */ /* of 1900 for the length of a character string. */ /* errhnd.inc Version 1 29-JUL-1997 (NJB) */ /* Maximum length of the long error message: */ /* Maximum length of the short error message: */ /* End Include File: SPICELIB Error Handling Parameters */ /* $ Abstract */ /* The parameters below form an enumerated list of the recognized */ /* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */ /* are outlined below. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Parameters */ /* INERTL an inertial frame that is listed in the routine */ /* CHGIRF and that requires no external file to */ /* compute the transformation from or to any other */ /* inertial frame. */ /* PCK is a frame that is specified relative to some */ /* INERTL frame and that has an IAU model that */ /* may be retrieved from the PCK system via a call */ /* to the routine TISBOD. */ /* CK is a frame defined by a C-kernel. */ /* TK is a "text kernel" frame. These frames are offset */ /* from their associated "relative" frames by a */ /* constant rotation. */ /* DYN is a "dynamic" frame. These currently are */ /* parameterized, built-in frames where the full frame */ /* definition depends on parameters supplied via a */ /* frame kernel. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */ /* The parameter DYN was added to support the dynamic frame class. */ /* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */ /* Various unused frames types were removed and the */ /* frame time TK was added. */ /* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */ /* -& */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* FRAME1 I the frame id-code for some reference frame */ /* FRAME2 I the frame id-code for some reference frame */ /* ET I an epoch in TDB seconds past J2000. */ /* ROTATE O a rotation matrix */ /* $ Detailed_Input */ /* FRAME1 is the frame id-code in which some positions */ /* are known. */ /* FRAME2 is the frame id-code for some frame in which you */ /* would like to represent positions. */ /* ET is the epoch at which to compute the transformation */ /* matrix. This epoch should be in TDB seconds past */ /* the ephemeris epoch of J2000. */ /* $ Detailed_Output */ /* ROTATE is a 3 x 3 rotaion matrix that can be used to */ /* transform positions relative to the frame */ /* correspsonding to frame FRAME2 to positions relative */ /* to the frame FRAME2. More explicitely, if POS is */ /* the position of some object relative to the */ /* reference frame of FRAME1 then POS2 is the position */ /* of the same object relative to FRAME2 where POS2 is */ /* computed via the subroutine call below */ /* CALL MXV ( ROTATE, POS, POS2 ) */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If either of the reference frames is unrecognized, the error */ /* SPICE(UNKNOWNFRAME) will be signalled. */ /* 2) If the auxillary information needed to compute a non-inertial */ /* frame is not available an error will be diagnosed and signalled */ /* by a routine in the call tree of this routine. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine allows you to compute the rotation matrix */ /* between two reference frames. */ /* $ Examples */ /* Suppose that you have a position POS1 at epoch ET */ /* relative to FRAME1 and wish to determine its representation */ /* POS2 relative to FRAME2. The following subroutine calls */ /* would suffice to make this rotation. */ /* CALL REFCHG ( FRAME1, FRAME2, ET, ROTATE ) */ /* CALL MXV ( ROTATE, POS1, POS2 ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */ /* Upgraded long error message associated with frame */ /* connection failure. */ /* - SPICELIB Version 1.2.0, 26-APR-2004 (NJB) */ /* Another typo was corrected in the long error message, and */ /* in a comment. */ /* - SPICELIB Version 1.1.0, 23-MAY-2000 (WLT) */ /* A typo was corrected in the long error message. */ /* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */ /* -& */ /* $ Index_Entries */ /* Rotate positions from one frame to another */ /* -& */ /* SPICE functions */ /* Local Paramters */ /* The root of all reference frames is J2000 (Frame ID = 1). */ /* Local Variables */ /* ROT contains the rotations from FRAME1 to FRAME2 */ /* ROT(1...3,1...3,I) has the rotation from FRAME(I) */ /* to FRAME(I+1). We make extra room in ROT because we */ /* plan to add rotations beyond the obvious chain from */ /* FRAME1 to a root node. */ /* ROT2 is used to store intermediate rotation from */ /* FRAME2 to some node in the chain from FRAME1 to PCK or */ /* INERTL frames. */ /* FRAME contains the frames we transform from in going from */ /* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */ /* NODE counts the number of rotations needed to go */ /* from FRAME1 to FRAME2. */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("REFCHG", (ftnlen)6); /* Do the obvious thing first. If FRAME1 and FRAME2 are the */ /* same then we simply return the identity matrix. */ if (*frame1 == *frame2) { ident_(rotate); chkout_("REFCHG", (ftnlen)6); return 0; } /* Now perform the obvious check to make sure that both */ /* frames are recognized. */ frinfo_(frame1, ¢, &class__, &clssid, &found); if (! found) { setmsg_("The number # is not a recognized id-code for a reference fr" "ame. ", (ftnlen)64); errint_("#", frame1, (ftnlen)1); sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); chkout_("REFCHG", (ftnlen)6); return 0; } frinfo_(frame2, ¢, &class__, &clssid, &found); if (! found) { setmsg_("The number # is not a recognized id-code for a reference fr" "ame. ", (ftnlen)64); errint_("#", frame2, (ftnlen)1); sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); chkout_("REFCHG", (ftnlen)6); return 0; } node = 1; frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, "refchg_", (ftnlen)287)] = *frame1; found = TRUE_; /* Follow the chain of rotations until we run into */ /* one that rotates to J2000 (frame id = 1) or we hit FRAME2. */ while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, "refchg_", (ftnlen)293)] != 1 && node < 10 && frame[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "refc" "hg_", (ftnlen)293)] != *frame2 && found) { /* Find out what rotation is available for this */ /* frame. */ rotget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "frame", i__1, "refchg_", (ftnlen)301)], et, &rot[(i__2 = ( node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( "rot", i__2, "refchg_", (ftnlen)301)], &frame[(i__3 = node) < 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "refchg_", ( ftnlen)301)], &found); if (found) { /* We found a rotation matrix. ROT(1,1,NODE) */ /* now contains the rotation from FRAME(NODE) */ /* to FRAME(NODE+1). We need to look up the information */ /* for the next NODE. */ ++node; } } done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, "refchg_", (ftnlen)317)] == 1 || frame[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "refchg_", (ftnlen) 317)] == *frame2 || ! found; while(! done) { /* The only way to get to this point is to have run out of */ /* room in the array of reference frame rotation */ /* buffers. We will now build the rotation from */ /* the previous NODE to whatever the next node in the */ /* chain is. We'll do this until we get to one of the */ /* root classes or we run into FRAME2. */ rotget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "frame", i__1, "refchg_", (ftnlen)331)], et, &rot[(i__2 = ( node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( "rot", i__2, "refchg_", (ftnlen)331)], &relto, &found); if (found) { /* Recall that ROT(1,1,NODE-1) contains the rotation */ /* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */ /* FRAME(NODE) with the frame indicated by RELTO. This means */ /* that ROT(1,1,NODE-1) should be replaced with the */ /* rotation from FRAME(NODE) to RELTO. */ frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, "refchg_", (ftnlen)342)] = relto; zzrxr_(&rot[(i__1 = ((node - 1) * 3 + 1) * 3 - 12) < 126 && 0 <= i__1 ? i__1 : s_rnge("rot", i__1, "refchg_", (ftnlen)343)] , &c__2, tmprot); for (i__ = 1; i__ <= 3; ++i__) { for (j = 1; j <= 3; ++j) { rot[(i__1 = i__ + (j + (node - 1) * 3) * 3 - 13) < 126 && 0 <= i__1 ? i__1 : s_rnge("rot", i__1, "refchg_", (ftnlen)347)] = tmprot[(i__2 = i__ + j * 3 - 4) < 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", i__2, "refchg_", (ftnlen)347)]; } } } /* We are done if the class of the last frame is J2000 */ /* or if the last frame is FRAME2 or if we simply couldn't get */ /* another rotation. */ done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge( "frame", i__1, "refchg_", (ftnlen)357)] == 1 || frame[(i__2 = node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "refchg_", (ftnlen)357)] == *frame2 || ! found; } /* Right now we have the following situation. We have in hand */ /* a collection of rotations between frames. (Assuming */ /* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */ /* no rotations computed yet. */ /* ROT(1...3, 1...3, 1 ) rotates FRAME1 to FRAME(2) */ /* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ /* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ /* . */ /* . */ /* . */ /* ROT(1...3, 1...3, NODE-1 ) rotates FRAME(NODE-1) */ /* to FRAME(NODE) */ /* One of the following situations is true. */ /* 1) FRAME(NODE) is the root of all frames, J2000. */ /* 2) FRAME(NODE) is the same as FRAME2 */ /* 3) There is no rotation from FRAME(NODE) to another */ /* more fundamental frame. The chain of rotations */ /* from FRAME1 stops at FRAME(NODE). This means that the */ /* "frame atlas" is incomplete because we can't get to the */ /* root frame. */ /* We now have to do essentially the same thing for FRAME2. */ if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, "refchg_", (ftnlen)395)] == *frame2) { /* We can handle this one immediately with the private routine */ /* ZZRXR which multiplies a series of matrices. */ i__1 = node - 1; zzrxr_(rot, &i__1, rotate); chkout_("REFCHG", (ftnlen)6); return 0; } /* We didn't luck out above. So we follow the chain of */ /* rotation for FRAME2. Note that at the moment the */ /* chain of rotations from FRAME2 to other frames */ /* does not share a node in the chain for FRAME1. */ /* ( GOTONE = .FALSE. ) . */ this__ = *frame2; gotone = FALSE_; /* First see if there is any chain to follow. */ done = this__ == 1; /* Set up the matrices ROT2(,,1) and ROT(,,2) and set up */ /* PUT and GET pointers so that we know where to GET the partial */ /* rotation from and where to PUT partial results. */ if (! done) { put = 1; get = 1; inc = 1; } /* Follow the chain of rotations until we run into */ /* one that rotates to the root frame or we land in the */ /* chain of nodes for FRAME1. */ /* Note that this time we will simply keep track of the full */ /* rotation from FRAME2 to the last node. */ while(! done) { /* Find out what rotation is available for this */ /* frame. */ if (this__ == *frame2) { /* This is the first pass, just put the rotation */ /* directly into ROT2(,,PUT). */ rotget_(&this__, et, &rot2[(i__1 = (put * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : s_rnge("rot2", i__1, "refchg_", ( ftnlen)452)], &relto, &found); if (found) { this__ = relto; get = put; put += inc; inc = -inc; cmnode = isrchi_(&this__, &node, frame); gotone = cmnode > 0; } } else { /* Fetch the rotation into a temporary spot TMPROT */ rotget_(&this__, et, tmprot, &relto, &found); if (found) { /* Next multiply TMPROT on the right by the last partial */ /* product (in ROT2(,,GET) ). We do this in line. */ for (i__ = 1; i__ <= 3; ++i__) { for (j = 1; j <= 3; ++j) { rot2[(i__1 = i__ + (j + put * 3) * 3 - 13) < 18 && 0 <= i__1 ? i__1 : s_rnge("rot2", i__1, "refch" "g_", (ftnlen)478)] = tmprot[(i__2 = i__ - 1) < 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", i__2, "refchg_", (ftnlen)478)] * rot2[(i__3 = (j + get * 3) * 3 - 12) < 18 && 0 <= i__3 ? i__3 : s_rnge("rot2", i__3, "refchg_", ( ftnlen)478)] + tmprot[(i__4 = i__ + 2) < 9 && 0 <= i__4 ? i__4 : s_rnge("tmprot", i__4, "refchg_", (ftnlen)478)] * rot2[(i__5 = (j + get * 3) * 3 - 11) < 18 && 0 <= i__5 ? i__5 : s_rnge("rot2", i__5, "refchg_", (ftnlen)478)] + tmprot[(i__6 = i__ + 5) < 9 && 0 <= i__6 ? i__6 : s_rnge("tmprot", i__6, "refchg_", ( ftnlen)478)] * rot2[(i__7 = (j + get * 3) * 3 - 10) < 18 && 0 <= i__7 ? i__7 : s_rnge("rot2" , i__7, "refchg_", (ftnlen)478)]; } } /* Adjust GET and PUT so that GET points to the slots */ /* where we just stored the result of our multiply and */ /* so that PUT points to the next available storage */ /* locations. */ get = put; put += inc; inc = -inc; this__ = relto; cmnode = isrchi_(&this__, &node, frame); gotone = cmnode > 0; } } /* See if we have a common node and determine whether or not */ /* we are done with this loop. */ done = this__ == 1 || gotone || ! found; } /* There are two possible scenarios. Either the chain of */ /* rotations from FRAME2 ran into a node in the chain for */ /* FRAME1 or it didn't. (The common node might very well be */ /* the root node.) If we didn't run into a common one, then */ /* the two chains don't intersect and there is no way to */ /* get from FRAME1 to FRAME2. */ if (! gotone) { zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1, "refchg_", (ftnlen)525)], frame2, &this__, errmsg, (ftnlen)1840); if (failed_()) { /* We were unable to create the error message. This */ /* unfortunate situation could arise if a frame kernel */ /* is corrupted. */ chkout_("REFCHG", (ftnlen)6); return 0; } /* The normal case: signal an error with a descriptive long */ /* error message. */ setmsg_(errmsg, (ftnlen)1840); sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21); chkout_("REFCHG", (ftnlen)6); return 0; } /* Recall that we have the following. */ /* ROT(1...3, 1...3, 1 ) rotates FRAME(1) to FRAME(2) */ /* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */ /* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */ /* ROT(1...3, 1...3, CMNODE-1) rotates FRAME(CMNODE-1) */ /* to FRAME(CMNODE) */ /* and that ROT2(1,1,GET) rotates from FRAME2 to CMNODE. */ /* Hence the inverse of ROT2(1,1,GET) rotates from CMNODE */ /* to FRAME2. */ /* If we compute the inverse of ROT2 and store it in */ /* the next available slot of ROT (.i.e. ROT(1,1,CMNODE) */ /* we can simply apply our custom routine that multiplies a */ /* sequence of rotation matrices together to get the */ /* result from FRAME1 to FRAME2. */ xpose_(&rot2[(i__1 = (get * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 : s_rnge("rot2", i__1, "refchg_", (ftnlen)568)], &rot[(i__2 = ( cmnode * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge( "rot", i__2, "refchg_", (ftnlen)568)]); zzrxr_(rot, &cmnode, rotate); chkout_("REFCHG", (ftnlen)6); return 0; } /* refchg_ */
/* $Procedure ZZEKUE02 ( EK, update column entry, class 2 ) */ /* Subroutine */ int zzekue02_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, doublereal *dval, logical *isnull) { /* System generated locals */ integer i__1; /* Local variables */ extern /* Subroutine */ int zzekiid1_(integer *, integer *, integer *, doublereal *, integer *, logical *); extern integer zzekrp2n_(integer *, integer *, integer *); integer unit; extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), zzekglnk_(integer *, integer *, integer *, integer *), zzekpgpg_( integer *, integer *, integer *, integer *), zzekixdl_(integer *, integer *, integer *, integer *), zzekslnk_(integer *, integer *, integer *, integer *); integer p, pbase; extern /* Subroutine */ int chkin_(char *, ftnlen); integer recno, ncols; extern logical failed_(void); extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, integer *), dasudi_(integer *, integer *, integer *, integer *); extern logical return_(void); integer datptr, idxtyp, nlinks, ptrloc; extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), dasudd_(integer *, integer *, integer *, doublereal *), dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen), zzekad02_(integer *, integer *, integer *, integer *, doublereal *, logical *); /* $ Abstract */ /* Update a specified class 2 column entry in an EK record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* PRIVATE */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Record pointer. */ /* DVAL I Double precision value. */ /* ISNULL I Null flag. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* SEGDSC is the descriptor of the segment containing */ /* the specified column entry. */ /* COLDSC is the descriptor of the column containing */ /* the specified column entry. */ /* RECPTR is a pointer to the record containing the column */ /* entry to update. */ /* DVAL is the double precision value with which to update */ /* the specified column entry. */ /* ISNULL is a logical flag indicating whether the value */ /* of the specified column entry is to be set to NULL. */ /* If so, the input DVAL is ignored. */ /* $ Detailed_Output */ /* None. See the $Particulars section for a description of the */ /* effect of this routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. The file will not be modified. */ /* 2) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. The file may be corrupted. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: it updates a column entry */ /* in an EK segment. This routine does not participate in shadowing */ /* functions. If the target EK is shadowed, the caller is */ /* responsible for performing necessary backup operations. If the */ /* target EK is not shadowed, the target record's status is not */ /* modified. */ /* If the column containing the entry is indexed, the corresponding */ /* index is updated. */ /* The changes made by this routine to the target EK file become */ /* permanent when the file is closed. Failure to close the file */ /* properly will leave it in an indeterminate state. */ /* $ Examples */ /* See EKUCED. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */ /* Removed redundant calls to CHKIN. */ /* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKUE02", (ftnlen)8); } /* Is this file handle valid--is the file open for paged write */ /* access? Signal an error if not. */ zzekpgch_(handle, "WRITE", (ftnlen)5); if (failed_()) { chkout_("ZZEKUE02", (ftnlen)8); return 0; } /* We'll need to know how many columns the segment has in order to */ /* compute the size of the record pointer. The record pointer */ /* contains DPTBAS items plus two elements for each column. */ ncols = segdsc[4]; /* Compute the data pointer location. */ ptrloc = *recptr + 2 + coldsc[8]; dasrdi_(handle, &ptrloc, &ptrloc, &datptr); if (datptr > 0) { /* The column entry is non-null. Determine whether the column is */ /* indexed. */ idxtyp = coldsc[5]; if (idxtyp == 1) { /* The column has a type 1 index. Delete the index entry */ /* for this column. Create an index entry for the new value. */ zzekixdl_(handle, segdsc, coldsc, recptr); zzekiid1_(handle, segdsc, coldsc, dval, recptr, isnull); } else if (idxtyp != -1) { setmsg_("Column having index # in segment # has index type #.", ( ftnlen)52); errint_("#", &coldsc[8], (ftnlen)1); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &idxtyp, (ftnlen)1); sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); chkout_("ZZEKUE02", (ftnlen)8); return 0; } /* If the new value is null, set the data pointer to indicate a */ /* null value. Otherwise, overwrite the old value with the new */ /* one. */ if (*isnull) { /* The data location used by the previous value is no longer */ /* needed, so we have one less link to this page. */ zzekpgpg_(&c__2, &datptr, &p, &pbase); zzekglnk_(handle, &c__2, &p, &nlinks); i__1 = nlinks - 1; zzekslnk_(handle, &c__2, &p, &i__1); dasudi_(handle, &ptrloc, &ptrloc, &c_n2); } else { /* No link counts change; we just have a new value. */ dasudd_(handle, &datptr, &datptr, dval); } } else if (datptr == -2) { /* If the new entry is null too, there's nothing to do. */ /* We don't have to adjust link counts or indexes. */ /* If the new entry is non-null, we must add a new column entry, */ /* since no space was reserved for the old one. The column */ /* index entry must be cleaned up, if the column is indexed. */ if (! (*isnull)) { idxtyp = coldsc[5]; if (idxtyp == 1) { /* The column has a type 1 index. Delete the index entry */ /* for this column. */ zzekixdl_(handle, segdsc, coldsc, recptr); } else if (idxtyp != -1) { setmsg_("Column having index # in segment # has index type #." , (ftnlen)52); errint_("#", &coldsc[8], (ftnlen)1); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &idxtyp, (ftnlen)1); sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); chkout_("ZZEKUE02", (ftnlen)8); return 0; } /* We don't need to decrement the link count for this page. */ /* Just add the new value to the column. But first, set the */ /* data pointer to indicate an uninitialized value, so the */ /* data addition routine doesn't choke. */ dasudi_(handle, &ptrloc, &ptrloc, &c_n1); zzekad02_(handle, segdsc, coldsc, recptr, dval, isnull); } } else if (datptr == -1 || datptr == -3) { /* There is no current column entry. Just add a new entry. */ zzekad02_(handle, segdsc, coldsc, recptr, dval, isnull); } else { /* The data pointer is corrupted. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " "#; EK = #", (ftnlen)68); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &coldsc[8], (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKUE02", (ftnlen)8); return 0; } chkout_("ZZEKUE02", (ftnlen)8); return 0; } /* zzekue02_ */
/* $Procedure SCENCD ( Encode spacecraft clock ) */ /* Subroutine */ int scencd_(integer *sc, char *sclkch, doublereal *sclkdp, ftnlen sclkch_len) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; doublereal d__1; /* Builtin functions */ double d_nint(doublereal *); integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); integer part, i__; extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); doublereal ticks; integer pnter; char error[25]; doublereal pstop[9999]; extern logical failed_(void); extern /* Subroutine */ int sigerr_(char *, ftnlen), scpart_(integer *, integer *, doublereal *, doublereal *), chkout_(char *, ftnlen), nparsi_(char *, integer *, char *, integer *, ftnlen, ftnlen), sctiks_(integer *, char *, doublereal *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); integer nparts; doublereal pstart[9999]; extern logical return_(void); doublereal ptotls[9999]; integer pos; /* $ Abstract */ /* Encode character representation of spacecraft clock time into a */ /* double precision number. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SCLK */ /* $ Keywords */ /* CONVERSION */ /* TIME */ /* $ Declarations */ /* $ Abstract */ /* Include file sclk.inc */ /* SPICE private file intended solely for the support of SPICE */ /* routines. Users should not include this file directly due */ /* to the volatile nature of this file */ /* The parameters below define sizes and limits used by */ /* the SCLK system. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Parameters */ /* See the declaration section below. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ /* Increased value of maximum coefficient record count */ /* parameter MXCOEF from 10K to 50K. */ /* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ /* -& */ /* Number of supported SCLK field delimiters: */ /* Supported SCLK string field delimiters: */ /* Maximum number of partitions: */ /* Partition string length. */ /* Since the maximum number of partitions is given by MXPART is */ /* 9999, PRTSTR needs at most 4 characters for the partition number */ /* and one character for the slash. */ /* Maximum number of coefficient records: */ /* Maximum number of fields in an SCLK string: */ /* Length of strings used to represent D.P. */ /* numbers: */ /* Maximum number of supported parallel time systems: */ /* End of include file sclk.inc */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* SC I NAIF spacecraft identification code. */ /* SCLKCH I Character representation of a spacecraft clock. */ /* SCLKDP O Encoded representation of the clock count. */ /* MXPART P Maximum number of spacecraft clock partitions. */ /* $ Detailed_Input */ /* SC is the standard NAIF ID of the spacecraft whose clock's */ /* time is being encoded. */ /* SCLKCH is the character representation of some spacecraft's */ /* clock count. */ /* SCLKCH will have the following general format: */ /* 'pp/sclk_string', or just */ /* 'sclk_string' */ /* 'pp' is an integer greater than or equal to one */ /* and is called the partition number. */ /* Each mission is divided into some number of partitions. */ /* A new partition starts when the spacecraft clock */ /* resets, either to zero, or to some other */ /* value. Thus, the first partition for any mission */ /* starts with launch, and ends with the first clock */ /* reset. The second partition starts immediately when */ /* the first stopped, and so on. */ /* In order to be completely unambiguous about a */ /* particular time, you need to specify a partition number */ /* along with the standard clock string. */ /* Information about when partitions occur for different */ /* missions is contained in a spacecraft clock kernel */ /* file, which needs to be loaded into the kernel pool, */ /* using the routines CLPOOL and FURNSH. */ /* The routine SCPART is used to read the partition */ /* start and stop times, in encoded units of SCLK (called */ /* "ticks" -- see SCLKDP below) from the kernel file. */ /* If the partition number is included, it must be */ /* separated from the rest of the string by a '/'. */ /* Any number of spaces may separate the partition number, */ /* the '/', and the rest of the clock string. */ /* If the partition number is omitted, a default partition */ /* will be assumed. The default partition is the lowest- */ /* numbered partition that contains the given clock time. */ /* If the clock time does not fall in any of the */ /* partition boundaries then an error is signaled. */ /* 'sclk_string' is a spacecraft specific clock string. */ /* Using Galileo as an example, the full format is */ /* wwwwwwww:xx:y:z */ /* where z is a mod-8 counter (values 0-7) which */ /* increments approximately once every 8 1/3 ms., y is a */ /* mod-10 counter (values 0-9) which increments once */ /* every time z turns over, i.e., approximately once every */ /* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */ /* which increments once every time y turns over, i.e., */ /* once every 2/3 seconds. wwwwwwww is the Real-Time Image */ /* Count (RIM), which increments once every time xx turns */ /* over, i.e., once every 60 2/3 seconds. The roll-over */ /* expression for the RIM is 16777215, which corresponds */ /* to approximately 32 years. */ /* wwwwwwww, xx, y, and z are referred to interchangeably */ /* as the fields or components of the spacecraft clock. */ /* SCLK components may be separated by any of these */ /* five characters: ' ' ':' ',' '-' '.' */ /* Any number of spaces can separate the components and */ /* the delimiters. The presence of the RIM component */ /* is required. Successive components may be omitted, and */ /* in such cases are assumed to represent zero values. */ /* Values for the individual components may exceed the */ /* maximum expected values. For instance, '0:0:0:9' is */ /* an acceptable Galileo clock string, and will convert */ /* to the same number of ticks as '0:0:1:1'. */ /* Consecutive delimiters containing no intervening digits */ /* are treated as if they delimit zero components. */ /* Trailing zeros should always be included to match the */ /* length of the counter. For example, a Galileo clock */ /* count of '25684.90' should not be represented as */ /* '25684.9'. */ /* Some spacecraft clock components have offset, or */ /* starting, values different from zero. For example, */ /* with an offset value of 1, a mod 20 counter would */ /* cycle from 1 to 20 instead of from 0 to 19. */ /* See the SCLK required reading for a detailed */ /* description of the Voyager and Mars Observer clock */ /* formats. */ /* $ Detailed_Output */ /* SCLKDP is the double precision encoding of SCLKCH. */ /* The encoding is such that order and proximity will be */ /* preserved. That is, if t1, t2, and t3 are spacecraft */ /* clock times, and t1*, t2*, and t3* are their encodings, */ /* then if */ /* t1 < t2 < t3, and */ /* t2 is closer to t1 than to t3, you will have the result */ /* that */ /* t1* < t2* < t3*, and */ /* t2* is closer to t1* than to t3*. */ /* The units of encoded SCLK are "ticks since the start of */ /* the mission", where a "tick" is defined to be the */ /* shortest time increment expressible by a particular */ /* spacecraft's clock. */ /* Each clock string without partition number represents */ /* a certain number of ticks, but you need to include */ /* partition information to determine the relative */ /* position of that time in relation to the start of the */ /* mission. */ /* Since the end time of one partition is coincident */ /* with the begin time of the next, there are two */ /* different representations for this instant, and they */ /* will both yield the same encoding. */ /* For example, if partition 1 has an end time of t1, and */ /* partition 2 has a begin time of t2, then if we did */ /* CALL SCENCD ( '1/t1', SC, X ) and */ /* CALL SCENCD ( '2/t2', SC, Y ), then */ /* X = Y. */ /* The individual routines TIKSnn, where nn is the */ /* clock type code, contain more detailed information */ /* on the conversion process. */ /* $ Parameters */ /* MXPART is the maximum number of spacecraft clock partitions */ /* expected in the kernel file for any one spacecraft. */ /* See the INCLUDE file sclk.inc for this parameter's */ /* value. */ /* $ Exceptions */ /* 1) If the number of partitions in the kernel file for spacecraft */ /* SC exceeds the parameter MXPART, the error */ /* 'SPICE(TOOMANYPARTS)' is signaled. */ /* If a partition number is included in the SCLK string, the */ /* following exceptions may occur: */ /* 2) If the partition number cannot be parsed as an integer, the */ /* error 'SPICE(BADPARTNUMBER)' is signaled. */ /* 3) If the partition number is not in the range of the number of */ /* partitions found in the kernel pool, the error */ /* 'SPICE(BADPARTNUMBER)' is signaled. */ /* 4) If the clock count does not fall in the boundaries of the */ /* specified partition, the error 'SPICE(NOTINPART)' is */ /* signaled. */ /* If a partition number is not included in the SCLK string, the */ /* following exception may occur. */ /* 5) If the clock count does not fall in the boundaries of any */ /* partition found in the kernel pool, the error */ /* 'SPICE(NOPARTITION)' is signaled. */ /* The following error is signaled by a routine called by SCENCD */ /* 6) If any of the extracted clock components cannot be parsed as */ /* integers, or the string has too many components, or the value */ /* of one of the components is less than the offset value, then */ /* the error SPICE(INVALIDSCLKSTRING) is signaled. */ /* $ Files */ /* A kernel file containing spacecraft clock partition information */ /* for the desired spacecraft must be loaded, using the routines */ /* CLPOOL and FURNSH, before calling this routine. */ /* $ Particulars */ /* In general, it is difficult to compare spacecraft clock counts */ /* numerically since there are too many clock components for a */ /* single comparison. This routine provides a method of assigning a */ /* single double precision number to a spacecraft's clock count, */ /* given one of its character representations. */ /* The routine SCDECD performs the inverse operation to SCENCD, */ /* converting an encoded double precision number to character format. */ /* To convert the string to ticks since the start of the mission, */ /* SCENCD */ /* 1) Converts the non-partition portion of the string to */ /* ticks, using the routine SCTIKS. */ /* 2) Determines the partition number for the clock time, */ /* either by getting it directly from the input string, or */ /* determining the default partition if none was specified. */ /* 3) Includes partition start and stop times, which are also */ /* measured in ticks, to compute the number of ticks */ /* since the beginning of the mission of the clock time. */ /* $ Examples */ /* Double precision encodings of spacecraft clock counts are used to */ /* tag pointing data in the C-kernel. */ /* In the following example, pointing for a sequence of images from */ /* the Voyager 2 narrow angle camera is requested from the C-kernel */ /* using an array of character spacecraft clock counts as input. */ /* The clock counts attached to the output are then decoded to */ /* character and compared with the input strings. */ /* CHARACTER*(25) SCLKIN ( 4 ) */ /* CHARACTER*(25) SCLKOUT */ /* CHARACTER*(25) CLKTOL */ /* DOUBLE PRECISION TIMEIN */ /* DOUBLE PRECISION TIMOUT */ /* DOUBLE PRECISION CMAT ( 3, 3 ) */ /* INTEGER NPICS */ /* INTEGER SC */ /* DATA NPICS / 4 / */ /* DATA SCLKIN / '2 / 20538:39:768', */ /* . '2 / 20543:21:768', */ /* . '2 / 20550:37', */ /* . '2 / 20561:59' / */ /* DATA CLKTOL / ' 0:01:000' / */ /* C */ /* C The instrument we want pointing for is the Voyager 2 */ /* C narrow angle camera. The reference frame we want is */ /* C J2000. The spacecraft is Voyager 2. */ /* C */ /* INST = -32001 */ /* REF = 'J2000' */ /* SC = -32 */ /* C */ /* C Load the appropriate files. We need */ /* C */ /* C 1) CK file containing pointing data. */ /* C 2) Spacecraft clock kernel file, for SCENCD and SCDECD. */ /* C */ /* CALL CKLPF ( 'VGR2NA.CK' ) */ /* CALL CLPOOL */ /* CALL FURNSH ( 'SCLK.KER' ) */ /* C */ /* C Convert the tolerance string to ticks. */ /* C */ /* CALL SCTIKS ( SC, CLKTOL, TOL ) */ /* DO I = 1, NPICS */ /* CALL SCENCD ( SC, SCLKIN( I ), TIMEIN ) */ /* CALL CKGP ( INST, TIMEIN, TOL, REF, CMAT, TIMOUT, */ /* . FOUND ) */ /* CALL SCDECD ( SC, TIMOUT, SCLKOUT ) */ /* WRITE (*,*) */ /* WRITE (*,*) 'Input s/c clock count: ', SCLKIN( I ) */ /* WRITE (*,*) 'Output s/c clock count: ', SCLKOUT */ /* WRITE (*,*) 'Output C-Matrix: ', CMAT */ /* WRITE (*,*) */ /* END DO */ /* The output from such a program might look like: */ /* Input s/c clock count: 2 / 20538:39:768 */ /* Output s/c clock count: 2/20538:39:768 */ /* Output C-Matrix: 'first C-matrix' */ /* Input s/c clock count: 2 / 20543:21:768 */ /* Output s/c clock count: 2/20543:22:768 */ /* Output C-Matrix: 'second C-matrix' */ /* Input s/c clock count: 2 / 20550:37 */ /* Output s/c clock count: 2/20550:36:768 */ /* Output C-Matrix: 'third C-matrix' */ /* Input s/c clock count: 2 / 20561:59 */ /* Output s/c clock count: 2/20561:58:768 */ /* Output C-Matrix: 'fourth C-matrix' */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* J.M. Lynch (JPL) */ /* R.E. Thurman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.0, 28-FEB-2014 (BVS) */ /* Added FAILED checks to prevent passing uninitialized values to */ /* ANINT, which can causing numeric exceptions on some */ /* environments. */ /* - SPICELIB Version 1.1.0, 05-FEB-2008 (NJB) */ /* The values of the parameter MXPART is now */ /* provided by the INCLUDE file sclk.inc. */ /* - SPICELIB Version 1.0.2, 22-AUG-2006 (EDW) */ /* Replaced references to LDPOOL with references */ /* to FURNSH. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 03-SEP-1990 (JML) (RET) */ /* -& */ /* $ Index_Entries */ /* encode spacecraft_clock */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("SCENCD", (ftnlen)6); } /* Convert the non-partition portion of the clock string to ticks. */ pos = cpos_(sclkch, "/", &c__1, sclkch_len, (ftnlen)1); i__1 = pos; sctiks_(sc, sclkch + i__1, &ticks, sclkch_len - i__1); if (failed_()) { chkout_("SCENCD", (ftnlen)6); return 0; } ticks = d_nint(&ticks); /* Read the partition start and stop times (in ticks) for this */ /* mission. Error if there are too many of them. */ scpart_(sc, &nparts, pstart, pstop); if (failed_()) { chkout_("SCENCD", (ftnlen)6); return 0; } if (nparts > 9999) { setmsg_("The number of partitions, #, for spacecraft # exceeds the v" "alue for parameter MXPART, #.", (ftnlen)88); errint_("#", &nparts, (ftnlen)1); errint_("#", sc, (ftnlen)1); errint_("#", &c__9999, (ftnlen)1); sigerr_("SPICE(TOOMANYPARTS)", (ftnlen)19); chkout_("SCENCD", (ftnlen)6); return 0; } /* PSTART and PSTOP represent integers but are read from the */ /* kernel pool as double precision numbers. Make them whole */ /* numbers so that logical tests may be performed with them. */ i__1 = nparts; for (i__ = 1; i__ <= i__1; ++i__) { pstop[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("pstop", i__2, "scencd_", (ftnlen)500)] = d_nint(&pstop[(i__3 = i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("pstop", i__3, "scenc" "d_", (ftnlen)500)]); pstart[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("pstart", i__2, "scencd_", (ftnlen)501)] = d_nint(&pstart[(i__3 = i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("pstart", i__3, "scen" "cd_", (ftnlen)501)]); } /* For each partition, compute the total number of ticks in that */ /* partition plus all preceding partitions. */ d__1 = pstop[0] - pstart[0]; ptotls[0] = d_nint(&d__1); i__1 = nparts; for (i__ = 2; i__ <= i__1; ++i__) { d__1 = ptotls[(i__3 = i__ - 2) < 9999 && 0 <= i__3 ? i__3 : s_rnge( "ptotls", i__3, "scencd_", (ftnlen)512)] + pstop[(i__4 = i__ - 1) < 9999 && 0 <= i__4 ? i__4 : s_rnge("pstop", i__4, "sce" "ncd_", (ftnlen)512)] - pstart[(i__5 = i__ - 1) < 9999 && 0 <= i__5 ? i__5 : s_rnge("pstart", i__5, "scencd_", (ftnlen)512)]; ptotls[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", i__2, "scencd_", (ftnlen)512)] = d_nint(&d__1); } /* Determine the partition number for the input clock string: */ /* If it was included in the string make sure it's valid for */ /* this mission. */ /* Error if */ /* 1) The partition number can't be parsed. */ /* 2) The partition number is not in the range 1 to the number */ /* of partitions. */ /* 3) The clock count does not fall in the boundaries of the */ /* specified partition. */ /* If it wasn't included, determine the default partition for */ /* this clock count. */ /* Error if */ /* 1) The clock count does not fall in the boundaries of any */ /* of the partitions. */ if (pos == 1) { setmsg_("Unable to parse the partition number from SCLK string #.", ( ftnlen)56); errch_("#", sclkch, (ftnlen)1, sclkch_len); sigerr_("SPICE(BADPARTNUMBER)", (ftnlen)20); chkout_("SCENCD", (ftnlen)6); return 0; } if (pos > 1) { part = 0; nparsi_(sclkch, &part, error, &pnter, pos - 1, (ftnlen)25); if (s_cmp(error, " ", (ftnlen)25, (ftnlen)1) != 0) { setmsg_("Unable to parse the partition number from SCLK string #." , (ftnlen)56); errch_("#", sclkch, (ftnlen)1, sclkch_len); sigerr_("SPICE(BADPARTNUMBER)", (ftnlen)20); chkout_("SCENCD", (ftnlen)6); return 0; } else if (part <= 0 || part > nparts) { setmsg_("Partition number # taken from SCLK string # is not in a" "cceptable range 1 to #.", (ftnlen)78); errint_("#", &part, (ftnlen)1); errch_("#", sclkch, (ftnlen)1, sclkch_len); errint_("#", &nparts, (ftnlen)1); sigerr_("SPICE(BADPARTNUMBER)", (ftnlen)20); chkout_("SCENCD", (ftnlen)6); return 0; } else if (ticks < pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : s_rnge("pstart", i__1, "scencd_", (ftnlen)575)] || ticks > pstop[(i__2 = part - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("pstop", i__2, "scencd_", (ftnlen)575)]) { setmsg_("SCLK count # does not fall in the boundaries of partiti" "on number #.", (ftnlen)67); errch_("#", sclkch, (ftnlen)1, sclkch_len); errint_("#", &part, (ftnlen)1); sigerr_("SPICE(NOTINPART)", (ftnlen)16); chkout_("SCENCD", (ftnlen)6); return 0; } } else { part = 1; while(part <= nparts && (ticks < pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : s_rnge("pstart", i__1, "scencd_", (ftnlen) 592)] || ticks > pstop[(i__2 = part - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("pstop", i__2, "scencd_", (ftnlen)592)])) { ++part; } if (part > nparts) { setmsg_("SCLK count # does not fall in the boundaries of any of " "the partitions for spacecraft #.", (ftnlen)87); errch_("#", sclkch, (ftnlen)1, sclkch_len); errint_("#", sc, (ftnlen)1); sigerr_("SPICE(NOPARTITION)", (ftnlen)18); chkout_("SCENCD", (ftnlen)6); return 0; } } /* Now we have a valid partition number, and the number of ticks for */ /* the clock string. To convert to ticks since the start of the */ /* mission, add in the total number of ticks in preceding partitions */ /* and subtract off the starting ticks value for this partition. */ if (part > 1) { *sclkdp = ticks - pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : s_rnge("pstart", i__1, "scencd_", (ftnlen)622)] + ptotls[( i__2 = part - 2) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls", i__2, "scencd_", (ftnlen)622)]; } else { *sclkdp = ticks - pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : s_rnge("pstart", i__1, "scencd_", (ftnlen)624)]; } chkout_("SCENCD", (ftnlen)6); return 0; } /* scencd_ */
/* $Procedure SPKW19 ( Write SPK segment, type 19 ) */ /* Subroutine */ int spkw19_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *nintvl, integer *npkts, integer *subtps, integer *degres, doublereal *packts, doublereal *epochs, doublereal *ivlbds, logical * sellst, ftnlen frame_len, ftnlen segid_len) { /* Initialized data */ static integer pktszs[2] = { 12,6 }; /* System generated locals */ integer i__1, i__2; doublereal d__1; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ integer isel, ndir, i__, j, k; extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *); doublereal descr[5]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); integer bepix, eepix; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_( doublereal *, integer *); doublereal dc[2]; extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, ftnlen); integer ic[6]; extern /* Subroutine */ int dafena_(void); extern logical failed_(void); integer segbeg, chrcod, refcod, segend, pktbeg; extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); extern integer lastnb_(char *, ftnlen); integer pktend; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); integer minisz; extern logical return_(void); integer pktdsz, winsiz, pktsiz, subtyp; extern logical odd_(integer *); /* $ Abstract */ /* Write a type 19 segment to an SPK file. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAF */ /* NAIF_IDS */ /* SPC */ /* SPK */ /* TIME */ /* $ Keywords */ /* EPHEMERIS */ /* FILES */ /* $ Declarations */ /* $ Abstract */ /* Declare parameters specific to SPK type 19. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPK */ /* $ Keywords */ /* SPK */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* B.V. Semenov (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 07-MAR-2014 (NJB) (BVS) */ /* -& */ /* Maximum polynomial degree supported by the current */ /* implementation of this SPK type. */ /* The degree is compatible with the maximum degrees */ /* supported by types 13 and 21. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* SPK type 19 subtype codes: */ /* Subtype 0: Hermite interpolation, 12-element packets. */ /* Subtype 1: Lagrange interpolation, 6-element packets. */ /* Packet sizes associated with the various subtypes: */ /* Number of subtypes: */ /* Maximum packet size for type 19: */ /* Minimum packet size for type 19: */ /* The SPKPVN record size declared in spkrec.inc must be at least as */ /* large as the maximum possible size of an SPK type 19 record. */ /* The largest possible SPK type 19 record has subtype 1 (note that */ /* records of subtype 0 have half as many epochs as those of subtype */ /* 1, for a given polynomial degree). A type 1 record contains */ /* - The subtype and packet count */ /* - MAXDEG+1 packets of size S19PS1 */ /* - MAXDEG+1 time tags */ /* End of include file spk19.inc. */ /* $ Abstract */ /* Declare SPK data record size. This record is declared in */ /* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */ /* (SPKExx) routines. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPK */ /* $ Keywords */ /* SPK */ /* $ Restrictions */ /* 1) If new SPK types are added, it may be necessary to */ /* increase the size of this record. The header of SPKPVN */ /* should be updated as well to show the record size */ /* requirement for each data type. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 2.0.0, 05-OCT-2012 (NJB) */ /* Updated to support increase of maximum degree to 27 for types */ /* 2, 3, 8, 9, 12, 13, 18, and 19. See SPKPVN for a list */ /* of record size requirements as a function of data type. */ /* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */ /* -& */ /* End include file spkrec.inc */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of an SPK file open for writing. */ /* BODY I NAIF ID code for an ephemeris object. */ /* CENTER I NAIF ID code for center of motion of BODY. */ /* FRAME I Reference frame name. */ /* FIRST I Start time of interval covered by segment. */ /* LAST I End time of interval covered by segment. */ /* SEGID I Segment identifier. */ /* NINTVL I Number of mini-segments and interpolation */ /* intervals. */ /* NPKTS I Array of packet counts of mini-segments. */ /* SUBTPS I Array of segment subtypes of mini-segments. */ /* DEGRES I Array of polynomial degrees of mini-segments. */ /* PACKTS I Array of data packets of mini-segments. */ /* EPOCHS I Array of epochs of mini-segments. */ /* IVLBDS I Interpolation interval bounds. */ /* SELLST I Interval selection flag. */ /* MAXDEG P Maximum allowed degree of interpolating polynomial. */ /* $ Detailed_Input */ /* HANDLE is the handle of an SPK file that has been opened */ /* for writing. */ /* BODY is the NAIF integer code for an ephemeris object */ /* whose state relative to another body is described */ /* by the segment to be created. */ /* CENTER is the NAIF integer code for the center of motion */ /* of the object identified by BODY. */ /* FRAME is the NAIF name for a reference frame */ /* relative to which the state information for BODY */ /* is specified. */ /* FIRST, */ /* LAST are, respectively, the bounds of the time interval */ /* over which the segment defines the state of BODY. */ /* FIRST must be greater than or equal to the first */ /* interpolation interval start time; LAST must be */ /* less than or equal to the last interpolation */ /* interval stop time. See the description of IVLBDS */ /* below. */ /* SEGID is the segment identifier. An SPK segment */ /* identifier may contain up to 40 characters. */ /* NINTVL is the number of interpolation intervals */ /* associated with the input data. The interpolation */ /* intervals are associated with data sets referred */ /* to as "mini-segments." */ /* The input data comprising each mini-segment are: */ /* - a packet count */ /* - a type 19 subtype */ /* - an interpolating polynomial degree */ /* - a sequence of type 19 data packets */ /* - a sequence of packet epochs */ /* These inputs are described below. */ /* NPKTS is an array of packet counts. The Ith element of */ /* NPKTS is the packet count of the Ith interpolation */ /* interval/mini-segment. */ /* NPKTS has dimension NINTVL. */ /* SUBTPS is an array of type 19 subtypes. The Ith element */ /* of SUBTPS is the subtype of the packets associated */ /* with the Ith interpolation interval/mini-segment. */ /* SUBTPS has dimension NINTVL. */ /* DEGRES is an array of interpolating polynomial degrees. */ /* The Ith element of DEGRES is the polynomial degree */ /* of the packets associated with the Ith */ /* interpolation interval/mini-segment. */ /* For subtype 0, interpolation degrees must be */ /* equivalent to 3 mod 4, that is, they must be in */ /* the set */ /* { 3, 7, 11, ..., MAXDEG } */ /* For subtype 1, interpolation degrees must be odd */ /* and must be in the range 1:MAXDEG. */ /* DEGRES has dimension NINTVL. */ /* PACKTS is an array containing data packets for all input */ /* mini-segments. The packets for a given */ /* mini-segment are stored contiguously in increasing */ /* time order. The order of the sets of packets for */ /* different mini-segments is the same as the order */ /* of their corresponding interpolation intervals. */ /* Each packet represents geometric states of BODY */ /* relative to CENTER, specified relative to FRAME. */ /* The packet structure depends on the segment */ /* subtype as follows: */ /* Type 0 (indicated by code S19TP0): */ /* x, y, z, dx/dt, dy/dt, dz/dt, */ /* vx, vy, vz, dvx/dt, dvy/dt, dvz/dt */ /* where x, y, z represent Cartesian position */ /* components and vx, vy, vz represent Cartesian */ /* velocity components. Note well: vx, vy, and */ /* vz *are not necessarily equal* to the time */ /* derivatives of x, y, and z. This packet */ /* structure mimics that of the Rosetta/MEX orbit */ /* file. */ /* Type 1 (indicated by code S19TP1): */ /* x, y, z, dx/dt, dy/dt, dz/dt */ /* where x, y, z represent Cartesian position */ /* components and vx, vy, vz represent Cartesian */ /* velocity components. */ /* Position units are kilometers, velocity units */ /* are kilometers per second, and acceleration units */ /* are kilometers per second per second. */ /* EPOCHS is an array containing epochs for all input */ /* mini-segments. Each epoch is expressed as seconds */ /* past J2000 TDB. The epochs have a one-to-one */ /* relationship with the packets in the input packet */ /* array. */ /* The epochs for a given mini-segment are stored */ /* contiguously in increasing order. The order of the */ /* sets of epochs for different mini-segments is the */ /* same as the order of their corresponding */ /* interpolation intervals. */ /* For each mini-segment, "padding" is allowed: the */ /* sequence of epochs for that mini-segment may start */ /* before the corresponding interpolation interval */ /* start time and end after the corresponding */ /* interpolation interval stop time. Padding is used */ /* to control behavior of interpolating polynomials */ /* near interpolation interval boundaries. */ /* Due to possible use of padding, the elements of */ /* EPOCHS, taken as a whole, may not be in increasing */ /* order. */ /* IVLBDS is an array of interpolation interval boundary */ /* times. This array is an ordered list of the */ /* interpolation interval start times, to which the */ /* the end time for the last interval is appended. */ /* The Ith interpolation interval is the time */ /* coverage interval of the Ith mini-segment (see the */ /* description of NPKTS above). */ /* For each mini-segment, the corresponding */ /* interpolation interval's start time is greater */ /* than or equal to the mini-segment's first epoch, */ /* and the interval's stop time is less than or equal */ /* to the mini-segment's last epoch. */ /* For each interpolation interval other than the */ /* last, the interval's coverage stop time coincides */ /* with the coverage start time of the next interval. */ /* There are no coverage gaps, and coverage overlap */ /* for adjacent intervals consists of a single epoch. */ /* IVLBDS has dimension NINTVL+1. */ /* SELLST is a logical flag indicating to the SPK type 19 */ /* segment reader SPKR19 how to select the */ /* interpolation interval when a request time */ /* coincides with a time boundary shared by two */ /* interpolation intervals. When SELLST ("select */ /* last") is .TRUE., the later interval is selected; */ /* otherwise the earlier interval is selected. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* MAXDEG is the maximum allowed degree of the interpolating */ /* polynomial. */ /* See the INCLUDE file spk19.inc for the value of */ /* MAXDEG. */ /* $ Exceptions */ /* If any of the following exceptions occur, this routine will return */ /* without creating a new segment. */ /* 1) If FIRST is greater than LAST then the error */ /* SPICE(BADDESCRTIMES) will be signaled. */ /* 2) If FRAME is not a recognized name, the error */ /* SPICE(INVALIDREFFRAME) is signaled. */ /* 3) If the last non-blank character of SEGID occurs past index */ /* 40, the error SPICE(SEGIDTOOLONG) is signaled. */ /* 4) If SEGID contains any nonprintable characters, the error */ /* SPICE(NONPRINTABLECHARS) is signaled. */ /* 5) If NINTVL is not at least 1, the error SPICE(INVALIDCOUNT) */ /* is signaled. */ /* 6) If the elements of the array IVLBDS are not in strictly */ /* increasing order, the error SPICE(BOUNDSOUTOFORDER) will be */ /* signaled. */ /* 7) If the first interval start time IVLBDS(1) is greater than */ /* FIRST, or if the last interval end time IVLBDS(N+1) is less */ /* than LAST, the error SPICE(COVERAGEGAP) will be signaled. */ /* 8) If any packet count in the array NPKTS is not at least 2, the */ /* error SPICE(TOOFEWPACKETS) will be signaled. */ /* 9) If any subtype code in the array SUBTPS is not recognized, */ /* the error SPICE(INVALIDSUBTYPE) will be signaled. */ /* 10) If any interpolation degree in the array DEGRES */ /* is not at least 1 or is greater than MAXDEG, the */ /* error SPICE(INVALIDDEGREE) is signaled. */ /* 11) If the window size implied by any element of the array DEGRES */ /* is odd, the error SPICE(BADWINDOWSIZE) is signaled. */ /* 12) If the elements of the array EPOCHS corresponding to a given */ /* mini-segment are not in strictly increasing order, the error */ /* SPICE(TIMESOUTOFORDER) will be signaled. */ /* 13) If the first epoch of a mini-segment exceeds the start */ /* time of the associated interpolation interval, or if the */ /* last epoch of the mini-segment precedes the end time of the */ /* interpolation interval, the error SPICE(BOUNDSDISAGREE) */ /* is signaled. */ /* 14) Any error that occurs while writing the output segment will */ /* be diagnosed by routines in the call tree of this routine. */ /* $ Files */ /* A new type 19 SPK segment is written to the SPK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an SPK type 19 data segment to the open SPK */ /* file according to the format described in the type 19 section of */ /* the SPK Required Reading. The SPK file must have been opened with */ /* write access. */ /* $ Examples */ /* Suppose that you have states and are prepared to produce */ /* a segment of type 19 in an SPK file. */ /* The following code fragment could be used to add the new segment */ /* to a previously opened SPK file attached to HANDLE. The file must */ /* have been opened with write access. */ /* C */ /* C Create a segment identifier. */ /* C */ /* SEGID = 'MY_SAMPLE_SPK_TYPE_19_SEGMENT' */ /* C */ /* C Write the segment. */ /* C */ /* CALL SPKW19 ( HANDLE, BODY, CENTER, FRAME, */ /* . FIRST, LAST, SEGID, NINTVL, */ /* . NPKTS, SUBTPS, DEGRES, PACKTS, */ /* . EPOCHS, IVLBDS, SELLST ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* B.V. Semenov (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 05-FEB-2014 (NJB) (BVS) */ /* -& */ /* $ Index_Entries */ /* write spk type_19 ephemeris data segment */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Saved values */ /* Initial values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("SPKW19", (ftnlen)6); /* Start with a parameter compatibility check. */ if (FALSE_) { setmsg_("SPK type 19 record size may be as large as #, but SPKPVN re" "cord size is #.", (ftnlen)74); errint_("#", &c__198, (ftnlen)1); errint_("#", &c__198, (ftnlen)1); sigerr_("SPICE(BUG0)", (ftnlen)11); chkout_("SPKW19", (ftnlen)6); return 0; } /* Make sure the segment descriptor bounds are */ /* correctly ordered. */ if (*last < *first) { setmsg_("Segment start time is #; stop time is #; bounds must be in " "nondecreasing order.", (ftnlen)79); errdp_("#", first, (ftnlen)1); errdp_("#", last, (ftnlen)1); sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); chkout_("SPKW19", (ftnlen)6); return 0; } /* Get the NAIF integer code for the reference frame. */ namfrm_(frame, &refcod, frame_len); if (refcod == 0) { setmsg_("The reference frame # is not supported.", (ftnlen)39); errch_("#", frame, (ftnlen)1, frame_len); sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); chkout_("SPKW19", (ftnlen)6); return 0; } /* Check to see if the segment identifier is too long. */ if (lastnb_(segid, segid_len) > 40) { setmsg_("Segment identifier contains more than 40 characters.", ( ftnlen)52); sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); chkout_("SPKW19", (ftnlen)6); return 0; } /* Now check that all the characters in the segment identifier */ /* can be printed. */ i__1 = lastnb_(segid, segid_len); for (i__ = 1; i__ <= i__1; ++i__) { chrcod = *(unsigned char *)&segid[i__ - 1]; if (chrcod < 32 || chrcod > 126) { setmsg_("The segment identifier contains nonprintable characters", (ftnlen)55); sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); chkout_("SPKW19", (ftnlen)6); return 0; } } /* The mini-segment/interval count must be positive. */ if (*nintvl < 1) { setmsg_("Mini-segment/interval count was #; this count must be posit" "ive.", (ftnlen)63); errint_("#", nintvl, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("SPKW19", (ftnlen)6); return 0; } /* Make sure the interval bounds form a strictly */ /* increasing sequence. */ /* Note that there are NINTVL+1 bounds. */ i__1 = *nintvl; for (i__ = 1; i__ <= i__1; ++i__) { if (ivlbds[i__ - 1] >= ivlbds[i__]) { setmsg_("Interval bounds at indices # and # are # and # respecti" "vely. The difference is #. The bounds are required to be" " strictly increasing.", (ftnlen)132); errint_("#", &i__, (ftnlen)1); i__2 = i__ + 1; errint_("#", &i__2, (ftnlen)1); errdp_("#", &ivlbds[i__ - 1], (ftnlen)1); errdp_("#", &ivlbds[i__], (ftnlen)1); d__1 = ivlbds[i__] - ivlbds[i__ - 1]; errdp_("#", &d__1, (ftnlen)1); sigerr_("SPICE(BOUNDSOUTOFORDER)", (ftnlen)23); chkout_("SPKW19", (ftnlen)6); return 0; } } /* Make sure the time span of the descriptor doesn't extend */ /* beyond the span of the interval bounds. */ if (*first < ivlbds[0] || *last > ivlbds[*nintvl]) { setmsg_("First interval start time is #; segment start time is #; se" "gment stop time is #; last interval stop time is #. This seq" "uence of times is required to be non-decreasing: segment cov" "erage must be contained within the union of the interpolatio" "n intervals.", (ftnlen)251); errdp_("#", ivlbds, (ftnlen)1); errdp_("#", first, (ftnlen)1); errdp_("#", last, (ftnlen)1); errdp_("#", &ivlbds[*nintvl], (ftnlen)1); sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18); chkout_("SPKW19", (ftnlen)6); return 0; } /* Check the input data before writing to the file. */ /* This order of operations entails some redundant */ /* calculations, but it allows for rapid error */ /* detection. */ /* Initialize the mini-segment packet array indices, */ /* and those of the mini-segment epoch array as well. */ pktbeg = 0; pktend = 0; bepix = 0; eepix = 0; i__1 = *nintvl; for (i__ = 1; i__ <= i__1; ++i__) { /* First, just make sure the packet count for the current */ /* mini-segment is at least two. This check reduces our chances */ /* of a subscript range violation. */ /* Check the number of packets. */ if (npkts[i__ - 1] < 2) { setmsg_("At least 2 packets are required for SPK type 19. Number" " of packets supplied was # in mini-segment at index #.", ( ftnlen)109); errint_("#", &npkts[i__ - 1], (ftnlen)1); errint_("#", &i__, (ftnlen)1); sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20); chkout_("SPKW19", (ftnlen)6); return 0; } /* Set the packet size, which is a function of the subtype. Also */ /* set the window size. First check the subtype, which will be */ /* used as an array index. */ subtyp = subtps[i__ - 1]; if (subtyp < 0 || subtyp > 1) { setmsg_("Unexpected SPK type 19 subtype # found in mini-segment " "#.", (ftnlen)57); errint_("#", &subtyp, (ftnlen)1); errint_("#", &i__, (ftnlen)1); sigerr_("SPICE(INVALIDSUBTYPE)", (ftnlen)21); chkout_("SPKW19", (ftnlen)6); return 0; } pktsiz = pktszs[(i__2 = subtyp) < 2 && 0 <= i__2 ? i__2 : s_rnge( "pktszs", i__2, "spkw19_", (ftnlen)689)]; if (odd_(&subtyp)) { winsiz = degres[i__ - 1] + 1; } else { winsiz = (degres[i__ - 1] + 1) / 2; } /* Make sure that the degree of the interpolating polynomials is */ /* in range. */ if (degres[i__ - 1] < 1 || degres[i__ - 1] > 27) { setmsg_("The interpolating polynomials of mini-segment # have de" "gree #; the valid degree range is [1, #]", (ftnlen)95); errint_("#", &i__, (ftnlen)1); errint_("#", °res[i__ - 1], (ftnlen)1); errint_("#", &c__27, (ftnlen)1); sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); chkout_("SPKW19", (ftnlen)6); return 0; } /* Make sure that the window size is even. */ if (odd_(&winsiz)) { setmsg_("The interpolating polynomials of mini-segment # have wi" "ndow size # and degree # for SPK type 19. The mini-segme" "nt subtype is #. The degree must be equivalent to 3 mod " "4 for subtype 0 (Hermite interpolation) and be odd for s" "ubtype 1 (Lagrange interpolation).", (ftnlen)257); errint_("#", &i__, (ftnlen)1); errint_("#", &winsiz, (ftnlen)1); errint_("#", °res[i__ - 1], (ftnlen)1); errint_("#", &subtps[i__ - 1], (ftnlen)1); sigerr_("SPICE(BADWINDOWSIZE)", (ftnlen)20); chkout_("SPKW19", (ftnlen)6); return 0; } /* Make sure the epochs of the Ith mini-segment form a */ /* strictly increasing sequence. */ /* To start out, determine the indices of the epoch sequence */ /* of the Ith mini-segment. We'll call the begin and end */ /* epoch indices BEPIX and EEPIX respectively. */ bepix = eepix + 1; eepix = bepix - 1 + npkts[i__ - 1]; i__2 = npkts[i__ - 1] - 1; for (j = 1; j <= i__2; ++j) { k = bepix + j - 1; if (epochs[k - 1] >= epochs[k]) { setmsg_("In mini-segment #, epoch # having index # in array " "EPOCHS and index # in the mini-segment is greater th" "an or equal to its successor #.", (ftnlen)134); errint_("#", &i__, (ftnlen)1); errdp_("#", &epochs[k - 1], (ftnlen)1); errint_("#", &k, (ftnlen)1); errint_("#", &j, (ftnlen)1); errdp_("#", &epochs[k], (ftnlen)1); sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); chkout_("SPKW19", (ftnlen)6); return 0; } } /* Make sure that the span of the input epochs of the Ith */ /* mini-segment includes the Ith interpolation interval. */ if (epochs[bepix - 1] > ivlbds[i__ - 1]) { setmsg_("Interpolation interval # start time # precedes mini-seg" "ment's first epoch #.", (ftnlen)76); errint_("#", &i__, (ftnlen)1); errdp_("#", &ivlbds[i__ - 1], (ftnlen)1); errdp_("#", &epochs[bepix - 1], (ftnlen)1); sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21); chkout_("SPKW19", (ftnlen)6); return 0; } else if (epochs[eepix - 1] < ivlbds[i__]) { setmsg_("Interpolation interval # end time # exceeds mini-segmen" "t's last epoch #.", (ftnlen)72); errint_("#", &i__, (ftnlen)1); errdp_("#", &ivlbds[i__], (ftnlen)1); errdp_("#", &epochs[eepix - 1], (ftnlen)1); sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21); chkout_("SPKW19", (ftnlen)6); return 0; } } /* If we made it this far, we're ready to start writing the segment. */ /* The type 19 segment structure is eloquently described by this */ /* diagram from the SPK Required Reading: */ /* +--------------------------------+ */ /* | Interval 1 mini-segment | */ /* +--------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------+ */ /* | Interval N mini-segment | */ /* +--------------------------------+ */ /* | Interval 1 start time | */ /* +--------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------+ */ /* | Interval N start time | */ /* +--------------------------------+ */ /* | Interval N stop time | */ /* +--------------------------------+ */ /* | Interval start 100 | (First interval directory) */ /* +--------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------+ */ /* | Interval start (N/100)*100 | (Last interval directory) */ /* +--------------------------------+ */ /* | Interval 1 start pointer | */ /* +--------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------+ */ /* | Interval N start pointer | */ /* +--------------------------------+ */ /* | Interval N stop pointer + 1 | */ /* +--------------------------------+ */ /* | Boundary choice flag | */ /* +--------------------------------+ */ /* | Number of intervals | */ /* +--------------------------------+ */ /* SPK type 19 mini-segments have the following structure: */ /* +-----------------------+ */ /* | Packet 1 | */ /* +-----------------------+ */ /* . */ /* . */ /* . */ /* +-----------------------+ */ /* | Packet M | */ /* +-----------------------+ */ /* | Epoch 1 | */ /* +-----------------------+ */ /* . */ /* . */ /* . */ /* +-----------------------+ */ /* | Epoch M | */ /* +-----------------------+ */ /* | Epoch 100 | (First time tag directory) */ /* +-----------------------+ */ /* . */ /* . */ /* . */ /* +-----------------------+ */ /* | Epoch ((M-1)/100)*100 | (Last time tag directory) */ /* +-----------------------+ */ /* | Subtype code | */ /* +-----------------------+ */ /* | Window size | */ /* +-----------------------+ */ /* | Number of packets | */ /* +-----------------------+ */ /* Create the segment descriptor. We don't use SPKPDS because */ /* that routine doesn't allow creation of a singleton segment. */ ic[0] = *body; ic[1] = *center; ic[2] = refcod; ic[3] = 19; dc[0] = *first; dc[1] = *last; dafps_(&c__2, &c__6, dc, ic, descr); /* Begin a new segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("SPKW19", (ftnlen)6); return 0; } /* Re-initialize the mini-segment packet array indices, */ /* and those of the mini-segment epoch array as well. */ pktbeg = 0; pktend = 0; bepix = 0; eepix = 0; /* Write data for each mini-segment to the file. */ i__1 = *nintvl; for (i__ = 1; i__ <= i__1; ++i__) { /* Set the packet size, which is a function of the subtype. */ subtyp = subtps[i__ - 1]; pktsiz = pktszs[(i__2 = subtyp) < 2 && 0 <= i__2 ? i__2 : s_rnge( "pktszs", i__2, "spkw19_", (ftnlen)931)]; if (odd_(&subtyp)) { winsiz = degres[i__ - 1] + 1; } else { winsiz = (degres[i__ - 1] + 1) / 2; } /* Now that we have the packet size, we can compute */ /* mini-segment packet index range. We'll let PKTDSZ */ /* be the total count of packet data entries for this */ /* mini-segment. */ pktdsz = npkts[i__ - 1] * pktsiz; pktbeg = pktend + 1; pktend = pktbeg - 1 + pktdsz; /* At this point, we're read to start writing the */ /* current mini-segment to the file. Start with the */ /* packet data. */ dafada_(&packts[pktbeg - 1], &pktdsz); /* Write the epochs for this mini-segment. */ bepix = eepix + 1; eepix = bepix - 1 + npkts[i__ - 1]; dafada_(&epochs[bepix - 1], &npkts[i__ - 1]); /* Compute the number of epoch directories for the */ /* current mini-segment. */ ndir = (npkts[i__ - 1] - 1) / 100; /* Write the epoch directories to the segment. */ i__2 = ndir; for (j = 1; j <= i__2; ++j) { k = bepix - 1 + j * 100; dafada_(&epochs[k - 1], &c__1); } /* Write the mini-segment's subtype, window size, and packet */ /* count to the segment. */ d__1 = (doublereal) subtps[i__ - 1]; dafada_(&d__1, &c__1); d__1 = (doublereal) winsiz; dafada_(&d__1, &c__1); d__1 = (doublereal) npkts[i__ - 1]; dafada_(&d__1, &c__1); if (failed_()) { chkout_("SPKW19", (ftnlen)6); return 0; } } /* We've finished writing the mini-segments. */ /* Next write the interpolation interval bounds. */ i__1 = *nintvl + 1; dafada_(ivlbds, &i__1); /* Create and write directories for the interval */ /* bounds. */ /* The directory count is the interval bound count */ /* (N+1), minus 1, divided by the directory size. */ ndir = *nintvl / 100; i__1 = ndir; for (i__ = 1; i__ <= i__1; ++i__) { dafada_(&ivlbds[i__ * 100 - 1], &c__1); } /* Now we compute and write the start/stop pointers */ /* for each mini-segment. */ /* The pointers are relative to the DAF address */ /* preceding the segment. For example, a pointer */ /* to the first DAF address in the segment has */ /* value 1. */ segend = 0; i__1 = *nintvl; for (i__ = 1; i__ <= i__1; ++i__) { /* Set the packet size, which is a function of the subtype. */ pktsiz = pktszs[(i__2 = subtps[i__ - 1]) < 2 && 0 <= i__2 ? i__2 : s_rnge("pktszs", i__2, "spkw19_", (ftnlen)1033)]; /* In order to compute the end pointer of the current */ /* mini-segment, we must compute the size, in terms */ /* of DAF addresses, of this mini-segment. The formula */ /* for the size is */ /* size = n_packets * packet_size */ /* + n_epochs */ /* + n_epoch_directories */ /* + 3 */ /* = n_packets * ( packet_size + 1 ) */ /* + ( n_packets - 1 ) / DIRSIZ */ /* + 3 */ minisz = npkts[i__ - 1] * (pktsiz + 1) + (npkts[i__ - 1] - 1) / 100 + 3; segbeg = segend + 1; segend = segbeg + minisz - 1; /* Write the mini-segment begin pointer. */ /* After the loop terminates, the final end pointer, incremented */ /* by 1, will be written. */ d__1 = (doublereal) segbeg; dafada_(&d__1, &c__1); } /* Write the last mini-segment end pointer, incremented by one. */ /* SEGEND was computed on the last iteration of the above loop. */ d__1 = (doublereal) (segend + 1); dafada_(&d__1, &c__1); /* Write out the interval selection flag. The input */ /* boolean value is represented by a numeric constant. */ if (*sellst) { isel = 1; } else { isel = -1; } d__1 = (doublereal) isel; dafada_(&d__1, &c__1); /* Write the mini-segment/interpolation interval count. */ d__1 = (doublereal) (*nintvl); dafada_(&d__1, &c__1); /* End the segment. */ dafena_(); chkout_("SPKW19", (ftnlen)6); return 0; } /* spkw19_ */
/* $Procedure LPARSS ( Parse a list of items; return a set. ) */ /* Subroutine */ int lparss_(char *list, char *delims, char *set, ftnlen list_len, ftnlen delims_len, ftnlen set_len) { /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ char bchr[1], echr[1]; integer nmax, b, e, n; extern /* Subroutine */ int chkin_(char *, ftnlen); logical valid; extern integer sizec_(char *, ftnlen); extern logical failed_(void); extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), validc_( integer *, integer *, char *, ftnlen); extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int chkout_(char *, ftnlen), insrtc_(char *, char *, ftnlen, ftnlen); extern logical return_(void); integer eol; /* $ Abstract */ /* Parse a list of items delimited by multiple delimiters, */ /* placing the resulting items into a set. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* CELLS */ /* SETS */ /* $ Keywords */ /* CHARACTER */ /* PARSING */ /* SETS */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* LIST I List of items delimited by DELIMS on input. */ /* DELIMS I Single characters which delimit items. */ /* SET O Items in the list, validated, left justified. */ /* $ Detailed_Input */ /* LIST is a list of items delimited by any one of the */ /* characters in the string DELIMS. Consecutive */ /* delimiters, and delimiters at the beginning and */ /* end of the list, are considered to delimit blank */ /* items. A blank list is considered to contain */ /* a single (blank) item. */ /* DELIMS contains the individual characters which delimit */ /* the items in the list. These may be any ASCII */ /* characters, including blanks. */ /* However, by definition, consecutive blanks are NOT */ /* considered to be consecutive delimiters. Nor are */ /* a blank and any other delimiter considered to be */ /* consecutive delimiters. In addition, leading and */ /* trailing blanks are ignored. */ /* $ Detailed_Output */ /* SET is a set containing the items in the list, left */ /* justified. Any item in the list too long to fit */ /* into an element of SET is truncated on the right. */ /* The size of the set must be initialized prior */ /* to calling LPARSS. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the size of the set is not large enough to accommodate all */ /* of the items in the set, the error is diagnosed by routines in */ /* the call tree of this routine. */ /* 2) If the string length of ITEMS is too short to accommodate */ /* an item, the item will be truncated on the right. */ /* 3) If the string length of ITEMS is too short to permit encoding */ /* of integers via ENCHAR, the error is diagnosed by routines in */ /* the call tree of this routine. */ /* $ Files */ /* None. */ /* $ Particulars */ /* None. */ /* $ Examples */ /* The following examples illustrate the operation of LPARSS. */ /* 1) Let */ /* LIST = 'A number of words separated by */ /* spaces.' */ /* DELIMS = ' ,.' */ /* SIZE (SET) = 20 */ /* Then */ /* CARDC (SET) = 8 */ /* SET (1) = ' ' */ /* SET (2) = 'A' */ /* SET (3) = 'by' */ /* SET (4) = 'number' */ /* SET (5) = 'of' */ /* SET (6) = 'separated' */ /* SET (7) = 'spaces' */ /* SET (8) = 'words' */ /* 2) Let */ /* LIST = ' 1986-187// 13:15:12.184 ' */ /* DELIMS = ' ,/-:' */ /* SIZE (SET) = 20 */ /* Then */ /* CARDC (SET) = 6 */ /* SET (1) = ' ' */ /* SET (2) = '12.184' */ /* SET (3) = '13' */ /* SET (4) = '15' */ /* SET (5) = '187' */ /* SET (6) = '1986' */ /* 3) Let LIST = ' ,This, is, ,an,, example, ' */ /* DELIMS = ' ,' */ /* SIZE (SET) = 20 */ /* Then */ /* CARDC (SET) = 5 */ /* SET (1) = ' ' */ /* SET (2) = 'This' */ /* SET (3) = 'an' */ /* SET (4) = 'example' */ /* SET (5) = 'is' */ /* 4) Let LIST = 'Mary had a little lamb, little lamb */ /* whose fleece was white as snow.' */ /* DELIMS = ' ,.' */ /* SIZE (SET) = 6 */ /* An error would be signaled because the set is not */ /* large enough to accommodate all of the items in the */ /* list. */ /* 5) Let LIST = '1 2 3 4 5 6 7 8 9 10.' */ /* DELIMS = ' .' */ /* SIZE (SET) = 10 */ /* An error would be signaled because the set is not */ /* large enough to accommodate all of the items in the */ /* list. Note that delimiters at the end (or beginning) */ /* of list are considered to delimit blank items. */ /* 6) Let LIST = '1 2 3 4 5 6 7 8 9 10.' */ /* DELIMS = '.' */ /* SIZE (SET) = 10 */ /* Then */ /* CARDC (SET) = 2 */ /* SET (1) = ' ' */ /* SET (2) = '1 2 3 4 5 6 7 8 9 10' */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* H.A. Neilan (JPL) */ /* I.M. Underwood (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ /* Bug fix: code was modified to avoid out-of-range */ /* substring bound conditions. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (HAN) (IMU) */ /* -& */ /* $ Index_Entries */ /* parse a list of items and return a set */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 26-OCT-2005 (NJB) */ /* Bug fix: code was modified to avoid out-of-range */ /* substring bound conditions. The previous version */ /* of this routine used DO WHILE statements of the form */ /* DO WHILE ( ( B .LE. EOL ) */ /* . .AND. ( LIST(B:B) .EQ. BLANK ) ) */ /* Such statements can cause index range violations when the */ /* index B is greater than the length of the string LIST. */ /* Whether or not such violations occur is platform-dependent. */ /* - Beta Version 2.0.0, 10-JAN-1989 (HAN) */ /* Error handling was added, and old error flags and their */ /* checks were removed. An error is signaled if the set */ /* is not large enough to accommodate all of the items in */ /* the list. */ /* The header documentation was updated to reflect the error */ /* handling changes, and more examples were added. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("LPARSS", (ftnlen)6); } /* Because speed is essential in many list parsing applications, */ /* LPARSS, like LPARSE, parses the input list in a single pass. */ /* What follows is nearly identical to LPARSE, except the FORTRAN */ /* INDEX function is used to test for delimiters, instead of testing */ /* each character for simple equality. Also, the items are inserted */ /* into a set instead of simply placed at the end of an array. */ /* No items yet. */ n = 0; /* What is the size of the set? */ nmax = sizec_(set, set_len); /* The array has not been validated yet. */ valid = FALSE_; /* Blank list contains a blank item. No need to validate. */ if (s_cmp(list, " ", list_len, (ftnlen)1) == 0) { scardc_(&c__0, set, set_len); insrtc_(" ", set, (ftnlen)1, set_len); valid = TRUE_; } else { /* Eliminate trailing blanks. EOL is the last non-blank */ /* character in the list. */ eol = lastnb_(list, list_len); /* As the King said to Alice: 'Begin at the beginning. */ /* Continue until you reach the end. Then stop.' */ /* When searching for items, B is the beginning of the current */ /* item; E is the end. E points to the next non-blank delimiter, */ /* if any; otherwise E points to either the last character */ /* preceding the next item, or to the last character of the list. */ b = 1; while(b <= eol) { /* Skip any blanks before the next item or delimiter. */ /* At this point in the loop, we know */ /* B <= EOL */ *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; while(b <= eol && *(unsigned char *)bchr == 32) { ++b; if (b <= eol) { *(unsigned char *)bchr = *(unsigned char *)&list[b - 1]; } } /* At this point B is the index of the next non-blank */ /* character BCHR, or else */ /* B == EOL + 1 */ /* The item ends at the next delimiter. */ e = b; if (e <= eol) { *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; } else { *(unsigned char *)echr = ' '; } while(e <= eol && i_indx(delims, echr, delims_len, (ftnlen)1) == 0) { ++e; if (e <= eol) { *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; } } /* (This is different from LPARSE. If the delimiter was */ /* a blank, find the next non-blank character. If it's not */ /* a delimiter, back up. This prevents constructions */ /* like 'a , b', where the delimiters are blank and comma, */ /* from being interpreted as three items instead of two. */ /* By definition, consecutive blanks, or a blank and any */ /* other delimiter, do not count as consecutive delimiters.) */ if (e <= eol && *(unsigned char *)echr == 32) { /* Find the next non-blank character. */ while(e <= eol && *(unsigned char *)echr == 32) { ++e; if (e <= eol) { *(unsigned char *)echr = *(unsigned char *)&list[e - 1]; } } if (e <= eol) { if (i_indx(delims, echr, delims_len, (ftnlen)1) == 0) { /* We're looking at a non-delimiter character. */ /* E is guaranteed to be > 1 if we're here, so the */ /* following subtraction is valid. */ --e; } } } /* The item now lies between B and E. Unless, of course, B and */ /* E are the same character; this can happen if the list */ /* starts or ends with a non-blank delimiter, or if we have */ /* stumbled upon consecutive delimiters. */ if (! valid) { /* If the array has not been validated, it's just an */ /* array, and we can insert items directly into it. */ /* Unless it's full, in which case we validate now and */ /* insert later. */ if (n < nmax) { ++n; if (e > b) { s_copy(set + (n + 5) * set_len, list + (b - 1), set_len, e - 1 - (b - 1)); } else { s_copy(set + (n + 5) * set_len, " ", set_len, (ftnlen) 1); } } else { validc_(&nmax, &nmax, set, set_len); valid = TRUE_; } } /* Once the set has been validated, the strings are inserted */ /* into the set if there's room. If there is not enough room */ /* in the set, let INSRTC signal the error. */ if (valid) { if (e > b) { insrtc_(list + (b - 1), set, e - 1 - (b - 1), set_len); } else { insrtc_(" ", set, (ftnlen)1, set_len); } if (failed_()) { chkout_("LPARSS", (ftnlen)6); return 0; } } /* If there are more items to be found, continue with the */ /* character following E (which is a delimiter). */ b = e + 1; } /* If the array has not yet been validated, validate it before */ /* returning. */ if (! valid) { validc_(&nmax, &n, set, set_len); } /* If the list ended with a (non-blank) delimiter, insert a */ /* blank item into the set. If there isn't any room, signal */ /* an error. */ if (i_indx(delims, list + (eol - 1), delims_len, (ftnlen)1) != 0) { insrtc_(" ", set, (ftnlen)1, set_len); /* If INSRTC failed to insert the blank because the set */ /* was already full, INSRTC will have signaled an error. */ /* No action is necessary here. */ } } chkout_("LPARSS", (ftnlen)6); return 0; } /* lparss_ */
static FLAC__bool do_picture(const char *prefix) { FLAC__StreamMetadata *obj; const char *error; size_t i; printf("\n+++ grabbag unit test: picture\n\n"); /* invalid spec: no filename */ printf("testing grabbag__picture_parse_specification(\"\")... "); if(0 != (obj = grabbag__picture_parse_specification("", &error))) return failed_("expected error, got object"); printf("OK (failed as expected, error: %s)\n", error); /* invalid spec: no filename */ printf("testing grabbag__picture_parse_specification(\"||||\")... "); if(0 != (obj = grabbag__picture_parse_specification("||||", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); /* invalid spec: no filename */ printf("testing grabbag__picture_parse_specification(\"|image/gif|||\")... "); if(0 != (obj = grabbag__picture_parse_specification("|image/gif|||", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); /* invalid spec: bad resolution */ printf("testing grabbag__picture_parse_specification(\"|image/gif|desc|320|0.gif\")... "); if(0 != (obj = grabbag__picture_parse_specification("|image/gif|desc|320|0.gif", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); /* invalid spec: bad resolution */ printf("testing grabbag__picture_parse_specification(\"|image/gif|desc|320x240|0.gif\")... "); if(0 != (obj = grabbag__picture_parse_specification("|image/gif|desc|320x240|0.gif", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); /* invalid spec: no filename */ printf("testing grabbag__picture_parse_specification(\"|image/gif|desc|320x240x9|\")... "); if(0 != (obj = grabbag__picture_parse_specification("|image/gif|desc|320x240x9|", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); /* invalid spec: #colors exceeds color depth */ printf("testing grabbag__picture_parse_specification(\"|image/gif|desc|320x240x9/2345|0.gif\")... "); if(0 != (obj = grabbag__picture_parse_specification("|image/gif|desc|320x240x9/2345|0.gif", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); /* invalid spec: standard icon has to be 32x32 PNG */ printf("testing grabbag__picture_parse_specification(\"1|-->|desc|32x24x9|0.gif\")... "); if(0 != (obj = grabbag__picture_parse_specification("1|-->|desc|32x24x9|0.gif", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); /* invalid spec: need resolution for linked URL */ printf("testing grabbag__picture_parse_specification(\"|-->|desc||http://blah.blah.blah/z.gif\")... "); if(0 != (obj = grabbag__picture_parse_specification("|-->|desc||http://blah.blah.blah/z.gif", &error))) return failed_("expected error, got object"); printf("OK (failed as expected: %s)\n", error); printf("testing grabbag__picture_parse_specification(\"|-->|desc|320x240x9|http://blah.blah.blah/z.gif\")... "); if(0 == (obj = grabbag__picture_parse_specification("|-->|desc|320x240x9|http://blah.blah.blah/z.gif", &error))) return failed_(error); printf("OK\n"); FLAC__metadata_object_delete(obj); /* test automatic parsing of picture files from only the file name */ for(i = 0; i < sizeof(picturefiles)/sizeof(picturefiles[0]); i++) if(!test_one_picture(prefix, picturefiles+i, "", /*fn_only=*/true)) return false; /* test automatic parsing of picture files to get resolution/color info */ for(i = 0; i < sizeof(picturefiles)/sizeof(picturefiles[0]); i++) if(!test_one_picture(prefix, picturefiles+i, "", /*fn_only=*/false)) return false; picturefiles[0].width = 320; picturefiles[0].height = 240; picturefiles[0].depth = 3; picturefiles[0].colors = 2; if(!test_one_picture(prefix, picturefiles+0, "320x240x3/2", /*fn_only=*/false)) return false; return true; }
/* $Procedure PCKWSS ( PCK write segment summary ) */ /* Subroutine */ int pckwss_(integer *unit, char *segid, integer *segbod, integer *segfrm, integer *segtyp, doublereal *segbtm, doublereal * segetm, ftnlen segid_len) { /* Initialized data */ static char pcktyp[80*3] = "***Not Used*** " " " "Fixed Width, Fixed Order " "Chebyshev Polynomials: Angles " "Variab" "le Width Chebyshev Polynomials Angles (in degrees!!!) " " "; /* System generated locals */ integer i__1; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, char *, integer); /* Local variables */ static char body[32]; extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen); static char frame[32]; extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); static char lines[80*9]; static logical found; extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *, ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen, ftnlen); extern logical failed_(void); static char begtim[32], endtim[32]; extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_( char *, ftnlen), writla_(integer *, char *, integer *, ftnlen); static char typdsc[80]; extern logical return_(void); /* $ Abstract */ /* Write the segment summary for a PCK segment to a Fortran logical */ /* unit. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* None. */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* UNIT I The logical unit to use for writing the summary. */ /* SEGIDS I Segment ID for the segment in a PCK file. */ /* SEGBOD I Body for the segment in a PCK file. */ /* SEGFRM I Reference frame for the segment in a PCK file. */ /* SEGTYP I Ephemeris type for the segment in a PCK file. */ /* SEGBTM I Begin time (ET) for the segment in a PCK file. */ /* SEGETM I End time (ET) for the segment in a PCK file. */ /* $ Detailed_Input */ /* UNIT The Fortran logical unit to which the segment summary */ /* is written. */ /* SEGID Segment ID for a segment in a PCK file. */ /* SEGBOD Body for a segment in a PCK file. This is the */ /* NAIF integer code for the body. */ /* SEGFRM Inertial reference frame for a segment in a PCK file. */ /* this is the NAIF integer code for the inertial reference */ /* frame. */ /* SEGTYP Ephemeris type for a segment in a PCK file. This is an */ /* integer code which represents the PCK segment data type. */ /* SEGBTM Begin time (ET) for a segment in a PCK file. */ /* SEGETM End time (ET) for a segment in a PCK file. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If an error occurs while writing to the logical unit, the error */ /* will be signalled by a routine called by this routine. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine will format and display a PCK segment summary in a */ /* human compatible fashion. */ /* $ Examples */ /* None. */ /* $ Restrictions */ /* 1) This routine performs time conversions using ET2UTC, and */ /* therefore requires that a SPICE leapseconds kernel file be */ /* loaded into the SPICELIB kernel pool before being called. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* K.R. Gehringer (JPL) */ /* $ Version */ /* - Beta Version 2.1.0, 17-May-2001 (WLT) (20 years in CA today!) */ /* Added a description for type 03 PCK segments. */ /* - Beta Version 2.0.0, 24-JAN-1996 (KRG) */ /* There have been several undocumented revisions of this */ /* subroutine to improve its display formats and fix display bugs. */ /* We are starting a new trend here, with the documentation of the */ /* changes to this version. Hopefully we will continue to do so. */ /* The changes to this version are: */ /* Calling a new subroutien to get reference frame names, to */ /* support the non-inertial frames software. */ /* Fixing some display inconsistencies when body, or frame */ /* names are not found. */ /* - Beta Version 1.0.0, 25-FEB-1993 (KRG) */ /* -& */ /* $ Index_Entries */ /* format and write a pck segment summary */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Set the value for the maximum output display width. */ /* Set the maximum length for the inertial reference frame name. */ /* Set the maximum length for a body name. */ /* Set the precision for fractions of seconds used for UTC times */ /* when converted from ET times. */ /* Set the length of a UTC time string. */ /* Set the maximum length of an PCK data type description. */ /* Set the maximum number of PCK data types. */ /* Set up some mnemonics for accessing the correct labels. */ /* Set the number of output lines. */ /* Local variables */ /* Save everything to keep configuration control happy. */ /* Initial Values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("PCKWSS", (ftnlen)6); } /* Set up the line labels. */ s_copy(lines, " Segment ID : #", (ftnlen)80, (ftnlen)21); s_copy(lines + 400, " UTC Start time : #", (ftnlen)80, (ftnlen)21); s_copy(lines + 480, " UTC Stop time : #", (ftnlen)80, (ftnlen)21); s_copy(lines + 560, " ET Start time : #", (ftnlen)80, (ftnlen)21); s_copy(lines + 640, " ET Stop time : #", (ftnlen)80, (ftnlen)21); s_copy(lines + 80, " Body : Body #", (ftnlen)80, (ftnlen)26); s_copy(lines + 160, " Reference frame: Frame #", (ftnlen)80, (ftnlen)27) ; s_copy(lines + 240, " PCK Data Type : #", (ftnlen)80, (ftnlen)21); s_copy(lines + 320, " Description : #", (ftnlen)80, (ftnlen)21); /* Format the segment ID. */ repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, ( ftnlen)80); /* Convert the segment start and stop times from ET to UTC for */ /* human readability. */ et2utc_(segbtm, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32); et2utc_(segetm, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32); if (failed_()) { chkout_("PCKWSS", (ftnlen)6); return 0; } /* Format the UTC times. */ repmc_(lines + 400, "#", begtim, lines + 400, (ftnlen)80, (ftnlen)1, ( ftnlen)32, (ftnlen)80); repmc_(lines + 480, "#", endtim, lines + 480, (ftnlen)80, (ftnlen)1, ( ftnlen)32, (ftnlen)80); /* Convert the ET times into Calendar format. */ etcal_(segbtm, begtim, (ftnlen)32); etcal_(segetm, endtim, (ftnlen)32); if (failed_()) { chkout_("PCKWSS", (ftnlen)6); return 0; } /* Format the ET times. */ repmc_(lines + 560, "#", begtim, lines + 560, (ftnlen)80, (ftnlen)1, ( ftnlen)32, (ftnlen)80); repmc_(lines + 640, "#", endtim, lines + 640, (ftnlen)80, (ftnlen)1, ( ftnlen)32, (ftnlen)80); /* Format the body and its name if we found it. */ bodc2n_(segbod, body, &found, (ftnlen)32); if (found) { repmc_(lines + 80, "#", "#, #", lines + 80, (ftnlen)80, (ftnlen)1, ( ftnlen)4, (ftnlen)80); repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, ( ftnlen)80); repmc_(lines + 80, "#", body, lines + 80, (ftnlen)80, (ftnlen)1, ( ftnlen)32, (ftnlen)80); } else { repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, ( ftnlen)80); } /* Format the inertial reference frame and its name if we found it. */ frmnam_(segfrm, frame, (ftnlen)32); if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) { repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, ( ftnlen)4, (ftnlen)80); repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, ( ftnlen)80); repmc_(lines + 160, "#", frame, lines + 160, (ftnlen)80, (ftnlen)1, ( ftnlen)32, (ftnlen)80); } else { repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, ( ftnlen)80); } /* Format the PCK segment type and a description if we have one. */ /* The reason SEGTYP >= 2 is that this routine works on binary */ /* PCK files, and their segment types begin with type 2. Type 1 is */ /* considered to be the text PCK files. */ if (*segtyp > 3 || *segtyp < 2) { s_copy(typdsc, "No description for this type. Do you need a new tool" "kit?", (ftnlen)80, (ftnlen)56); } else { s_copy(typdsc, pcktyp + ((i__1 = *segtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("pcktyp", i__1, "pckwss_", (ftnlen)352)) * 80, ( ftnlen)80, (ftnlen)80); } repmi_(lines + 240, "#", segtyp, lines + 240, (ftnlen)80, (ftnlen)1, ( ftnlen)80); repmc_(lines + 320, "#", typdsc, lines + 320, (ftnlen)80, (ftnlen)1, ( ftnlen)80, (ftnlen)80); /* Display the summary. */ writla_(&c__9, lines, unit, (ftnlen)80); /* We were either successful or not on the previous write. In either */ /* event, we want to check out and return to the caller, so there is */ /* no need to check FAILED() here. */ chkout_("PCKWSS", (ftnlen)6); return 0; } /* pckwss_ */
/* $Procedure COMMNT ( Comment utility program ) */ /* Main program */ MAIN__(void) { /* Initialized data */ static logical insbln = TRUE_; static char maintl[20] = "COMMNT Options "; static char mainvl[20*5] = "QUIT " "ADD_COMMENTS " "READ_COMMENTS " "EXTRACT_COMMENTS " "DELETE_COMMENTS " " "; static char maintx[40*5] = "Quit. " "Add comments to a binary file. " "Read the comments in" " a binary file. " "Extract comments from a binary file. " "Delete the comments in a binary file. "; static char mainnm[1*5] = "Q" "A" "R" "E" "D"; /* System generated locals */ address a__1[3]; integer i__1[3], i__2, i__3, i__4, i__5; cllist cl__1; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, char **, integer *, integer *, ftnlen); integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, ftnlen, ftnlen), f_clos(cllist *); /* Local variables */ static char arch[3]; static logical done; static char line[1000]; static logical more; static integer iopt; static char type__[4]; static integer i__; extern /* Subroutine */ int dasdc_(integer *); extern integer cardi_(integer *); static integer r__; extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *, ftnlen, ftnlen), chkin_(char *, ftnlen), spcec_(integer *, integer *), spcdc_(integer *), errch_(char *, char *, ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), reset_(void); extern integer rtrim_(char *, ftnlen); extern logical failed_(void); extern /* Subroutine */ int dafhof_(integer *); static integer handle; extern /* Subroutine */ int dafcls_(integer *), dasacu_(integer *, char *, char *, logical *, integer *, ftnlen, ftnlen), cleari_(integer *, integer *), delfil_(char *, ftnlen), dasecu_(integer *, integer * , logical *), scardi_(integer *, integer *), dashof_(integer *); static logical fileok; extern /* Subroutine */ int clcomm_(void), getfat_(char *, char *, char *, ftnlen, ftnlen, ftnlen), cnfirm_(char *, logical *, ftnlen); static char fnmtbl[128*2], messag[1000], errmsg[320], messgs[1000*7], option[20], prmtbl[80*2], statbl[3*2]; extern logical exists_(char *, ftnlen); static integer comlun; static char status[1000*2]; static integer numfnm; static char prmpts[80*2]; static integer numopn, opnset[7], tblidx[2]; static logical comnts, contnu, ndfnms, tryagn; extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen), erract_(char *, char *, ftnlen, ftnlen), errprt_(char *, char *, ftnlen, ftnlen), tostdo_(char *, ftnlen), ssizei_(integer *, integer *), getopt_(char *, integer *, char *, char *, integer *, ftnlen, ftnlen, ftnlen), getfnm_(char *, char *, char *, logical * , char *, ftnlen, ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen) , sigerr_(char *, ftnlen), txtopr_(char *, integer *, ftnlen), dafopw_(char *, integer *, ftnlen), dasopw_(char *, integer *, ftnlen), dascls_(integer *), dafopr_(char *, integer *, ftnlen), spcrfl_(integer *, char *, logical *, ftnlen), spcrnl_(char *, logical *, ftnlen), dasopr_(char *, integer *, ftnlen), txtopn_( char *, integer *, ftnlen), chkout_(char *, ftnlen); static logical eoc; static char tkv[12]; /* $ Abstract */ /* NAIF Toolkit utility program for adding, reading, extracting, */ /* and deleting comments from a binary file. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPC */ /* DAS */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* K.R. Gehringer (JPL) */ /* J.E. McLean (JPL) */ /* M.J. Spencer (JPL) */ /* $ Version */ /* - Version 6.0.1, 08-MAY-2001 (BVS) */ /* Increased LINLEN from 255 to 1000 to make it consistent */ /* with SPICELIB's SPC* and SUPPORT's DAF* internal line sizes. */ /* - Version 5.0.1, 21-JUL-1997 (WLT) */ /* Modified the banner at start up so that the version of the */ /* toolkit used to link COMMNT will be displayed. */ /* In addition all WRITE statements were replaced by calls to */ /* TOSTDO. */ /* - Version 5.0.0, 05-MAY-1994 (KRG) */ /* Modified the program to use the new file type identification */ /* capability that was added to spicelib. No file type menu is */ /* necessary now, as the file type is determined during the */ /* execution of the program. */ /* The prompts for the begin and end markers used to extract a */ /* subset of text lines from an input comment file which were then */ /* placed into the comment area of a SPICE binary kernel file have */ /* been removed. The entire input comment file is now placed into */ /* the comment area of the binary kernel file. This change */ /* simplifies the user interaction with the program. */ /* Added support for the new PCK binary kernel files. */ /* If an error occurs during the extraction of comments to a file, */ /* the file that was being created is deleted. We cannot know */ /* whether the file had been successfully created before the error */ /* occurred. */ /* - Version 4.0.0, 11-DEC-1992 (KRG) */ /* Added code to support the E-Kernel, and redesigned the */ /* user interface. */ /* - Version 3.1.0, 19-NOV-1991 (MJS) */ /* Variable QUIT initialized to FALSE. */ /* - Version 3.0.1, 10-AUG-1991 (CHA) (NJB) */ /* Updated comments to reflect status as a Toolkit */ /* utility program. Message indicating that no comments */ /* were found in the specified file was changed to include */ /* the file name. */ /* - Version 2.0.0, 28-JUN-1991 (JEM) */ /* The option to read the comments from the comment */ /* area of a binary SPK or CK was added to the menu. */ /* - Version 1.0.0, 05-APR-1991 (JEM) */ /* -& */ /* SPICELIB functions */ /* Parameters */ /* Set the version of the comment program. This should be updated */ /* every time a change is made, and it should agree with the */ /* version number in the header. */ /* Set a value for the logical unit which represents the standard */ /* output device, commonly a terminal. A value of 6 is widely used, */ /* but the Fortran standard does not specify a value, so it may be */ /* different for different Fortran implementations. */ /* Lower bound for a SPICELIB CELL data structure. */ /* Maximum number of open binary files allowed. */ /* Set a value for a replacement marker. */ /* Set a value for a filename prompt. */ /* File types */ /* Set a value for the length of a text line. */ /* Set a value for the length of an error message. */ /* Set a value for the length of a filename. */ /* Set a length for the prompts in the prompt table. */ /* Set a length for the status of a file: 'OLD' or 'NEW'. */ /* Set the length for the architecture of a file. */ /* Set the length for the type of a file. */ /* Set a length for the option values. */ /* Set a length for the title of a menu. */ /* Set a length for an option name (what is typed to select it) */ /* for a menu. */ /* Set the length of the text description of an option on a menu. */ /* The number of options available on the main menu. */ /* Set up some mnemonics for indexing the prompts in the prompt */ /* table. */ /* Set the maximum size of the filename table: this must be the */ /* number of distinct ``types'' of files that the program may */ /* require. */ /* Set up some mnemonics for indexing the messages in the message */ /* table. */ /* Set the maximum size of the message table: There should be a */ /* message for each ``type'' of action that the program can take. */ /* Set up some mnemonics for the OK and not OK status messages. */ /* Set the maximum number of status messages that are available. */ /* We need to have TKVLEN characters to hold the current version */ /* of the toolkit. */ /* Variables */ /* We want to insert a blank line between additions if there are */ /* already comments in the binary file. We indicate this by giving */ /* the variable INSBLN the value .TRUE.. */ /* Define the main menu title ... */ /* Define the main menu option values ... */ /* Define the main menu descriptive text for each option ... */ /* Define the main menu option names ... */ /* Register the COMMNT main program with the SPICELIB error handler. */ chkin_("COMMNT", (ftnlen)6); clcomm_(); tkvrsn_("TOOLKIT", tkv, (ftnlen)7, (ftnlen)12); r__ = rtrim_(tkv, (ftnlen)12); /* Set the error action to 'RETURN'. We don't want the program */ /* to abort if an error is signalled. We check FAILED where */ /* necessary. If an error is signalled, we'll just handle the */ /* error, display an appropriate message, then call RESET at the */ /* end of the loop to continue. */ erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6); /* Set the error messages that we want to have displayed. We will */ /* diaplay the SPICELIB short and long error messages. This is done */ /* to ensure that some sort of an error message is displayed if an */ /* error occurs. In several places, long error messages are not set, */ /* so if only the long error messages were displayed, it would be */ /* possible to have an error signalled and not see any error */ /* information. This is not a very useful thing. */ errprt_("SET", "NONE, SHORT, LONG, TRACEBACK", (ftnlen)3, (ftnlen)28); /* Set up the prompt table for the different types of files. */ s_copy(prmtbl + 80, "Enter the name of the comment file to be #.", ( ftnlen)80, (ftnlen)43); s_copy(prmtbl, "Enter the name of the binary file.", (ftnlen)80, (ftnlen) 34); /* Set up the message table for the different ``types'' of */ /* operations. The message table contains generic messages which will */ /* have their missing parts filled in after the option and file type */ /* havve been selected. */ s_copy(messgs, "Reading the comment area of the # file.", (ftnlen)1000, ( ftnlen)39); s_copy(messgs + 1000, "Adding comments to the # file.", (ftnlen)1000, ( ftnlen)30); s_copy(messgs + 2000, "Extracting comments from the # file.", (ftnlen) 1000, (ftnlen)36); s_copy(messgs + 3000, "Deleting the comment area of # file.", (ftnlen) 1000, (ftnlen)36); s_copy(messgs + 4000, "Quitting the program.", (ftnlen)1000, (ftnlen)21); s_copy(messgs + 5000, "The comments were successfully #.", (ftnlen)1000, ( ftnlen)33); s_copy(messgs + 6000, "The comments were NOT successfully #.", (ftnlen) 1000, (ftnlen)37); /* Display a brief commercial with the name of the program and the */ /* version. */ s_copy(line, " Welcome to COMMNT Version: #", (ftnlen)1000, (ftnlen)31); repmc_(line, "#", "6.0.1", line, (ftnlen)1000, (ftnlen)1, (ftnlen)5, ( ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); /* Writing concatenation */ i__1[0] = 23, a__1[0] = " (Spice Toolkit "; i__1[1] = r__, a__1[1] = tkv; i__1[2] = 1, a__1[2] = ")"; s_cat(line, a__1, i__1, &c__3, (ftnlen)1000); tostdo_(line, (ftnlen)1000); tostdo_(" ", (ftnlen)1); /* Initialize the CELL oriented set for collecting open DAF or DAS */ /* files in the event of an error. */ ssizei_(&c__1, opnset); /* While there is still more to do ... */ done = FALSE_; while(! done) { /* We initialize a few things here, so that they get reset for */ /* every trip through the loop. */ /* Initialize the logical flags that we use. */ comnts = FALSE_; contnu = TRUE_; eoc = FALSE_; ndfnms = FALSE_; /* Initialize the filename table, ... */ s_copy(fnmtbl, " ", (ftnlen)128, (ftnlen)1); s_copy(fnmtbl + 128, " ", (ftnlen)128, (ftnlen)1); /* the file status table, ... */ s_copy(statbl, " ", (ftnlen)3, (ftnlen)1); s_copy(statbl + 3, " ", (ftnlen)3, (ftnlen)1); /* the table indices, ... */ tblidx[0] = 0; tblidx[1] = 0; /* set the number of file names to zero, ... */ numfnm = 0; /* the prompts in the prompt table, ... */ s_copy(prmpts, " ", (ftnlen)80, (ftnlen)1); s_copy(prmpts + 80, " ", (ftnlen)80, (ftnlen)1); /* the message, and the option. */ s_copy(messag, " ", (ftnlen)1000, (ftnlen)1); s_copy(option, " ", (ftnlen)20, (ftnlen)1); /* Set the status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)1000); /* Get the option to be performed from the main menu. */ getopt_(maintl, &c__5, mainnm, maintx, &iopt, (ftnlen)20, (ftnlen)1, ( ftnlen)40); s_copy(option, mainvl + ((i__2 = iopt - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("mainvl", i__2, "commnt_", (ftnlen)502)) * 20, (ftnlen) 20, (ftnlen)20); /* Set up the messages and other information for the option */ /* selected. */ if (contnu) { if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) { ndfnms = TRUE_; numfnm = 2; s_copy(messag, messgs + 1000, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 2; s_copy(prmpts, prmtbl + 80, (ftnlen)80, (ftnlen)80); repmc_(prmpts, "#", "added", prmpts, (ftnlen)80, (ftnlen)1, ( ftnlen)5, (ftnlen)80); s_copy(statbl + 3, "OLD", (ftnlen)3, (ftnlen)3); tblidx[1] = 1; s_copy(prmpts + 80, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "added", status, (ftnlen)1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "added", status + 1000, (ftnlen) 1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000); } else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13) == 0) { ndfnms = TRUE_; numfnm = 1; s_copy(messag, messgs, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 1; s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "read", status, (ftnlen)1000, (ftnlen)1, ( ftnlen)4, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "read", status + 1000, (ftnlen) 1000, (ftnlen)1, (ftnlen)4, (ftnlen)1000); } else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen) 16) == 0) { ndfnms = TRUE_; numfnm = 2; s_copy(messag, messgs + 2000, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 1; s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); tblidx[1] = 2; s_copy(prmpts + 80, prmtbl + 80, (ftnlen)80, (ftnlen)80); repmc_(prmpts + 80, "#", "created", prmpts + 80, (ftnlen)80, ( ftnlen)1, (ftnlen)7, (ftnlen)80); s_copy(statbl + 3, "NEW", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "extracted", status, (ftnlen)1000, ( ftnlen)1, (ftnlen)9, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "extracted", status + 1000, ( ftnlen)1000, (ftnlen)1, (ftnlen)9, (ftnlen)1000); } else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen) 15) == 0) { ndfnms = TRUE_; numfnm = 1; s_copy(messag, messgs + 3000, (ftnlen)1000, (ftnlen)1000); tblidx[0] = 1; s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80); s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3); /* Set the operation status messages. */ s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000); repmc_(status, "#", "deleted", status, (ftnlen)1000, (ftnlen) 1, (ftnlen)7, (ftnlen)1000); s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen) 1000); repmc_(status + 1000, "#", "deleted", status + 1000, (ftnlen) 1000, (ftnlen)1, (ftnlen)7, (ftnlen)1000); } else if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) { s_copy(messag, messgs + 4000, (ftnlen)1000, (ftnlen)1000); } } /* Collect any filenames that we may need. */ if (contnu && ndfnms) { /* we always need at least one filename if we get to here. */ i__ = 1; more = TRUE_; while(more) { fileok = FALSE_; tryagn = TRUE_; while(tryagn) { tostdo_(" ", (ftnlen)1); tostdo_(prmpts + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("prmpts", i__2, "commnt_", (ftnlen) 614)) * 80, (ftnlen)80); tostdo_(" ", (ftnlen)1); getfnm_("Filename? ", statbl + ((i__3 = tblidx[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("tblidx" , i__2, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <= i__3 ? i__3 : s_rnge("statbl", i__3, "commnt_", ( ftnlen)617)) * 3, fnmtbl + (((i__5 = tblidx[(i__4 = i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("tbl" "idx", i__4, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <= i__5 ? i__5 : s_rnge("fnmtbl", i__5, "commn" "t_", (ftnlen)617)) << 7), &fileok, errmsg, ( ftnlen)10, (ftnlen)3, (ftnlen)128, (ftnlen)320); /* If the filename is OK, increment the filename index */ /* and leave the try again loop. Otherwise, write out the */ /* error message, and give the opportunity to go around */ /* again. */ if (fileok) { ++i__; tryagn = FALSE_; } else { tostdo_(" ", (ftnlen)1); tostdo_(errmsg, (ftnlen)320); tostdo_(" ", (ftnlen)1); cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20); if (! tryagn) { contnu = FALSE_; more = FALSE_; } } } if (i__ > numfnm) { more = FALSE_; } } } /* Get the file architecture and type. */ if (contnu && ndfnms) { getfat_(fnmtbl, arch, type__, (ftnlen)128, (ftnlen)3, (ftnlen)4); if (failed_()) { contnu = FALSE_; } } /* Check to see that we got back a valid architecture and type. */ if (contnu && ndfnms) { if (s_cmp(arch, "?", (ftnlen)3, (ftnlen)1) == 0 || s_cmp(type__, "?", (ftnlen)4, (ftnlen)1) == 0) { contnu = FALSE_; setmsg_("The architecture and type of the binary file '#' co" "uld not be determined. A common error is to give the" " name of a text file instead of the name of a binary" " file.", (ftnlen)161); errch_("#", fnmtbl, (ftnlen)1, (ftnlen)128); sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20); } } /* Customize the message. We know we can do this, because we */ /* need files, and so we don't have the QUIT message. */ if (contnu && ndfnms) { repmc_(messag, "#", type__, messag, (ftnlen)1000, (ftnlen)1, ( ftnlen)4, (ftnlen)1000); } /* Process the option that was selected so long ago. */ if (contnu) { if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); tostdo_(" ", (ftnlen)1); done = TRUE_; } else if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1, (ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(line, (ftnlen)1000); /* Open the text file which contains the comments to be */ /* added to the binary file. */ txtopr_(fnmtbl + 128, &comlun, (ftnlen)128); if (! failed_()) { if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen) 1); dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen) 1); dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen) 1); dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, add the comments, and close */ /* the binary file. */ dasopw_(fnmtbl, &handle, (ftnlen)128); dasacu_(&comlun, " ", " ", &insbln, &handle, (ftnlen) 1, (ftnlen)1); dascls_(&handle); } /* Close the comment file. */ cl__1.cerr = 0; cl__1.cunit = comlun; cl__1.csta = 0; f_clos(&cl__1); } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); tostdo_(" ", (ftnlen)1); if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); /* The comments are read a line at a time and displayed */ /* on the screen. */ spcrfl_(&handle, line, &eoc, (ftnlen)1000); if (! failed_()) { if (eoc) { tostdo_("There were no comments found in the fil" "e.", (ftnlen)41); } while(! eoc && ! failed_()) { tostdo_(line, (ftnlen)1000); spcrnl_(line, &eoc, (ftnlen)1000); } } dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); /* The comments are read a line at a time and displayed */ /* on the screen. */ spcrfl_(&handle, line, &eoc, (ftnlen)1000); if (! failed_()) { if (eoc) { tostdo_("There were no commentfound in the file.", (ftnlen)39); } while(! eoc && ! failed_()) { tostdo_(line, (ftnlen)1000); spcrnl_(line, &eoc, (ftnlen)1000); } } dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); /* The comments are read a line at a time and displayed */ /* on the screen. */ spcrfl_(&handle, line, &eoc, (ftnlen)1000); if (! failed_()) { if (eoc) { tostdo_("There were no comments found in the fil" "e.", (ftnlen)41); } while(! eoc && ! failed_()) { tostdo_(line, (ftnlen)1000); spcrnl_(line, &eoc, (ftnlen)1000); } } dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, read the comments, and close */ /* the binary file. */ dasopr_(fnmtbl, &handle, (ftnlen)128); dasecu_(&handle, &c__6, &comnts); dascls_(&handle); if (! comnts) { s_copy(line, "There were no comments found in the fi" "le.", (ftnlen)1000, (ftnlen)41); tostdo_(line, (ftnlen)1000); } } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen) 16) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12); repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1, (ftnlen)128, (ftnlen)1000); tostdo_(line, (ftnlen)1000); /* Open the text file. */ txtopn_(fnmtbl + 128, &comlun, (ftnlen)128); if (! failed_()) { if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); spcec_(&handle, &comlun); dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); spcec_(&handle, &comlun); dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dafopr_(fnmtbl, &handle, (ftnlen)128); spcec_(&handle, &comlun); dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, extract the comments, and */ /* close the binary file. */ dasopr_(fnmtbl, &handle, (ftnlen)128); dasecu_(&handle, &comlun, &comnts); dascls_(&handle); if (! comnts) { s_copy(line, "There were no comments found in th" "e file.", (ftnlen)1000, (ftnlen)41); tostdo_(line, (ftnlen)1000); } } /* Close the text file that we opened. */ cl__1.cerr = 0; cl__1.cunit = comlun; cl__1.csta = 0; f_clos(&cl__1); } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen) 15) == 0) { tostdo_(" ", (ftnlen)1); tostdo_(messag, (ftnlen)1000); s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7); repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, ( ftnlen)128, (ftnlen)1000); tostdo_(" ", (ftnlen)1); tostdo_(line, (ftnlen)1000); if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcdc_(&handle); dafcls_(&handle); } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcdc_(&handle); dafcls_(&handle); } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dafopw_(fnmtbl, &handle, (ftnlen)128); spcdc_(&handle); dafcls_(&handle); } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) { /* Open the binary file, delete the comments, and close */ /* the binary file. */ dasopw_(fnmtbl, &handle, (ftnlen)128); dasdc_(&handle); dascls_(&handle); } /* Display the status of the operation that was selected. */ tostdo_(" ", (ftnlen)1); if (failed_()) { tostdo_(status + 1000, (ftnlen)1000); } else { tostdo_(status, (ftnlen)1000); } } } /* If anything failed, close any binary files that might still be */ /* open and reset the error handling before getting the next */ /* option. */ if (failed_()) { /* Before we can attempt to perform any clean up actions if an */ /* error occurred, we need to reset the SPICELIB error handling */ /* mechanism so that we can call the SPICELIB routines that we */ /* need to. */ reset_(); /* Clear out any binary file handles in the open set, OPNSET. */ scardi_(&c__0, opnset); cleari_(&c__1, &opnset[6]); /* Get the handles for any DAF files which may still be open. */ dafhof_(opnset); numopn = cardi_(opnset); if (numopn > 0) { i__2 = numopn; for (i__ = 1; i__ <= i__2; ++i__) { dafcls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 : s_rnge("opnset", i__3, "commnt_", (ftnlen)1100)]) ; } } /* Clear out any binary file handles in the open set, OPNSET. */ scardi_(&c__0, opnset); cleari_(&c__1, &opnset[6]); /* Get the handles for any DAS files which may still be open. */ dashof_(opnset); numopn = cardi_(opnset); if (numopn > 0) { i__2 = numopn; for (i__ = 1; i__ <= i__2; ++i__) { dascls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 : s_rnge("opnset", i__3, "commnt_", (ftnlen)1121)]) ; } } /* If there was an error and we were extracting comments to a */ /* file, then we should delete the file that was created, */ /* because we do not know whether the extraction was completed */ /* successfully. */ if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)16) == 0) { if (exists_(fnmtbl + 128, (ftnlen)128)) { delfil_(fnmtbl + 128, (ftnlen)128); } } /* Finally, reset the error handling, and go get the next */ /* option. This is just to be sure. */ reset_(); } } chkout_("COMMNT", (ftnlen)6); return 0; } /* MAIN__ */
/* $Procedure CKFROT ( C-kernel, find rotation ) */ /* Subroutine */ int ckfrot_(integer *inst, doublereal *et, doublereal * rotate, integer *ref, logical *found) { logical have, pfnd, sfnd; doublereal time; extern /* Subroutine */ int sce2c_(integer *, doublereal *, doublereal *); char segid[40]; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal descr[5]; extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, doublereal *, integer *), ckbss_(integer *, doublereal *, doublereal *, logical *), ckpfs_(integer *, doublereal *, doublereal *, doublereal *, logical *, doublereal *, doublereal *, doublereal *, logical *), cksns_(integer *, doublereal *, char *, logical *, ftnlen), xpose_(doublereal *, doublereal *); extern logical failed_(void); doublereal av[3]; integer handle; extern /* Subroutine */ int ckhave_(logical *); logical needav; extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen); integer sclkid; extern /* Subroutine */ int chkout_(char *, ftnlen); doublereal clkout; extern logical return_(void), zzsclk_(integer *, integer *); doublereal dcd[2]; integer icd[6]; doublereal tol, rot[9] /* was [3][3] */; /* $ Abstract */ /* Find the rotation from a C-kernel Id to the native */ /* frame at the time requested. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* CK */ /* $ Keywords */ /* POINTING */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* INST I NAIF instrument ID. */ /* ET I Epoch measured in seconds past J2000. */ /* ROTATE O rotation from CK platform to frame REF. */ /* REF O Reference frame. */ /* FOUND O True when requested pointing is available. */ /* $ Detailed_Input */ /* INST is the unique NAIF integer ID for the spacecraft */ /* instrument for which data is being requested. */ /* ET is the epoch for which the state rotation */ /* is desired. ET should be given in seconds past the */ /* epoch of J2000. */ /* $ Detailed_Output */ /* ROTATE is a rotation matrix that converts */ /* positions relative to the input frame (given by INST) */ /* to positions relative to the frame REF. */ /* Thus, if a state S has components x,y,z,dx,dy,dz */ /* in the frame of INST, frame, then S has components */ /* x', y', z', dx', dy', dz' in frame REF. */ /* [ x' ] [ ] [ x ] */ /* | y' | = | ROTATE | | y | */ /* [ z' ] [ ] [ z ] */ /* REF is the id-code reference frame to which ROTATE will */ /* transform states. */ /* FOUND is true if a record was found to satisfy the pointing */ /* request. FOUND will be false otherwise. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If a C-kernel file is not loaded using CKLPF prior to calling */ /* this routine, an error is signalled by a routine that this */ /* routine calls. */ /* $ Files */ /* CKFROT searches through files loaded by CKLPF to locate a segment */ /* that can satisfy the request for position rotation */ /* for instrument INST at time ET. You must load a C-kernel */ /* file using CKLPF before calling this routine. */ /* $ Particulars */ /* CKFROT searches through files loaded by CKLPF to satisfy a */ /* pointing request. Last-loaded files are searched first, and */ /* individual files are searched in backwards order, giving */ /* priority to segments that were added to a file later than the */ /* others. CKFROT considers only those segments that contain */ /* angular velocity data. */ /* The search ends when a segment is found that can give pointing */ /* for the specified instrument at the request time. */ /* $ Examples */ /* None. */ /* $ Restrictions */ /* A C-kernel file should have been loaded by CKLPF. */ /* In addition it is helpful to load a CK-info file into the */ /* Kernel pool. This file should have the following variables */ /* defined. */ /* CK_<INST>_SCLK = SCLK idcode that yields SCLK mapping for INST. */ /* CK_<INST>_SPK = SPK idcode that yields ephemeris for INST. */ /* where <INST> is the integer string corresponding to INST. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.0, 17-FEB-2000 (WLT) */ /* The routine now checks to make sure convert ET to TICKS */ /* and that at least one C-kernel is loaded before trying */ /* to look up the transformation. Also the routine now calls */ /* SCE2C instead of SCE2T. */ /* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */ /* -& */ /* $ Index_Entries */ /* get instrument frame rotation and reference frame */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* NDC is the number of double precision components in an */ /* unpacked C-kernel segment descriptor. */ /* NIC is the number of integer components in an unpacked */ /* C-kernel segment descriptor. */ /* NC is the number of components in a packed C-kernel */ /* descriptor. All DAF summaries have this formulaic */ /* relationship between the number of its integer and */ /* double precision components and the number of packed */ /* components. */ /* IDLEN is the length of the C-kernel segment identifier. */ /* All DAF names have this formulaic relationship */ /* between the number of summary components and */ /* the length of the name (You will notice that */ /* a name and a summary have the same length in bytes.) */ /* Local variables */ /* Set FOUND to FALSE right now in case we end up */ /* returning before doing any work. */ *found = FALSE_; *ref = 0; /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("CKFROT", (ftnlen)6); } /* We don't need angular velocity data. */ /* Assume the segment won't be found until it really is. */ needav = FALSE_; tol = 0.; /* Begin a search for this instrument and time, and get the first */ /* applicable segment. */ ckhave_(&have); ckmeta_(inst, "SCLK", &sclkid, (ftnlen)4); if (! have) { chkout_("CKFROT", (ftnlen)6); return 0; } else if (! zzsclk_(inst, &sclkid)) { chkout_("CKFROT", (ftnlen)6); return 0; } sce2c_(&sclkid, et, &time); ckbss_(inst, &time, &tol, &needav); cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); /* Keep trying candidate segments until a segment can produce a */ /* pointing instance within the specified time tolerance of the */ /* input time. */ /* Check FAILED to prevent an infinite loop if an error is detected */ /* by a SPICELIB routine and the error handling is not set to abort. */ while(sfnd && ! failed_()) { ckpfs_(&handle, descr, &time, &tol, &needav, rot, av, &clkout, &pfnd); if (pfnd) { /* Found one. Fetch the ID code of the reference frame */ /* from the descriptor. */ dafus_(descr, &c__2, &c__6, dcd, icd); *ref = icd[1]; *found = TRUE_; /* We now have the rotation matrix from */ /* REF to INS. We invert ROT to get the rotation */ /* from INST to REF. */ xpose_(rot, rotate); chkout_("CKFROT", (ftnlen)6); return 0; } cksns_(&handle, descr, segid, &sfnd, (ftnlen)40); } chkout_("CKFROT", (ftnlen)6); return 0; } /* ckfrot_ */
/* $Procedure EKRCED ( EK, read column entry element, d.p. ) */ /* Subroutine */ int ekrced_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, doublereal *dvals, logical *isnull, ftnlen column_len) { integer unit; extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), zzektrdp_(integer *, integer *, integer *, integer *); extern integer zzekesiz_(integer *, integer *, integer *, integer *); extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); integer class__; logical found; integer dtype; extern logical failed_(void); integer coldsc[11], segdsc[24]; extern /* Subroutine */ int dashlu_(integer *, integer *); integer recptr; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), zzekrd02_(integer *, integer *, integer *, integer *, doublereal *, logical *), zzekrd05_(integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, logical *, logical *), zzekrd08_(integer *, integer *, integer *, integer *, doublereal *, logical *); /* $ Abstract */ /* Read data from a double precision column in a specified EK */ /* record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGNO I Index of segment containing record. */ /* RECNO I Record from which data is to be read. */ /* COLUMN I Column name. */ /* NVALS O Number of values in column entry. */ /* DVALS O D.p. values in column entry. */ /* ISNULL O Flag indicating whether column entry is null. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. The file may be open for */ /* read or write access. */ /* SEGNO is the index of the segment from which data is to */ /* be read. */ /* RECNO is the index of the record from which data is to be */ /* read. This record number is relative to the start */ /* of the segment indicated by SEGNO; the first */ /* record in the segment has index 1. */ /* COLUMN is the name of the column from which data is to be */ /* read. */ /* $ Detailed_Output */ /* NVALS, */ /* DVALS are, respectively, the number of values found in */ /* the specified column entry and the set of values */ /* themselves. */ /* For columns having fixed-size entries, when a */ /* a column entry is null, NVALS is still set to the */ /* column entry size. For columns having variable- */ /* size entries, NVALS is set to 1 for null entries. */ /* ISNULL is a logical flag indicating whether the returned */ /* column entry is null. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If SEGNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 3) If RECNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 4) If COLUMN is not the name of a declared column, the error */ /* will be diagnosed by routines called by this routine. */ /* 5) If COLUMN specifies a column of whose data type is not */ /* double precision, the error SPICE(WRONGDATATYPE) will be */ /* signalled. */ /* 6) If COLUMN specifies a column of whose class is not */ /* a double precision class known to this routine, the error */ /* SPICE(NOCLASS) will be signalled. */ /* 7) If an attempt is made to read an uninitialized column entry, */ /* the error will be diagnosed by routines called by this */ /* routine. A null entry is considered to be initialized, but */ /* entries do not contain null values by default. */ /* 8) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine is a utility that allows an EK file to be read */ /* directly without using the high-level query interface. */ /* $ Examples */ /* 1) Read the value in the third record of the column DCOL in */ /* the fifth segment of an EK file designated by HANDLE. */ /* CALL EKRCED ( HANDLE, 5, 3, 'DCOL', N, DVAL, ISNULL ) */ /* $ Restrictions */ /* 1) EK files open for write access are not necessarily readable. */ /* In particular, a column entry can be read only if it has been */ /* initialized. The caller is responsible for determining */ /* when it is safe to read from files open for write access. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.0, 20-JUN-1999 (WLT) */ /* Removed unbalanced call to CHKOUT. */ /* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ /* Bug fix: Record number, not record pointer, is now supplied */ /* to look up data in the class 8 case. Miscellaneous header */ /* changes were made as well. */ /* - SPICELIB Version 1.0.0, 06-NOV-1995 (NJB) */ /* -& */ /* $ Index_Entries */ /* read double precision data from EK column */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ /* Bug fix: Record number, not record pointer, is now supplied */ /* to look up data in the class 8 case. For class 8 columns, */ /* column entry locations are calculated directly from record */ /* numbers; no indirection is used. */ /* Miscellaneous header changes were made as well. */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* First step: find the descriptor for the named segment. Using */ /* this descriptor, get the column descriptor. */ zzeksdsc_(handle, segno, segdsc); zzekcdsc_(handle, segdsc, column, coldsc, column_len); if (failed_()) { return 0; } /* This column had better be of d.p. or TIME type. */ dtype = coldsc[1]; if (dtype != 2 && dtype != 4) { chkin_("EKRCED", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Column # is of type #; EKRCED only works with d.p. or TIME " "columns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)99); errch_("#", column, (ftnlen)1, column_len); errint_("#", &dtype, (ftnlen)1); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); chkout_("EKRCED", (ftnlen)6); return 0; } /* Now it's time to read data from the file. Call the low-level */ /* reader appropriate to the column's class. */ class__ = coldsc[0]; if (class__ == 2) { /* Look up the record pointer for the target record. */ zzektrdp_(handle, &segdsc[6], recno, &recptr); zzekrd02_(handle, segdsc, coldsc, &recptr, dvals, isnull); *nvals = 1; } else if (class__ == 5) { zzektrdp_(handle, &segdsc[6], recno, &recptr); *nvals = zzekesiz_(handle, segdsc, coldsc, &recptr); zzekrd05_(handle, segdsc, coldsc, &recptr, &c__1, nvals, dvals, isnull, &found); } else if (class__ == 8) { /* Records in class 8 columns are identified by a record number */ /* rather than a pointer. */ zzekrd08_(handle, segdsc, coldsc, recno, dvals, isnull); *nvals = 1; } else { /* This is an unsupported d.p. column class. */ *segno = segdsc[1]; chkin_("EKRCED", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Class # from input column descriptor is not a supported d.p" ". class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen) 110); errint_("#", &class__, (ftnlen)1); errch_("#", column, (ftnlen)1, column_len); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(NOCLASS)", (ftnlen)14); chkout_("EKRCED", (ftnlen)6); return 0; } return 0; } /* ekrced_ */
/* $Procedure GETFNM_1 ( Get a filename from standard input ) */ /* Subroutine */ int getfnm_1__(char *prmpt, char *fstat, char *fname, logical *valid, ftnlen prmpt_len, ftnlen fstat_len, ftnlen fname_len) { /* Initialized data */ static logical first = TRUE_; /* System generated locals */ address a__1[2]; integer i__1, i__2[2]; char ch__1[1], ch__2[81]; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ extern integer cpos_(char *, char *, integer *, ftnlen, ftnlen); integer i__; extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), reset_( void); extern integer rtrim_(char *, ftnlen); extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); static char badchr[162]; extern logical failed_(void); char oldact[10]; extern /* Subroutine */ int cnfirm_(char *, logical *, ftnlen), erract_( char *, char *, ftnlen, ftnlen); integer length; extern integer lastnb_(char *, ftnlen); char myfnam[1000]; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); logical tryagn, myvlid; extern logical exists_(char *, ftnlen), return_(void); extern /* Subroutine */ int prompt_(char *, char *, ftnlen, ftnlen), writln_(char *, integer *, ftnlen); char status[3], myprmt[80]; /* $ Abstract */ /* This routine prompts the user for a valid filename. */ /* $ 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 */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* PRMPT I The prompt to use when asking for the filename. */ /* FSTAT I Status of the file: 'OLD' or 'NEW'. */ /* FNAME O A valid filename typed in by the user. */ /* VALID O A logical flag indicating a valid filename. */ /* PRMLEN P Maximum length allowed for a prompt before */ /* truncation. */ /* $ Detailed_Input */ /* PRMPT is a character string that will be displayed from the */ /* current cursor position that informs a user that input */ /* is expected. Prompts should be fairly short, since we */ /* need to declare some local storage. The current maximum */ /* length of a prompt is given by the parameter PRMLEN. */ /* FSTAT This is the status of the filename entered. It should */ /* be 'OLD' when prompting for the filename of a file which */ /* already exists, and 'NEW' when prompting for the */ /* filename of a file which does not already exist or is to */ /* be over written. */ /* $ Detailed_Output */ /* FNAME is a character string that contains a valid filename */ /* typed in by the user. A valid filename is defined */ /* simply to be a nonblank character string with no */ /* embedded blanks, nonprinting characters, or characters */ /* having decimal values > 126. */ /* VALID A logical flag which indicates whether or not the */ /* filename entered is valid, i.e., a nonblank character */ /* string with no leading or embedded blanks, which */ /* satisfies the constraints for validity imposed. */ /* $ Parameters */ /* PRMLEN The maximum length for an input prompt string. */ /* $ Exceptions */ /* 1) If the input file status is not equal to 'NEW' or 'OLD' after */ /* being left justified and converted to upper case, the error */ /* SPICE(INVALIDARGUMENT) will be signalled. The error handling */ /* is then reset. */ /* 2) If the filename entered at the prompt is blank, the error */ /* SPICE(BLANKFILENAME) will be signalled. The error handling is */ /* then reset. */ /* 3) If the filename contains an illegal character, a nonprinting */ /* character or embedded blanks, the error */ /* SPICE(ILLEGALCHARACTER) will be signalled. */ /* 4) If the file status is equal to 'OLD' after being left */ /* justified and converted to upper case and the file specified */ /* by the filename entered at the prompt does not exist, the */ /* error SPICE(FILEDOESNOTEXIST) will be signalled. */ /* 5) If the file status is equal to 'NEW' after being left */ /* justified and converted to upper case and the file specified */ /* by the filename entered at the prompt already exists, the */ /* error SPICE(FILEALREADYEXISTS) will be signalled. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This is a utility that allows you to "easily" request a valid, */ /* filename from a program user. At a high level, it frees you */ /* from the peculiarities of a particular FORTRAN's implementation */ /* of cursor control. */ /* A valid filename is defined as a nonblank character string with */ /* no embedded blanks, nonprinting characters, or characters with */ /* decimal values > 126. Leading blanks are removed, and trailing */ /* blanks are ignored. */ /* If an invalid filename is entered, this routine provides a */ /* descriptive error message and halts the execution of the */ /* process which called it by using a Fortran STOP. */ /* $ Examples */ /* EXAMPLE 1: */ /* FNAME = ' ' */ /* PRMPT = 'Filename? ' */ /* FSTAT = 'OLD' */ /* CALL GETFNM_1( PRMPT, FSTAT, FNAME, VALID ) */ /* The user sees the following displayed on the screen: */ /* Filename? _ */ /* where the underbar, '_', represents the cursor position. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* $ Version */ /* - SPICELIB Version 6.17.0, 10-MAR-2014 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-INTEL. */ /* - SPICELIB Version 6.16.0, 10-MAR-2014 (BVS) */ /* Updated for PC-LINUX-64BIT-IFORT. */ /* - SPICELIB Version 6.15.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-GFORTRAN. */ /* - SPICELIB Version 6.14.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */ /* - SPICELIB Version 6.13.0, 14-DEC-2010 (EDW) */ /* Declared PROMPT as EXTERNAL. */ /* Unfied Version and Revision sections, eliminated Revision */ /* section. Corrected error in 09-DEC-1999 Version entry. */ /* Version ID changed to 6.0.9 from 7.0.0. */ /* - Beta Version 6.12.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL. */ /* - Beta Version 6.11.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ /* - Beta Version 6.10.0, 13-MAY-2010 (BVS) */ /* Updated for PC-LINUX-64BIT-GFORTRAN. */ /* - Beta Version 6.9.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-IFORT. */ /* - Beta Version 6.8.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-GFORTRAN. */ /* - Beta Version 6.7.0, 18-MAR-2009 (BVS) */ /* Updated for PC-LINUX-GFORTRAN. */ /* - Beta Version 6.6.0, 18-MAR-2009 (BVS) */ /* Updated for MAC-OSX-GFORTRAN. */ /* - Beta Version 6.5.0, 19-FEB-2008 (BVS) */ /* Updated for PC-LINUX-IFORT. */ /* - Beta Version 6.4.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-IFORT. */ /* - Beta Version 6.3.0, 26-OCT-2005 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-GCC_C. */ /* - Beta Version 6.2.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN. */ /* - Beta Version 6.1.1, 17-JUL-2002 (BVS) */ /* Added MAC-OSX environments. */ /* - Beta Version 6.1.0, 16-AUG-2000 (WLT) */ /* Added PC-LINUX environment */ /* - Beta Version 6.0.9, 09-DEC-1999 (WLT) */ /* This routine now calls EXPFNM_2 only UNIX environments */ /* - Beta Version 6.0.0, 20-JAN-1998 (NJB) */ /* Now calls EXPFNM_2 to attempt to expand environment variables. */ /* Fixed a typo or two at various places in the header. */ /* - Beta Version 5.1.0, 31-JAN-1996 (KRG) */ /* Fixed a pedantic Fortran syntax error dealing with input */ /* strings that are dimensioned CHARACTER*(*). */ /* A local character string is now declared, and a parameter, */ /* PRMLEN, has been added to the interface description for this */ /* subroutine. PRMLEN defines the maximum length allowed for a */ /* prompt before it is truncated. */ /* - Beta Version 5.0.0, 05-JUL-1995 (KRG) */ /* Modified the routine to handle all of its own error messages */ /* and error conditions. The routine now signals an error */ /* immediately resetting the error handling when an exceptional */ /* condition is encountered. This is done so that input attempts */ /* may continue until a user decides to stop trying. */ /* Added several exceptions to the $ Exceptions section of the */ /* header. */ /* - Beta Version 4.0.1, 25-APR-1994 (KRG) */ /* Removed some incorrect comments from the $ Particulars section */ /* of the header. Something about a looping structure that is not */ /* a part of the code now, if it ever was. */ /* Fixed a typo or two at various places in the header. */ /* - Beta Version 4.0.0, 29-SEP-1993 (KRG) */ /* Added the character reperesnted by decimal 127 to the BADCHR. */ /* It should have been there, but it wasn't. */ /* - Beta Version 3.0.0, 10-SEP-1993 (KRG) */ /* Made the file status variable FSTAT case insensitive. */ /* Added code to the file status .EQ. 'NEW' case to set the */ /* valid flag to .FALSE. and set an appropriate error message */ /* about the file already existing. */ /* - Beta Version 2.0.0, 02-APR-1993 (KRG) */ /* The variable BADCHR was not saved which caused problems on */ /* some computers. This variable is now saved. */ /* - Beta Version 1.0.0, 01-JUN-1992 (KRG) */ /* -& */ /* $ Index_Entries */ /* prompt for a filename with error handling */ /* -& */ /* SPICELIB Functions */ /* Local Parameters */ /* Maximum length of a filename. */ /* Length of an error action */ /* Local Variables */ /* Saved Variables */ /* Initial Values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("GETFNM_1", (ftnlen)8); } /* We are going to be signalling errors and resetting the error */ /* handling, so we need to be in RETURN mode. First we get the */ /* current mode and save it, then we set the mode to return. Upon */ /* leaving the subroutine, we will restore the error handling mode */ /* that was in effect when we entered. */ erract_("GET", oldact, (ftnlen)3, (ftnlen)10); erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6); /* If this is the first time this routine has been called, */ /* initialize the ``bad character'' string. */ if (first) { first = FALSE_; for (i__ = 0; i__ <= 32; ++i__) { i__1 = i__; *(unsigned char *)&ch__1[0] = i__; s_copy(badchr + i__1, ch__1, i__ + 1 - i__1, (ftnlen)1); } for (i__ = 1; i__ <= 129; ++i__) { i__1 = i__ + 32; *(unsigned char *)&ch__1[0] = i__ + 126; s_copy(badchr + i__1, ch__1, i__ + 33 - i__1, (ftnlen)1); } } /* Left justify and convert the file status to upper case for */ /* comparisons. */ ljust_(fstat, status, fstat_len, (ftnlen)3); ucase_(status, status, (ftnlen)3, (ftnlen)3); /* Check to see if we have a valid status for the filename. */ if (s_cmp(status, "OLD", (ftnlen)3, (ftnlen)3) != 0 && s_cmp(status, "NEW", (ftnlen)3, (ftnlen)3) != 0) { setmsg_("The file status '#' was not valid. The file status must hav" "e a value of 'NEW' or 'OLD'.", (ftnlen)87); errch_("#", status, (ftnlen)1, (ftnlen)3); sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22); chkout_("GETFNM_1", (ftnlen)8); return 0; } /* Store the input value for the prompt into our local value. We do */ /* this for pedantic Fortran compilers that issue warnings for */ /* CHARACTER*(*) variables used with concatenation. */ s_copy(myprmt, prmpt, (ftnlen)80, prmpt_len); /* Read in a potential filename, and test it for validity. */ tryagn = TRUE_; while(tryagn) { /* Set the value of the valid flag to .TRUE.. We assume that the */ /* name entered will be a valid one. */ myvlid = TRUE_; /* Get the filename. */ if (s_cmp(myprmt, " ", (ftnlen)80, (ftnlen)1) == 0) { prompt_("Filename? ", myfnam, (ftnlen)10, (ftnlen)1000); } else { /* Writing concatenation */ i__2[0] = lastnb_(myprmt, (ftnlen)80), a__1[0] = myprmt; i__2[1] = 1, a__1[1] = " "; s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)81); prompt_(ch__2, myfnam, lastnb_(myprmt, (ftnlen)80) + 1, (ftnlen) 1000); } if (failed_()) { myvlid = FALSE_; } if (myvlid) { if (s_cmp(myfnam, " ", (ftnlen)1000, (ftnlen)1) == 0) { myvlid = FALSE_; setmsg_("The filename entered was blank.", (ftnlen)31); sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20); } } if (myvlid) { /* Left justify the filename. */ ljust_(myfnam, myfnam, (ftnlen)1000, (ftnlen)1000); /* Check for bad characters in the filename. */ length = lastnb_(myfnam, (ftnlen)1000); i__ = cpos_(myfnam, badchr, &c__1, length, (ftnlen)162); if (i__ > 0) { myvlid = FALSE_; setmsg_("The filename entered contains non printing characte" "rs or embedded blanks.", (ftnlen)73); sigerr_("SPICE(ILLEGALCHARACTER)", (ftnlen)23); } } if (myvlid) { /* We know that the filename that was entered was nonblank and */ /* had no bad characters. So, now we take care of the status */ /* question. */ if (s_cmp(status, "OLD", (ftnlen)3, (ftnlen)3) == 0) { if (! exists_(myfnam, rtrim_(myfnam, (ftnlen)1000))) { myvlid = FALSE_; setmsg_("A file with the name '#' does not exist.", ( ftnlen)40); errch_("#", myfnam, (ftnlen)1, (ftnlen)1000); sigerr_("SPICE(FILEDOESNOTEXIST)", (ftnlen)23); } } else if (s_cmp(status, "NEW", (ftnlen)3, (ftnlen)3) == 0) { if (exists_(myfnam, rtrim_(myfnam, (ftnlen)1000))) { myvlid = FALSE_; setmsg_("A file with the name '#' already exists.", ( ftnlen)40); errch_("#", myfnam, (ftnlen)1, (ftnlen)1000); sigerr_("SPICE(FILEALREADYEXISTS)", (ftnlen)24); } } } if (myvlid) { tryagn = FALSE_; } else { writln_(" ", &c__6, (ftnlen)1); cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20); writln_(" ", &c__6, (ftnlen)1); if (tryagn) { reset_(); } } } /* At this point, we have done the best we can. If the status */ /* was new, we might still have an invalid filename, but the */ /* exact reasons for its invalidity are system dependent, and */ /* therefore hard to test. */ *valid = myvlid; if (*valid) { s_copy(fname, myfnam, fname_len, rtrim_(myfnam, (ftnlen)1000)); } /* Restore the error action. */ erract_("SET", oldact, (ftnlen)3, (ftnlen)10); chkout_("GETFNM_1", (ftnlen)8); return 0; } /* getfnm_1__ */
/* $Procedure ZZEKPGCH ( EK, paging system access check ) */ /* Subroutine */ int zzekpgch_(integer *handle, char *access, ftnlen access_len) { integer topc, topd, topi, unit; extern /* Subroutine */ int chkin_(char *, ftnlen); integer lastc, lastd, lasti, id; extern logical failed_(void); extern /* Subroutine */ int daslla_(integer *, integer *, integer *, integer *), dasrdi_(integer *, integer *, integer *, integer *), dassih_(integer *, char *, ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); integer npc, npd, npi; /* $ Abstract */ /* Check that an EK is valid for a specified type of access by the */ /* paging system. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Das Paging Parameters */ /* ekpage.inc Version 4 25-AUG-1995 (NJB) */ /* The EK DAS paging system makes use of the integer portion */ /* of an EK file's DAS address space to store the few numbers */ /* required to describe the system's state. The allocation */ /* of DAS integer addresses is shown below. */ /* DAS integer array */ /* +--------------------------------------------+ */ /* | EK architecture code | Address = 1 */ /* +--------------------------------------------+ */ /* | Character page size (in DAS words) | */ /* +--------------------------------------------+ */ /* | Character page base address | */ /* +--------------------------------------------+ */ /* | Number of character pages in file | */ /* +--------------------------------------------+ */ /* | Number of character pages on free list | */ /* +--------------------------------------------+ */ /* | Character free list head pointer | Address = 6 */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for d.p. pages | 7--11 */ /* | | */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for integer pages | 12--16 */ /* | | */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | End Address = */ /* | Unused space | integer page */ /* | | end */ /* +--------------------------------------------+ */ /* | | Start Address = */ /* | First integer page | integer page */ /* | | base */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | */ /* | Last integer page | */ /* | | */ /* +--------------------------------------------+ */ /* The following parameters indicate positions of elements in the */ /* paging system metadata array: */ /* Number of metadata items per data type: */ /* Character metadata indices: */ /* Double precision metadata indices: */ /* Integer metadata indices: */ /* Size of metadata area: */ /* Page sizes, in units of DAS words of the appropriate type: */ /* Default page base addresses: */ /* End Include Section: EK Das Paging Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Architecture Version Parameters */ /* ekarch.inc Version 1 01-NOV-1995 (NJB) */ /* The following parameter indicates the EK file architecture */ /* version. EK files read by the EK system must have the */ /* architecture expected by the reader software; the architecture ID */ /* below is used to test for compatibility. */ /* Architecture code: */ /* End Include Section: EK Architecture Version Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* ACCESS I Access type. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. The specified file is to be */ /* checked to see whether it is a valid paged EK and */ /* whether it is open for the specified type of */ /* access. */ /* ACCESS is a short string indicating the type of access */ /* desired. Possible values are 'READ' and 'WRITE'. */ /* Leading and trailing blanks in ACCESS are ignored, */ /* and case is not significant. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If the EK architecture version is not current, the error */ /* SPICE(WRONGARCHITECTURE) is signalled. */ /* 3) If the DAS logical address ranges occupied by the EK are */ /* not consistent with those recorded by the paging system, */ /* the error SPICE(INVALIDFORMAT) is signalled. */ /* 4) If the EK is not open for the specified type of access, the */ /* error will be diagnosed by routines called by this routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine centralizes a validation check performed by many */ /* EK routines. The EK designated by HANDLE is tested to see */ /* whether some aspects of its structure are valid, and whether */ /* the specified type of access (read or write) is allowed. */ /* The tests performed are: */ /* - Is the file a DAS file open for the specified type of access? */ /* - Is the file's EK architecture version correct? */ /* - Are the DAS address ranges in use consistent with those */ /* recorded in the file by the paging system? */ /* If the file fails any test, an error is signalled. */ /* $ Examples */ /* See EKINSR. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ chkin_("ZZEKPGCH", (ftnlen)8); /* Check whether the DAS is opened for the specified access method. */ dassih_(handle, access, access_len); if (failed_()) { chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* Make sure the DAS file is of the right type. */ dasrdi_(handle, &c__1, &c__1, &id); if (id != 8) { dashlu_(handle, &unit); setmsg_("File # has architecture #, which is invalid for paged acces" "s. You are using EK software version #.", (ftnlen)99); errfnm_("#", &unit, (ftnlen)1); errint_("#", &id, (ftnlen)1); errint_("#", &c__8, (ftnlen)1); sigerr_("SPICE(WRONGARCHITECTURE)", (ftnlen)24); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* Obtain the page counts. Set the `top' addresses. */ dasrdi_(handle, &c__4, &c__4, &npc); dasrdi_(handle, &c__9, &c__9, &npd); dasrdi_(handle, &c__14, &c__14, &npi); topc = npc << 10; topd = npd << 7; topi = (npi << 8) + 256; /* Verify that the last addresses in use are consistent with the */ /* `top' addresses known to this system. */ daslla_(handle, &lastc, &lastd, &lasti); if (lastc > topc) { dashlu_(handle, &unit); setmsg_("File # has last char address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lastc, (ftnlen)1); errint_("#", &topc, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } else if (lastd > topd) { dashlu_(handle, &unit); setmsg_("File # has last d.p. address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lastd, (ftnlen)1); errint_("#", &topd, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } else if (lasti > topi) { dashlu_(handle, &unit); setmsg_("File # has last int. address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lasti, (ftnlen)1); errint_("#", &topi, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* zzekpgch_ */
/* $Procedure ZZEKGLNK ( EK, get link count for data page ) */ /* Subroutine */ int zzekglnk_(integer *handle, integer *type__, integer *p, integer *nlinks) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ integer i_dnnt(doublereal *); /* Local variables */ integer base; extern /* Subroutine */ int zzekpgbs_(integer *, integer *, integer *); doublereal dplnk; extern logical failed_(void); extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, doublereal *), dasrdi_(integer *, integer *, integer *, integer *) , zzekgei_(integer *, integer *, integer *); /* $ Abstract */ /* Return the link count for a specified EK data page. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* TYPE I Data type of page. */ /* P I Page number. */ /* NLINKS O Number of links to page. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* TYPE is the data type of the desired page. */ /* P is the page number of the allocated page. This */ /* number is recognized by the EK paged access */ /* routines. */ /* $ Detailed_Output */ /* NLINKS is the currently held number of links to the */ /* specified data page. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If TYPE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 3) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine centralizes EK data page link count accesses. */ /* $ Examples */ /* See EKDELR. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* Look up the base address of the page. */ zzekpgbs_(type__, p, &base); if (failed_()) { return 0; } if (*type__ == 1) { /* Look up the encoded count. */ i__1 = base + 1020; zzekgei_(handle, &i__1, nlinks); } else if (*type__ == 2) { /* Convert the encoded count to integer type. */ i__1 = base + 128; i__2 = base + 128; dasrdd_(handle, &i__1, &i__2, &dplnk); *nlinks = i_dnnt(&dplnk); } else { /* The remaining possibility is that TYPE is INT. If we had had */ /* an unrecognized type, ZZEKPGBS would have complained. */ i__1 = base + 256; i__2 = base + 256; dasrdi_(handle, &i__1, &i__2, nlinks); } return 0; } /* zzekglnk_ */
/* $Procedure TIPBOD ( Transformation, inertial position to bodyfixed ) */ /* Subroutine */ int tipbod_(char *ref, integer *body, doublereal *et, doublereal *tipm, ftnlen ref_len) { doublereal ref2j[9] /* was [3][3] */; extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, integer *, doublereal *); extern logical failed_(void); extern /* Subroutine */ int bodmat_(integer *, doublereal *, doublereal *) , chkout_(char *, ftnlen); doublereal tmpmat[9] /* was [3][3] */; extern /* Subroutine */ int irftrn_(char *, char *, doublereal *, ftnlen, ftnlen); extern logical return_(void); extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *) ; /* $ Abstract */ /* Return a 3x3 matrix that transforms positions in inertial */ /* coordinates to positions in body-equator-and-prime-meridian */ /* coordinates. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* PCK */ /* NAIF_IDS */ /* ROTATION */ /* TIME */ /* $ Keywords */ /* TRANSFORMATION */ /* ROTATION */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* REF I ID of inertial reference frame to transform from. */ /* BODY I ID code of body. */ /* ET I Epoch of transformation. */ /* TIPM O Transformation (position), inertial to prime */ /* meridian. */ /* $ Detailed_Input */ /* REF is the NAIF name for an inertial reference frame. */ /* Acceptable names include: */ /* Name Description */ /* -------- -------------------------------- */ /* 'J2000' Earth mean equator, dynamical */ /* equinox of J2000 */ /* 'B1950' Earth mean equator, dynamical */ /* equinox of B1950 */ /* 'FK4' Fundamental Catalog (4) */ /* 'DE-118' JPL Developmental Ephemeris (118) */ /* 'DE-96' JPL Developmental Ephemeris ( 96) */ /* 'DE-102' JPL Developmental Ephemeris (102) */ /* 'DE-108' JPL Developmental Ephemeris (108) */ /* 'DE-111' JPL Developmental Ephemeris (111) */ /* 'DE-114' JPL Developmental Ephemeris (114) */ /* 'DE-122' JPL Developmental Ephemeris (122) */ /* 'DE-125' JPL Developmental Ephemeris (125) */ /* 'DE-130' JPL Developmental Ephemeris (130) */ /* 'GALACTIC' Galactic System II */ /* 'DE-200' JPL Developmental Ephemeris (200) */ /* 'DE-202' JPL Developmental Ephemeris (202) */ /* (See the routine CHGIRF for a full list of names.) */ /* The output TIPM will give the transformation */ /* from this frame to the bodyfixed frame specified by */ /* BODY at the epoch specified by ET. */ /* BODY is the integer ID code of the body for which the */ /* position transformation matrix is requested. Bodies */ /* are numbered according to the standard NAIF */ /* numbering scheme. The numbering scheme is */ /* explained in the NAIF_IDS required reading file. */ /* ET is the epoch at which the position transformation */ /* matrix is requested. (This is typically the */ /* epoch of observation minus the one-way light time */ /* from the observer to the body at the epoch of */ /* observation.) */ /* $ Detailed_Output */ /* TIPM is a 3x3 coordinate transformation matrix. It is */ /* used to transform positions from inertial */ /* coordinates to body fixed (also called equator and */ /* prime meridian --- PM) coordinates. */ /* Given a position P in the inertial reference frame */ /* specified by REF, the corresponding bodyfixed */ /* position is given by the matrix vector product: */ /* TIPM * S */ /* The X axis of the PM system is directed to the */ /* intersection of the equator and prime meridian. */ /* The Z axis points along the spin axis and points */ /* towards the same side of the invariable plane of */ /* the solar system as does earth's north pole. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the kernel pool does not contain all of the data required */ /* for computing the transformation matrix, TIPM, the error */ /* SPICE(INSUFFICIENTANGLES) is signalled. */ /* 2) If the reference frame, REF, is not recognized, a routine */ /* called by TIPBOD will diagnose the condition and invoke the */ /* SPICE error handling system. */ /* 3) If the specified body code, BODY, is not recognized, the */ /* error is diagnosed by a routine called by TIPBOD. */ /* $ Files */ /* None. */ /* $ Particulars */ /* TIPBOD takes PCK information as input, either in the */ /* form of a binary or text PCK file. High precision */ /* binary files are searched for first (the last loaded */ /* file takes precedence); then it defaults to the text */ /* PCK file. If binary information is found for the */ /* requested body and time, the Euler angles are */ /* evaluated and the transformation matrix is calculated */ /* from them. Using the Euler angles PHI, DELTA and W */ /* we compute */ /* TIPM = [W] [DELTA] [PHI] */ /* 3 1 3 */ /* If no appropriate binary PCK files have been loaded, */ /* the text PCK file is used. Here information is found */ /* as RA, DEC and W (with the possible addition of nutation */ /* and libration terms for satellites). Again, the Euler */ /* angles are found, and the transformation matrix is */ /* calculated from them. The transformation from inertial to */ /* bodyfixed coordinates is represented as: */ /* TIPM = [W] [HALFPI-DEC] [RA+HALFPI] */ /* 3 1 3 */ /* These are basically the Euler angles, PHI, DELTA and W: */ /* RA = PHI - HALFPI */ /* DEC = HALFPI - DELTA */ /* W = W */ /* In the text file, RA, DEC, and W are defined as follows: */ /* 2 ____ */ /* RA2*t \ */ /* RA = RA0 + RA1*t/T + ------ + / a sin theta */ /* 2 ---- i i */ /* T i */ /* 2 ____ */ /* DEC2*t \ */ /* DEC = DEC0 + DEC1*t/T + ------- + / d cos theta */ /* 2 ---- i i */ /* T i */ /* 2 ____ */ /* W2*t \ */ /* W = W0 + W1*t/d + ----- + / w sin theta */ /* 2 ---- i i */ /* d i */ /* where: */ /* d = seconds/day */ /* T = seconds/Julian century */ /* a , d , and w arrays apply to satellites only. */ /* i i i */ /* theta = THETA0(i) + THETA1(i)*t/T are specific to each */ /* i */ /* planet. */ /* These angles -- typically nodal rates -- vary in number and */ /* definition from one planetary system to the next. */ /* $ Examples */ /* Note that the items necessary to compute the Euler angles */ /* must have been loaded into the kernel pool (by one or more */ /* previous calls to FURNSH). The Euler angles are typically */ /* stored in the P_constants kernel file that comes with */ /* SPICELIB. */ /* 1) In the following code fragment, TIPBOD is used to transform */ /* a position in J2000 inertial coordinates to a state in */ /* bodyfixed coordinates. */ /* The 3-vectors POSTN represents the inertial position */ /* of an object with respect to the center of the */ /* body at time ET. */ /* C */ /* C First load the kernel pool. */ /* C */ /* CALL FURNSH ( 'PLANETARY_CONSTANTS.KER' ) */ /* C */ /* C Next get the transformation and its derivative. */ /* C */ /* CALL TIPBOD ( 'J2000', BODY, ET, TIPM ) */ /* C */ /* C Convert position, the first three elements of */ /* C STATE, to bodyfixed coordinates. */ /* C */ /* CALL MXVG ( TIPM, POSTN, BDPOS ) */ /* $ Restrictions */ /* The kernel pool must be loaded with the appropriate */ /* coefficients (from the P_constants kernel or binary PCK file) */ /* prior to calling this routine. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* K.S. Zukor (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in MXM call. Replaced header references to LDPOOL with */ /* references to FURNSH. */ /* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ /* Tests of routine FAILED() were added. */ /* - SPICELIB Version 1.0.3, 10-MAR-1994 (KSZ) */ /* Underlying BODMAT code changed to look for binary PCK */ /* data files, and use them to get orientation information if */ /* they are available. Only the comments to TIPBOD changed. */ /* - SPICELIB Version 1.0.2, 06-JUL-1993 (HAN) */ /* Example in header was corrected. Previous version had */ /* incorrect matrix dimension specifications passed to MXVG. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 05-AUG-1991 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* transformation from inertial position to bodyfixed */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.2.0, 06-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in MXM call. Replaced header references to LDPOOL with */ /* references to FURNSH. */ /* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */ /* Tests of routine FAILED() were added. The new checks */ /* are intended to prevent arithmetic operations from */ /* being performed with uninitialized or invalid data. */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("TIPBOD", (ftnlen)6); } /* Get the transformation from the inertial from REF to J2000 */ /* coordinates. */ irftrn_(ref, "J2000", ref2j, ref_len, (ftnlen)5); /* Get the transformation from J2000 to body-fixed coordinates */ /* for the requested epoch. */ bodmat_(body, et, tipm); if (failed_()) { chkout_("TIPBOD", (ftnlen)6); return 0; } /* Compose the transformations to arrive at the REF-to-J2000 */ /* transformation. */ mxm_(tipm, ref2j, tmpmat); moved_(tmpmat, &c__9, tipm); /* That's all folks. Check out and get out. */ chkout_("TIPBOD", (ftnlen)6); return 0; } /* tipbod_ */
/* $Procedure ZZEKACPS ( EK, allocate contiguous pages for segment ) */ /* Subroutine */ int zzekacps_(integer *handle, integer *segdsc, integer * type__, integer *n, integer *p, integer *base) { /* System generated locals */ integer i__1, i__2; /* Local variables */ integer tree; extern /* Subroutine */ int zzekpgan_(integer *, integer *, integer *, integer *), zzeksfwd_(integer *, integer *, integer *, integer *), zzektrap_(integer *, integer *, integer *, integer *), zzekslnk_( integer *, integer *, integer *, integer *); integer b, i__, p2; extern logical failed_(void); integer idx; /* $ Abstract */ /* Allocate a series of contiguous data pages for a specified EK */ /* segment. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* PRIVATE */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* SEGDSC I Segment descriptor. */ /* TYPE I Data type of page. */ /* N I Number of pages to allocate. */ /* P O Page number. */ /* BASE O DAS base address of page. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* SEGDSC is the descriptor of the segment for which to */ /* allocate a series of data pages. */ /* TYPE is the data type of the desired pages. */ /* N is the number of pages desired. All pages */ /* allocated are new. A new page is one that has not */ /* been allocated before. */ /* $ Detailed_Output */ /* P is the number of the first page of the allocated */ /* series. The rest of the pages have numbers */ /* P+1, P+2, ... , P+N-1 */ /* These numbers are recognized by the EK paged access */ /* routines. */ /* BASE is the DAS base address of the first allocated */ /* page. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. The file will not be modified. */ /* 2) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. The file may be corrupted. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: it allocates a series of */ /* new, contiguous EK data pages for a specified segment. The */ /* segment's metadata are updated to reflect aquisition of the pages. */ /* This routine, not ZZEKAPS, should be used when contiguous pages */ /* are required. */ /* Each allocated page is initialized as follows: */ /* - The page's link count is zeroed out. */ /* - The page's forward pointer is zeroed out. */ /* After all pages are allocated, the metadata for the segment are */ /* adjusted to reflect ownership of the allocated pages. */ /* The changes made by this routine to the target EK file become */ /* permanent when the file is closed. Failure to close the file */ /* properly will leave it in an indeterminate state. */ /* $ Examples */ /* See ZZEKWPAI. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* Allocate the pages. */ zzekpgan_(handle, type__, p, base); i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { zzekpgan_(handle, type__, &p2, &b); } if (failed_()) { return 0; } /* Initialize the pages. */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /* Zero out the page's link count and forward pointer. */ i__2 = *p + i__ - 1; zzekslnk_(handle, type__, &i__2, &c__0); i__2 = *p + i__ - 1; zzeksfwd_(handle, type__, &i__2, &c__0); } /* Update the segment's metadata. Insert the number of each new */ /* page into the page tree of the appropriate data type. */ if (*type__ == 1) { tree = segdsc[7]; } else if (*type__ == 2) { tree = segdsc[8]; } else { /* The remaining possibility is that TYPE is INT. If we had had */ /* an unrecognized type, one of the allocation routines would have */ /* complained. */ tree = segdsc[9]; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *p + i__ - 1; zzektrap_(handle, &tree, &i__2, &idx); } return 0; } /* zzekacps_ */
/* $Procedure SCPART ( Spacecraft Clock Partition Information ) */ /* Subroutine */ int scpart_(integer *sc, integer *nparts, doublereal *pstart, doublereal *pstop) { /* Initialized data */ static logical first = TRUE_; static logical nodata = TRUE_; static integer oldsc = 0; /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_rnge(char *, integer, char *, integer); double d_nint(doublereal *); /* Local variables */ extern /* Subroutine */ int zzcvpool_(char *, integer *, logical *, ftnlen), zzctruin_(integer *); integer i__; extern /* Subroutine */ int scld01_(char *, integer *, integer *, integer *, doublereal *, ftnlen), chkin_(char *, ftnlen), repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen); static doublereal prtsa[9999], prtso[9999]; extern logical failed_(void); char kvname[60*2]; logical update; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen); integer nprtsa; extern logical return_(void); static integer usrctr[2]; extern /* Subroutine */ int swpool_(char *, integer *, char *, ftnlen, ftnlen); integer nprtso; static integer lstprt; /* $ Abstract */ /* Get spacecraft clock partition information from a spacecraft */ /* clock kernel file. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SCLK */ /* $ Keywords */ /* TIME */ /* $ Declarations */ /* $ Abstract */ /* Include file sclk.inc */ /* SPICE private file intended solely for the support of SPICE */ /* routines. Users should not include this file directly due */ /* to the volatile nature of this file */ /* The parameters below define sizes and limits used by */ /* the SCLK system. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Parameters */ /* See the declaration section below. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */ /* Increased value of maximum coefficient record count */ /* parameter MXCOEF from 10K to 50K. */ /* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */ /* -& */ /* Number of supported SCLK field delimiters: */ /* Supported SCLK string field delimiters: */ /* Maximum number of partitions: */ /* Partition string length. */ /* Since the maximum number of partitions is given by MXPART is */ /* 9999, PRTSTR needs at most 4 characters for the partition number */ /* and one character for the slash. */ /* Maximum number of coefficient records: */ /* Maximum number of fields in an SCLK string: */ /* Length of strings used to represent D.P. */ /* numbers: */ /* Maximum number of supported parallel time systems: */ /* End of include file sclk.inc */ /* $ Abstract */ /* This include file defines the dimension of the counter */ /* array used by various SPICE subsystems to uniquely identify */ /* changes in their states. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Parameters */ /* CTRSIZ is the dimension of the counter array used by */ /* various SPICE subsystems to uniquely identify */ /* changes in their states. */ /* $ Author_and_Institution */ /* B.V. Semenov (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */ /* -& */ /* End of include file. */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* SC I NAIF spacecraft identification code. */ /* NPARTS O The number of spacecraft clock partitions. */ /* PSTART O Array of partition start times. */ /* PSTOP O Array of partition stop times. */ /* MXPART P Maximum number of partitions. */ /* $ Detailed_Input */ /* SC is the NAIF ID for the spacecraft whose clock partition */ /* information is being requested. */ /* $ Detailed_Output */ /* NPARTS is the number of spacecraft clock time partitions */ /* described in the kernel file for spacecraft SC. */ /* PSTART is an array containing NPARTS partition start times */ /* represented as double precision, encoded SCLK */ /* ("ticks"). The values contained in PSTART are whole */ /* numbers. */ /* PSTOP is an array containing NPARTS partition end times */ /* represented as double precision, encoded SCLK */ /* ("ticks"). The values contained in PSTOP are whole */ /* numbers. */ /* $ Parameters */ /* MXPART is the maximum number of partitions for any spacecraft */ /* clock. SCLK kernels contain start and stop times for */ /* each partition. See the INCLUDE file sclk.inc for this */ /* parameter's value. */ /* $ Exceptions */ /* 1) If the kernel variables containing the spacecraft clock */ /* partition start and stop times have not been loaded in the */ /* kernel pool, the error will be diagnosed by routines called */ /* by this routine. */ /* 2) If the number of start and stop times are different then */ /* the error SPICE(NUMPARTSUNEQUAL) is signaled. */ /* $ Files */ /* An SCLK kernel containing spacecraft clock partition start */ /* and stop times for the spacecraft clock indicated by SC must */ /* be loaded into the kernel pool. */ /* $ Particulars */ /* SCPART looks for two variables in the kernel pool for each */ /* spacecraft's partition information. If SC = -nn, then the names of */ /* the variables are */ /* 'SCLK_PARTITION_START_nn' and */ /* 'SCLK_PARTITION_END_nn'. */ /* The start and stop times returned are in units of "ticks". */ /* $ Examples */ /* 1) The following program fragment finds and prints out partition */ /* start and stop times in clock format for the Galileo mission. */ /* In this example, Galileo partition times are assumed to be */ /* in the kernel file SCLK.KER. */ /* CHARACTER*(30) START */ /* CHARACTER*(30) STOP */ /* CALL FURNSH ( 'SCLK.KER' ) */ /* SC = -77 */ /* CALL SCPART ( SC, NPARTS, PSTART, PSTOP ) */ /* DO I = 1, NPARTS */ /* CALL SCFMT ( SC, PSTART( I ), START ) */ /* CALL SCFMT ( SC, PSTOP ( I ), STOP ) */ /* WRITE (*,*) */ /* WRITE (*,*) 'Partition ', I, ':' */ /* WRITE (*,*) 'Start = ', START */ /* WRITE (*,*) 'Stop = ', STOP */ /* END DO */ /* $ Restrictions */ /* 1) This routine assumes that an SCLK kernel appropriate to the */ /* spacecraft identified by SC has been loaded into the kernel */ /* pool. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* J.M. Lynch (JPL) */ /* B.V. Semenov (JPL) */ /* R.E. Thurman (JPL) */ /* $ Version */ /* - SPICELIB Version 2.3.1, 19-MAR-2014 (NJB) */ /* Minor header comment updates were made. */ /* - SPICELIB Version 2.3.0, 09-SEP-2013 (BVS) */ /* Updated to keep track of the POOL counter and call ZZCVPOOL. */ /* - SPICELIB Version 2.2.0, 05-MAR-2009 (NJB) */ /* Bug fix: this routine now keeps track of whether its */ /* kernel pool look-up succeeded. If not, a kernel pool */ /* lookup is attempted on the next call to this routine. */ /* - SPICELIB Version 2.1.0, 05-FEB-2008 (NJB) */ /* The values of the parameter MXPART is now */ /* provided by the INCLUDE file sclk.inc. */ /* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */ /* Replaced references to LDPOOL with references */ /* to FURNSH. */ /* - SPICELIB Version 1.1.0, 22-MAR-1993 (JML) */ /* The routine now uses the kernel pool watch capability. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) (JML) (RET) */ /* -& */ /* $ Index_Entries */ /* spacecraft_clock partition information */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Saved variables */ /* Initial values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("SCPART", (ftnlen)6); /* On the first pass through the subroutine, or if the */ /* spacecraft code changes, set watches on the SCLK kernel */ /* variables for the current clock. */ if (first || *sc != oldsc) { /* Make up a list of names of kernel variables that we'll use. */ s_copy(kvname, "SCLK_PARTITION_START", (ftnlen)60, (ftnlen)20); s_copy(kvname + 60, "SCLK_PARTITION_END", (ftnlen)60, (ftnlen)18); for (i__ = 1; i__ <= 2; ++i__) { suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("kvname", i__1, "scpart_", (ftnlen)284)) * 60, (ftnlen)2, (ftnlen)60); i__3 = -(*sc); repmi_(kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("kvname", i__1, "scpart_", (ftnlen)285)) * 60, "#", &i__3, kvname + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("kvname", i__2, "scpart_", (ftnlen)285)) * 60, (ftnlen)60, (ftnlen)1, (ftnlen)60); } /* Set a watch on all of the kernel variables used. */ swpool_("SCPART", &c__2, kvname, (ftnlen)6, (ftnlen)60); /* Keep track of the last spacecraft ID encountered. */ oldsc = *sc; /* Initialize the local POOL counter to user value. */ zzctruin_(usrctr); first = FALSE_; } /* If any of the kernel pool variables that this routine uses */ /* have been updated, or if the spacecraft ID changes, look up */ /* the new values from the kernel pool. */ zzcvpool_("SCPART", usrctr, &update, (ftnlen)6); if (update || nodata) { /* Read the values from the kernel pool. */ scld01_("SCLK_PARTITION_START", sc, &c__9999, &nprtsa, prtsa, (ftnlen) 20); scld01_("SCLK_PARTITION_END", sc, &c__9999, &nprtso, prtso, (ftnlen) 18); if (failed_()) { nodata = TRUE_; chkout_("SCPART", (ftnlen)6); return 0; } /* Error checking. */ if (nprtsa != nprtso) { nodata = TRUE_; setmsg_("The number of partition start and stop times are unequa" "l for spacecraft #. ", (ftnlen)78); errint_("#", sc, (ftnlen)1); sigerr_("SPICE(NUMPARTSUNEQUAL)", (ftnlen)22); chkout_("SCPART", (ftnlen)6); return 0; } /* At this point we have the data we sought. We need not */ /* perform another kernel pool look-up unless there's */ /* a kernel pool update or change in the SCLK ID. */ nodata = FALSE_; /* Buffer the number of partitions and the partition start */ /* and stop times. */ lstprt = nprtsa; /* The partition start and stop times must be whole numbers. */ i__1 = lstprt; for (i__ = 1; i__ <= i__1; ++i__) { prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtsa" , i__2, "scpart_", (ftnlen)360)] = d_nint(&prtsa[(i__3 = i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtsa", i__3, "scpart_", (ftnlen)360)]); prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtso" , i__2, "scpart_", (ftnlen)361)] = d_nint(&prtso[(i__3 = i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtso", i__3, "scpart_", (ftnlen)361)]); } } /* Copy the values in local buffers to the output arguments. */ *nparts = lstprt; i__1 = *nparts; for (i__ = 1; i__ <= i__1; ++i__) { pstart[i__ - 1] = prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtsa", i__2, "scpart_", (ftnlen)372)]; pstop[i__ - 1] = prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtso", i__2, "scpart_", (ftnlen)373)]; } chkout_("SCPART", (ftnlen)6); return 0; } /* scpart_ */
/* $Procedure ZZEKJSQZ ( Private: EK, join row set squeeze ) */ /* Subroutine */ int zzekjsqz_(integer *jrsbas) { /* System generated locals */ integer i__1, i__2, i__3, i__4; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ integer ntab, size; extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *); integer i__, j, delta, rbase, nrloc, ptarg, ntloc, rtarg, vtarg; extern logical failed_(void); integer rc, nr, segvec[10], pcpair[2], ptbase, setbas, cntloc, nsvdel, nrvdel, svbase, nsvloc, ptrloc, rowvec[11], sizloc, newnsv, rvsize, svsize, nsv; extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *); /* $ 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. */ /* Compress a join row set by eliminating segment vectors for */ /* which there are no corresponding row vectors. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Join Row Set Parameters */ /* ekjrs.inc Version 1 07-FEB-1995 (NJB) */ /* Maximum number of join row sets in a join row set union: */ /* The layout of a join row set in the EK scratch area is shown */ /* below: */ /* +--------------------------------------------+ */ /* | join row set size | 1 element */ /* +--------------------------------------------+ */ /* | number of row vectors in join row set | 1 element */ /* +--------------------------------------------+ */ /* | table count (TC) | 1 element */ /* +--------------------------------------------+ */ /* | segment vector count (SVC) | 1 element */ /* +--------------------------------------------+ */ /* | segment vector 1 | TC elements */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | segment vector SVC | TC elements */ /* +--------------------------------------------+ */ /* | segment vector 1 row set base address | 1 element */ /* +--------------------------------------------+ */ /* | segment vector 1 row count (RC_1) | 1 element */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | segment vector SVC row set base address | 1 element */ /* +--------------------------------------------+ */ /* | segment vector SVC row count (RC_SVC) | 1 element */ /* +--------------------------------------------+ */ /* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */ /* +--------------------------------------------+ elements */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */ /* +--------------------------------------------+ elements */ /* The following parameters indicate positions of elements in the */ /* join row set structure: */ /* Base-relative index of join row set size */ /* Index of row vector count */ /* Index of table count */ /* Index of segment vector count */ /* Base address of first segment vector */ /* End Include Section: EK Join Row Set Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Query Limit Parameters */ /* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ /* Parameter MAXCON increased to 1000. */ /* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ /* Updated to support SELECT clause. */ /* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ /* These limits apply to character string queries input to the */ /* EK scanner. This limits are part of the EK system's user */ /* interface: the values should be advertised in the EK required */ /* reading document. */ /* Maximum length of an input query: MAXQRY. This value is */ /* currently set to twenty-five 80-character lines. */ /* Maximum number of columns that may be listed in the */ /* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ /* Maximum number of tables that may be listed in the `FROM */ /* clause' of a query: MAXTAB. */ /* Maximum number of relational expressions that may be listed */ /* in the `constraint clause' of a query: MAXCON. */ /* This limit applies to a query when it is represented in */ /* `normalized form': that is, the constraints have been */ /* expressed as a disjunction of conjunctions of relational */ /* expressions. The number of relational expressions in a query */ /* that has been expanded in this fashion may be greater than */ /* the number of relations in the query as orginally written. */ /* For example, the expression */ /* ( ( A LT 1 ) OR ( B GT 2 ) ) */ /* AND */ /* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ /* which contains 4 relational expressions, expands to the */ /* equivalent normalized constraint */ /* ( ( A LT 1 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ /* which contains eight relational expressions. */ /* MXJOIN is the maximum number of tables that can be joined. */ /* MXJCON is the maximum number of join constraints allowed. */ /* Maximum number of order-by columns that may be used in the */ /* `order-by clause' of a query: MAXORD. MAXORD = 10. */ /* Maximum number of tokens in a query: 500. Tokens are reserved */ /* words, column names, parentheses, and values. Literal strings */ /* and time values count as single tokens. */ /* Maximum number of numeric tokens in a query: */ /* Maximum total length of character tokens in a query: */ /* Maximum length of literal string values allowed in queries: */ /* MAXSTR. */ /* End Include Section: EK Query Limit Parameters */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* JRSBAS I Scratch area base address of join row set. */ /* $ Detailed_Input */ /* JRSBAS is the base address, in the scratch area, of a */ /* join row set to be compressed. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If JRSBAS is not the base address of a structurally valid */ /* join row set, the results of this routine will be */ /* unpredictable. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine operates by side effects: it modifies the join row */ /* set designated by the input argument JRSBAS. Every row vector */ /* marked for deletion is removed. Every empty segment vector is */ /* removed, along with the row count and row vector base for that */ /* segment vector. The join row set is compressed to remove all */ /* gaps. All counts are updated to reflect the updated join row */ /* set. */ /* The purpose of the compression performed by this routine is to */ /* save work during joins by reducing the size of the cartesian */ /* products of sets of segment vectors. Also, special cases */ /* involving null segment vectors can be avoided by this clean-up */ /* mechanism. Finally, it may be possible to save space in the EK */ /* scratch area freed by the compression. */ /* $ Examples */ /* See EKSRCH. */ /* $ Restrictions */ /* 1) Relies on the EK scratch area. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 07-AUG-2006 (NJB) */ /* Bug fix: added intialization of variable NRVDEL to support */ /* operation under the Macintosh Intel Fortran */ /* compiler. Note that this bug did not affect */ /* operation of this routine on other platforms. */ /* - SPICELIB Version 1.0.0, 10-OCT-1995 (NJB) */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 07-AUG-2006 (NJB) */ /* Bug fix: added intialization of variable NRVDEL to support */ /* operation under the Macintosh Intel Fortran */ /* compiler. Note that this bug did not affect */ /* operation of this routine on other platforms. The */ /* statement referencing the uninitialized variable */ /* was: */ /* IF ( ( RC .EQ. 0 ) .OR. ( NRVDEL .EQ. RC ) ) THEN */ /* In the previous version of the code, NRVDEL is uninitialized */ /* when NRVDEL is 0. NRVDEL *is* initialized when RC is */ /* non-zero, so the logical value of the IF expression is not */ /* affected by the lack of proper intialization. */ /* However, the Intel Fortran compiler for the Mac flags a runtime */ /* error when the above code is exercised. So NRVDEL is now */ /* initialized prior to the above IF statement. */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* Look up the counts that are of interest: */ /* -- The table count */ /* -- The segment vector count */ /* -- The join row set size */ /* Save the address of each count. */ sizloc = *jrsbas + 1; nsvloc = *jrsbas + 4; ntloc = *jrsbas + 3; zzeksrd_(&sizloc, &sizloc, &size); zzeksrd_(&ntloc, &ntloc, &ntab); zzeksrd_(&nsvloc, &nsvloc, &nsv); if (failed_()) { return 0; } /* Set the sizes of segment and row vectors. */ svsize = ntab; rvsize = ntab + 1; /* For each segment vector, obtain the row count. Clean up after */ /* null segment vectors: compress out the space allocated for their */ /* row vector pointers. Keep track of the number of deletions. */ nsvdel = 0; nrvdel = 0; vtarg = *jrsbas + 4; i__1 = nsv; for (i__ = 1; i__ <= i__1; ++i__) { /* The location of the row count is CNTLOC. The row vector base */ /* pointer precedes the row count. */ cntloc = *jrsbas + 4 + nsv * svsize + (i__ - 1 << 1) + 2; ptrloc = cntloc - 1; zzeksrd_(&cntloc, &cntloc, &rc); if (rc > 0) { /* The row vector set for this segment vector is non-empty. */ /* scan the rows, looking for those marked for deletion, and */ /* update the row count to reflect the number of rows that */ /* we're going to keep. */ zzeksrd_(&ptrloc, &ptrloc, &setbas); nrvdel = 0; i__2 = rc; for (j = 1; j <= i__2; ++j) { rbase = *jrsbas + setbas + (j - 1) * rvsize; i__3 = rbase + 1; i__4 = rbase + 1; zzeksrd_(&i__3, &i__4, rowvec); if (rowvec[0] == 0) { ++nrvdel; } } } /* Compute the base address of the current segment vector. */ svbase = *jrsbas + 4 + (i__ - 1) * svsize; if (rc == 0 || nrvdel == rc) { /* We're going to delete the current segment vector. We'll */ /* just skip over it without advancing our target pointers. */ ++nsvdel; } else if (nsvdel > 0) { /* We need to shift the current segment vector to its */ /* destination. */ i__2 = svbase + 1; i__3 = svbase + svsize; zzeksrd_(&i__2, &i__3, segvec); i__2 = vtarg + 1; i__3 = vtarg + svsize; zzeksupd_(&i__2, &i__3, segvec); vtarg += svsize; } else { /* No segment vectors have been deleted yet. We still must */ /* update the target in case we shift vectors later on in this */ /* loop. */ vtarg += svsize; } } /* At this point, we've compressed out the null segment vectors. */ /* The next step is to compress out the row vector counts and row */ /* vector pointers that corresponded to those segment vectors. We */ /* also want to remove the gap between the segment vectors and the */ /* row vector pointer/count pairs. */ /* We need to do this only if we deleted some segment vectors. */ if (nsvdel > 0) { newnsv = nsv - nsvdel; ptarg = *jrsbas + 4 + newnsv * svsize; i__1 = nsv; for (i__ = 1; i__ <= i__1; ++i__) { /* The row count is RC. */ svsize = ntab; cntloc = *jrsbas + 4 + nsv * svsize + (i__ - 1 << 1) + 2; zzeksrd_(&cntloc, &cntloc, &rc); ptbase = cntloc - 2; if (rc > 0) { /* Shift the current row vector pointer and row vector */ /* count. */ i__2 = ptbase + 1; i__3 = ptbase + 2; zzeksrd_(&i__2, &i__3, pcpair); i__2 = ptarg + 1; i__3 = ptarg + 2; zzeksupd_(&i__2, &i__3, pcpair); ptarg += 2; } } } else { newnsv = nsv; } /* Update the segment vector count. */ zzeksupd_(&nsvloc, &nsvloc, &newnsv); /* Remove any gaps that may exist between any of the row vectors, */ /* or between the end of the segment vector's row vector counts */ /* and base addresses and the first row vector. */ /* The initial target location is the first element following the */ /* last segment vector's row vector count. RTARG is used as a base */ /* address; it precedes this location by 1. */ /* If we deleted any segment vectors, the segment vector pointers */ /* embedded in the row vectors must change. Make these updates */ /* if necessary. */ rtarg = *jrsbas + 4 + newnsv * (svsize + 2); i__1 = newnsv; for (i__ = 1; i__ <= i__1; ++i__) { /* Find the row count and row pointer for the current segment */ /* vector. */ cntloc = *jrsbas + 4 + newnsv * svsize + (i__ - 1 << 1) + 2; zzeksrd_(&cntloc, &cntloc, &rc); ptrloc = cntloc - 1; /* Get the row vector set base pointer. After capturing the */ /* current value, we'll update this pointer to account for */ /* the shifting of row vectors. */ zzeksrd_(&ptrloc, &ptrloc, &setbas); rbase = *jrsbas + setbas; delta = rtarg - rbase; i__2 = setbas + delta; zzeksupd_(&ptrloc, &ptrloc, &i__2); /* Shift the row vectors for the current segment vector, */ /* leaving behind the row vectors marked for deletion. */ nrvdel = 0; i__2 = rc; for (j = 1; j <= i__2; ++j) { i__3 = rbase + 1; i__4 = rbase + rvsize; zzeksrd_(&i__3, &i__4, rowvec); if (rowvec[0] == 0) { /* This row vector is to be deleted; don't copy it. */ rbase += rvsize; ++nrvdel; } else { /* The segment vector pointer is base-relative. */ rowvec[(i__3 = rvsize - 1) < 11 && 0 <= i__3 ? i__3 : s_rnge( "rowvec", i__3, "zzekjsqz_", (ftnlen)415)] = (i__ - 1) * svsize + 4; i__3 = rtarg + 1; i__4 = rtarg + rvsize; zzeksupd_(&i__3, &i__4, rowvec); rbase += rvsize; rtarg += rvsize; } } /* Update the row count for the current segment vector, if */ /* necessary. Note that no segment vector will become empty */ /* as a result of the row vector deletions we've done; we */ /* already eliminated any segment vectors for which that */ /* could happen, before we entered this loop. */ if (nrvdel > 0) { i__2 = rc - nrvdel; zzeksupd_(&cntloc, &cntloc, &i__2); } } /* Update the total row count and size of the join row set. */ nr = 0; i__1 = newnsv; for (i__ = 1; i__ <= i__1; ++i__) { cntloc = *jrsbas + 4 + newnsv * svsize + (i__ - 1 << 1) + 2; zzeksrd_(&cntloc, &cntloc, &rc); nr += rc; } nrloc = *jrsbas + 2; size = newnsv * (svsize + 2) + 4 + nr * rvsize; zzeksupd_(&nrloc, &nrloc, &nr); zzeksupd_(&sizloc, &sizloc, &size); return 0; } /* zzekjsqz_ */
/* $Procedure ZZEKUE04 ( EK, update column entry, class 4 ) */ /* Subroutine */ int zzekue04_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, integer *nvals, integer *ivals, logical * isnull) { extern /* Subroutine */ int chkin_(char *, ftnlen); extern logical failed_(void), return_(void); extern /* Subroutine */ int chkout_(char *, ftnlen), zzekad04_(integer *, integer *, integer *, integer *, integer *, integer *, logical *), zzekde04_(integer *, integer *, integer *, integer *); /* $ Abstract */ /* Update a specified class 4 column entry in an EK record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Record pointer. */ /* NVALS I Number of values. */ /* IVALS I Integer values. */ /* ISNULL I Null flag. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* SEGDSC is the descriptor of the segment containing */ /* the specified column entry. */ /* COLDSC is the descriptor of the column containing */ /* the specified column entry. */ /* RECPTR is a pointer to the record containing the column */ /* entry to update. */ /* NVALS is the number of values in the replacement */ /* column entry. */ /* IVALS is an array of integer values with which to update */ /* the specified column entry. */ /* ISNULL is a logical flag indicating whether the value */ /* of the specified column entry is to be set to NULL. */ /* If so, the input IVALS is ignored. */ /* $ Detailed_Output */ /* None. See the $Particulars section for a description of the */ /* effect of this routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. The file will not be modified. */ /* 2) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. The file may be corrupted. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: it updates a column entry */ /* in an EK segment. The status of the record containing the entry */ /* is set to `updated'. If the column containing the entry is */ /* indexed, the corresponding index is updated. */ /* The changes made by this routine to the target EK file become */ /* permanent when the file is closed. Failure to close the file */ /* properly will leave it in an indeterminate state. */ /* $ Examples */ /* See EKUCEI. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKUE04", (ftnlen)8); } /* Get rid of the old column entry first. */ zzekde04_(handle, segdsc, coldsc, recptr); if (failed_()) { chkout_("ZZEKUE04", (ftnlen)8); return 0; } /* We've reduced the problem to a solved one: that of adding */ /* a column entry. */ zzekad04_(handle, segdsc, coldsc, recptr, nvals, ivals, isnull); chkout_("ZZEKUE04", (ftnlen)8); return 0; } /* zzekue04_ */
/* $Procedure ZZLDKER ( Load a kernel ) */ /* Subroutine */ int zzldker_(char *file, char *nofile, char *filtyp, integer *handle, ftnlen file_len, ftnlen nofile_len, ftnlen filtyp_len) { /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ char arch[32]; extern /* Subroutine */ int zzbodkik_(void), eklef_(char *, integer *, ftnlen), chkin_(char *, ftnlen), cklpf_(char *, integer *, ftnlen) , errch_(char *, char *, ftnlen, ftnlen); char versn[32]; extern logical failed_(void); extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen, ftnlen, ftnlen), pcklof_(char *, integer *, ftnlen), spklef_(char *, integer *, ftnlen), ldpool_(char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); extern logical exists_(char *, ftnlen), return_(void); char mytype[32]; extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, 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. */ /* Determine the architecture and type of a file and load */ /* the file into the appropriate SPICE subsystem */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* PRIVATE */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* FILE I The name of a file to be loaded. */ /* NOFILE I A message to issue if FILE cannot be located */ /* FILTYP O The type of kernel. */ /* HANDLE O The handle associated with the loaded kernel. */ /* $ Detailed_Input */ /* FILE is the name of a file that is anticipated to */ /* be a SPICE kernel. */ /* NOFILE is a template for the message that should be created */ /* with SETMSG if a problem is identified with FILE. The */ /* message should have the form: "[text] '#' [text] #" The */ /* first octothorpe ('#') will be replaced by the name of */ /* the file. The second by a descriptive message. */ /* $ Detailed_Output */ /* FILTYP is the type of the kernel as determined by the */ /* SPICE file record of the file or by various */ /* heuristics. Possible return values are: */ /* TEXT --- if FILE is interpreted as a text kernel */ /* suitable for loading via LDPOOL. No */ /* attempt is made to distinguish between */ /* different types of text kernels. */ /* SPK | */ /* CK | */ /* PCK |--- if FILE is a binary PCK file. */ /* EK | */ /* If a failure occurs during the attempt to load */ /* the FILE, FILTYP will be returned as the blank string. */ /* HANDLE is the DAF or DAS handle that is associated with the */ /* file. If the FILTYP of the file is 'TEXT', HANDLE */ /* will be set to zero. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the specified file does not exist, the error */ /* SPICE(NOSUCHFILE) will be signaled. */ /* 2) If the specified file can be identified as unloadable */ /* because it is a transfer format file, the error */ /* SPICE(TRANSFERFILE) will be signaled. */ /* 3) If the specified file can be identified as unloadable */ /* because it is an obsolete text E-kernel, the error */ /* SPICE(TYPE1TEXTEK) will be signaled. */ /* 4) If the specified file can be recognized as a DAF/DAS file */ /* but is not one of the currently recognized binary kernel */ /* types, the error SPICE(UNKNOWNKERNELTYPE) will be signaled. */ /* 5) FILTYP is not sufficiently long to hold the full text of the */ /* type of the kernel, the value returned will be the truncation */ /* of the value. As currently implemented this truncated type is */ /* sufficient to distinguish between the various types of */ /* kernels. */ /* 6) If the FILE cannot be loaded, HANDLE will be set to zero. */ /* 7) All other problems associated with the loading of FILE */ /* are diagnosed by the routines called by this routine. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine is intended as a supporting routine for the */ /* SPICE routine FURNSH. It handles the task of loading */ /* an arbitrary kernel without the caller having to specify */ /* the type of the kernel. */ /* $ Examples */ /* None. (After all it's a private routine) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* E.D. Wright (JPL) */ /* B.V. Semenov (JPL) */ /* $ Version */ /* - SPICELIB Version 1.17.0, 10-MAR-2014 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-INTEL. */ /* - SPICELIB Version 1.16.0, 10-MAR-2014 (BVS) */ /* Updated for PC-LINUX-64BIT-IFORT. */ /* - SPICELIB Version 1.15.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-GFORTRAN. */ /* - SPICELIB Version 1.14.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */ /* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL. */ /* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ /* Updated for PC-WINDOWS-64BIT-IFORT. */ /* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ /* Updated for PC-LINUX-64BIT-GFORTRAN. */ /* - SPICELIB Version 1.10.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-IFORT. */ /* - SPICELIB Version 1.9.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-GFORTRAN. */ /* - SPICELIB Version 1.8.0, 18-MAR-2009 (BVS) */ /* Updated for PC-LINUX-GFORTRAN. */ /* - SPICELIB Version 1.7.0, 18-MAR-2009 (BVS) */ /* Updated for MAC-OSX-GFORTRAN. */ /* - SPICELIB Version 1.6.0, 19-FEB-2008 (BVS) */ /* Updated for PC-LINUX-IFORT. */ /* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-IFORT. */ /* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ /* Updated for PC-WINDOWS-IFORT. */ /* - SPICELIB Version 1.3.0, 03-OCT-2005 (EDW) */ /* Source file zzldker.f converted to master file. */ /* Modification occurred to prevent f2c's versions */ /* from making the zzascii test. CSPICE now */ /* includes coed to allow reading of non native text files. */ /* - SPICELIB Version 1.2.0, 17-FEB-2004 (EDW) (BVS) */ /* Added the ZZASCII terminator test for text files. Used a */ /* working line length of 132 characters (maximum text kernel */ /* line size.) */ /* - SPICELIB Version 1.1.0, 24-JUN-2002 (EDW) */ /* Added a call to ZZBODKIK to run the */ /* NAIF_BODY_NAME/CODE read/check routine */ /* whenever a text kernel loads. */ /* - SPICELIB Version 1.0.0, 04-JUN-1999 (WLT) */ /* -& */ /* SPICELIB Functions */ /* Local Variables. */ if (return_()) { return 0; } chkin_("ZZLDKER", (ftnlen)7); if (! exists_(file, file_len)) { setmsg_(nofile, nofile_len); errch_("#", file, (ftnlen)1, file_len); errch_("#", "could not be located.", (ftnlen)1, (ftnlen)21); sigerr_("SPICE(NOSUCHFILE)", (ftnlen)17); chkout_("ZZLDKER", (ftnlen)7); return 0; } getfat_(file, arch, mytype, file_len, (ftnlen)32, (ftnlen)32); /* Possible values for the architecture are: */ /* DAF -- The file is based on the DAF architecture. */ /* DAS -- The file is based on the DAS architecture. */ /* XFR -- The file is in a SPICE transfer file format. */ /* DEC -- The file is an old SPICE decimal text file. */ /* ASC -- An ASCII text file. */ /* KPL -- Kernel Pool File (i.e., a text kernel) */ /* TXT -- An ASCII text file. */ /* TE1 -- Text E-Kernel type 1. */ /* ? -- The architecture could not be determined. */ /* Some of these are obviously losers. */ if (s_cmp(arch, "XFR", (ftnlen)32, (ftnlen)3) == 0 || s_cmp(arch, "DEC", ( ftnlen)32, (ftnlen)3) == 0) { setmsg_(nofile, nofile_len); errch_("#", file, (ftnlen)1, file_len); errch_("#", "is a transfer format file. Transfer format files cannot" " be loaded. ", (ftnlen)1, (ftnlen)67); sigerr_("SPICE(TRANSFERFILE)", (ftnlen)19); chkout_("ZZLDKER", (ftnlen)7); return 0; } else if (s_cmp(arch, "TE1", (ftnlen)32, (ftnlen)3) == 0) { setmsg_(nofile, nofile_len); errch_("#", file, (ftnlen)1, file_len); errch_("#", "is a type 1 text E-kernel. These files are obsolete an" "d cannot be loaded. ", (ftnlen)1, (ftnlen)75); sigerr_("SPICE(TYPE1TEXTEK)", (ftnlen)18); chkout_("ZZLDKER", (ftnlen)7); return 0; } /* That takes care of the obvious errors. Try loading the */ /* kernel. */ *handle = 0; s_copy(filtyp, " ", filtyp_len, (ftnlen)1); if (s_cmp(arch, "DAF", (ftnlen)32, (ftnlen)3) == 0) { if (s_cmp(mytype, "SPK", (ftnlen)32, (ftnlen)3) == 0) { spklef_(file, handle, file_len); } else if (s_cmp(mytype, "CK", (ftnlen)32, (ftnlen)2) == 0) { cklpf_(file, handle, file_len); } else if (s_cmp(mytype, "PCK", (ftnlen)32, (ftnlen)3) == 0) { pcklof_(file, handle, file_len); } else { tkvrsn_("TOOLKIT", versn, (ftnlen)7, (ftnlen)32); setmsg_(nofile, nofile_len); errch_("#", file, (ftnlen)1, file_len); errch_("#", "is a \"#\" DAF file. This kind of binary file is no" "t supported in version # of the SPICE toolkit. Check wit" "h NAIF to see if your toolkit version is up to date. ", ( ftnlen)1, (ftnlen)158); errch_("#", mytype, (ftnlen)1, (ftnlen)32); errch_("#", versn, (ftnlen)1, (ftnlen)32); sigerr_("SPICE(UNKNOWNKERNELTYPE)", (ftnlen)24); chkout_("ZZLDKER", (ftnlen)7); return 0; } s_copy(filtyp, mytype, filtyp_len, (ftnlen)32); } else if (s_cmp(arch, "DAS", (ftnlen)32, (ftnlen)3) == 0) { if (s_cmp(mytype, "EK", (ftnlen)32, (ftnlen)2) == 0) { eklef_(file, handle, file_len); } else { tkvrsn_("TOOLKIT", versn, (ftnlen)7, (ftnlen)32); setmsg_(nofile, nofile_len); errch_("#", file, (ftnlen)1, file_len); errch_("#", "is a \"#\" DAS file. This kind of binary file is n" "ot supported in version # of the SPICE toolkit. Check wi" "th NAIF to see if your toolkit version is up to date. ", ( ftnlen)1, (ftnlen)159); errch_("#", mytype, (ftnlen)1, (ftnlen)32); errch_("#", versn, (ftnlen)1, (ftnlen)32); sigerr_("SPICE(UNKNOWNKERNELTYPE)", (ftnlen)24); chkout_("ZZLDKER", (ftnlen)7); return 0; } s_copy(filtyp, mytype, filtyp_len, (ftnlen)32); } else { /* Load the file using the text file loader. */ ldpool_(file, file_len); if (! failed_()) { s_copy(filtyp, "TEXT", filtyp_len, (ftnlen)4); /* Cause the kernel pool mechanism to perform */ /* the standard error checks on the pool */ /* data. */ zzbodkik_(); } } chkout_("ZZLDKER", (ftnlen)7); return 0; } /* zzldker_ */
/* $Procedure ZZSPKGO1 ( S/P Kernel, geometric state ) */ /* Subroutine */ int zzspkgo1_(integer *targ, doublereal *et, char *ref, integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len) { /* Initialized data */ static logical first = TRUE_; /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, char *, integer); /* Local variables */ extern /* Subroutine */ int zzfrmch1_(integer *, integer *, doublereal *, doublereal *); integer cobs, legs; doublereal sobs[6]; extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *, integer *, doublereal *), zznamfrm_(integer *, char *, integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer *); integer i__; extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, doublereal *), etcal_(doublereal *, char *, ftnlen); integer refid; extern /* Subroutine */ int chkin_(char *, ftnlen); char oname[40]; doublereal descr[5]; integer ctarg[20]; char ident[40], tname[40]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), moved_(doublereal *, integer *, doublereal *); logical found; extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen); doublereal starg[120] /* was [6][20] */; logical nofrm; static char svref[32]; extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, doublereal *); doublereal stemp[6]; integer ctpos; doublereal vtemp[6]; extern doublereal vnorm_(doublereal *); extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen); static integer svctr1[2]; extern logical failed_(void); extern /* Subroutine */ int cleard_(integer *, doublereal *); integer handle, cframe; extern doublereal clight_(void); integer tframe[20]; extern integer isrchi_(integer *, integer *, integer *); extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen); static integer svrefi; extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_( char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen); integer tmpfrm; extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), spksfs_(integer *, doublereal *, integer *, doublereal *, char *, logical *, ftnlen); extern integer frstnp_(char *, ftnlen); extern logical return_(void); extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); doublereal stxfrm[36] /* was [6][6] */; extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); integer nct; doublereal rot[9] /* was [3][3] */; extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) ; char tstring[80]; /* $ Abstract */ /* SPICE Private routine intended solely for the support of SPICE */ /* routines. Users should not call this routine directly due */ /* to the volatile nature of this routine. */ /* Compute the geometric state (position and velocity) of a target */ /* body relative to an observing body. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPK */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ Abstract */ /* This file contains the number of inertial reference */ /* frames that are currently known by the SPICE toolkit */ /* software. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* FRAMES */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* NINERT P Number of known inertial reference frames. */ /* $ Parameters */ /* NINERT is the number of recognized inertial reference */ /* frames. This value is needed by both CHGIRF */ /* ZZFDAT, and FRAMEX. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */ /* -& */ /* $ Abstract */ /* This include file defines the dimension of the counter */ /* array used by various SPICE subsystems to uniquely identify */ /* changes in their states. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Parameters */ /* CTRSIZ is the dimension of the counter array used by */ /* various SPICE subsystems to uniquely identify */ /* changes in their states. */ /* $ Author_and_Institution */ /* B.V. Semenov (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */ /* -& */ /* End of include file. */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* TARG I Target body. */ /* ET I Target epoch. */ /* REF I Target reference frame. */ /* OBS I Observing body. */ /* STATE O State of target. */ /* LT O Light time. */ /* $ Detailed_Input */ /* TARG is the standard NAIF ID code for a target body. */ /* ET is the epoch (ephemeris time) at which the state */ /* of the target body is to be computed. */ /* REF is the name of the reference frame to */ /* which the vectors returned by the routine should */ /* be rotated. This may be any frame supported by */ /* the SPICELIB subroutine ZZFRMCH1. */ /* OBS is the standard NAIF ID code for an observing body. */ /* $ Detailed_Output */ /* STATE contains the geometric position and velocity of the */ /* target body, relative to the observing body, at epoch */ /* ET. STATE has six elements: the first three contain */ /* the target's position; the last three contain the */ /* target's velocity. These vectors are transformed into */ /* the specified reference frame. Units are always km */ /* and km/sec. */ /* LT is the one-way light time in seconds from the */ /* observing body to the geometric position of the */ /* target body at the specified epoch. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If insufficient ephemeris data has been loaded to compute */ /* the necessary states, the error SPICE(SPKINSUFFDATA) is */ /* signaled. */ /* $ Files */ /* See: $Restrictions. */ /* $ Particulars */ /* ZZSPKGO1 computes the geometric state, T(t), of the target */ /* body and the geometric state, O(t), of the observing body */ /* relative to the first common center of motion. Subtracting */ /* O(t) from T(t) gives the geometric state of the target */ /* body relative to the observer. */ /* CENTER ----- O(t) */ /* | / */ /* | / */ /* | / */ /* | / T(t) - O(t) */ /* | / */ /* T(t) */ /* The one-way light time, tau, is given by */ /* | T(t) - O(t) | */ /* tau = ----------------- */ /* c */ /* For example, if the observing body is -94, the Mars Observer */ /* spacecraft, and the target body is 401, Phobos, then the */ /* first common center is probably 4, the Mars Barycenter. */ /* O(t) is the state of -94 relative to 4 and T(t) is the */ /* state of 401 relative to 4. */ /* The center could also be the Solar System Barycenter, body 0. */ /* For example, if the observer is 399, Earth, and the target */ /* is 299, Venus, then O(t) would be the state of 399 relative */ /* to 0 and T(t) would be the state of 299 relative to 0. */ /* Ephemeris data from more than one segment may be required */ /* to determine the states of the target body and observer */ /* relative to a common center. ZZSPKGO1 reads as many segments */ /* as necessary, from as many files as necessary, using files */ /* that have been loaded by previous calls to SPKLEF (load */ /* ephemeris file). */ /* ZZSPKGO1 is similar to SPKEZ but returns geometric states */ /* only, with no option to make planetary (light-time) nor */ /* stellar aberration corrections. The geometric states */ /* returned by SPKEZ and ZZSPKGO1 are the same. */ /* $ Examples */ /* The following code example computes the geometric */ /* state of the moon with respect to the earth and */ /* then prints the distance of the moon from the */ /* the earth at a number of epochs. */ /* Assume the SPK file SAMPLE.BSP contains ephemeris data */ /* for the moon relative to earth over the time interval */ /* from BEGIN to END. */ /* INTEGER EARTH */ /* PARAMETER ( EARTH = 399 ) */ /* INTEGER MOON */ /* PARAMETER ( MOON = 301 ) */ /* INTEGER N */ /* PARAMETER ( N = 100 ) */ /* INTEGER I */ /* CHARACTER*(20) UTC */ /* DOUBLE PRECISION BEGIN */ /* DOUBLE PRECISION DELTA */ /* DOUBLE PRECISION END */ /* DOUBLE PRECISION ET */ /* DOUBLE PRECISION LT */ /* DOUBLE PRECISION STATE ( 6 ) */ /* DOUBLE PRECISION VNORM */ /* C */ /* C Load the binary SPK ephemeris file. */ /* C */ /* CALL FURNSH ( 'SAMPLE.BSP' ) */ /* . */ /* . */ /* . */ /* C */ /* C Divide the interval of coverage [BEGIN,END] into */ /* C N steps. At each step, compute the state, and */ /* C print out the epoch in UTC time and position norm. */ /* C */ /* DELTA = ( END - BEGIN ) / N */ /* DO I = 0, N */ /* ET = BEGIN + I*DELTA */ /* CALL ZZSPKGO1 ( MOON, ET, 'J2000', EARTH, STATE, LT ) */ /* CALL ET2UTC ( ET, 'C', 0, UTC ) */ /* WRITE (*,*) UTC, VNORM ( STATE ) */ /* END DO */ /* $ Restrictions */ /* 1) SPICE Private routine. */ /* 2) The ephemeris files to be used by ZZSPKGO1 must be loaded */ /* by SPKLEF before ZZSPKGO1 is called. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* J.E. McLean (JPL) */ /* B.V. Semenov (JPL) */ /* W.L. Taber (JPL) */ /* W.D. Wright (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */ /* Updated to save the input frame name and POOL state counter */ /* and to do frame name-ID conversion only if the counter has */ /* changed. */ /* Updated to map the input frame name to its ID by first calling */ /* ZZNAMFRM, and then calling IRFNUM. The side effect of this */ /* change is that now the frame with the fixed name 'DEFAULT' */ /* that can be associated with any code via CHGIRF's entry point */ /* IRFDEF will be fully masked by a frame with indentical name */ /* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */ /* frame masked the text kernel frame with the same name. */ /* Fixed description of STATE in Detailed Output. Replaced */ /* SPKLEF with FURNSH and fixed errors in Examples. */ /* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in VADDG calls. */ /* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */ /* Based on SPICELIB Version 2.3.0, 05-JAN-2005 (NJB) */ /* -& */ /* $ Index_Entries */ /* geometric state of one body relative to another */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in VADDG calls. */ /* -& */ /* This is the idea: */ /* Every body moves with respect to some center. The center */ /* is itself a body, which in turn moves about some other */ /* center. If we begin at the target body (T), follow */ /* the chain, */ /* T */ /* \ */ /* SSB \ */ /* \ C[1] */ /* \ / */ /* \ / */ /* \ / */ /* \ / */ /* C[3]-----------C[2] */ /* and avoid circular definitions (A moves about B, and B moves */ /* about A), eventually we get the state relative to the solar */ /* system barycenter (which, for our purposes, doesn't move). */ /* Thus, */ /* T = T + C[1] + C[2] + ... + C[n] */ /* SSB C[1] C[2] [C3] SSB */ /* where */ /* X */ /* Y */ /* is the state of body X relative to body Y. */ /* However, we don't want to follow each chain back to the SSB */ /* if it isn't necessary. Instead we will just follow the chain */ /* of the target body and follow the chain of the observing body */ /* until we find a common node in the tree. */ /* In the example below, C is the first common node. We compute */ /* the state of TARG relative to C and the state of OBS relative */ /* to C, then subtract the two states. */ /* TARG */ /* \ */ /* SSB \ */ /* \ A */ /* \ / OBS */ /* \ / | */ /* \ / | */ /* \ / | */ /* B-------------C-----------------D */ /* SPICELIB functions */ /* Local parameters */ /* CHLEN is the maximum length of a chain. That is, */ /* it is the maximum number of bodies in the chain from */ /* the target or observer to the SSB. */ /* Saved frame name length. */ /* Local variables */ /* Saved frame name/ID item declarations. */ /* Saved frame name/ID items. */ /* Initial values. */ /* In-line Function Definitions */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZSPKGO1", (ftnlen)8); } /* Initialization. */ if (first) { /* Initialize counter. */ zzctruin_(svctr1); first = FALSE_; } /* We take care of the obvious case first. It TARG and OBS are the */ /* same we can just fill in zero. */ if (*targ == *obs) { *lt = 0.; cleard_(&c__6, state); chkout_("ZZSPKGO1", (ftnlen)8); return 0; } /* CTARG contains the integer codes of the bodies in the */ /* target body chain, beginning with TARG itself and then */ /* the successive centers of motion. */ /* STARG(1,I) is the state of the target body relative */ /* to CTARG(I). The id-code of the frame of this state is */ /* stored in TFRAME(I). */ /* COBS and SOBS will contain the centers and states of the */ /* observing body. (They are single elements instead of arrays */ /* because we only need the current center and state of the */ /* observer relative to it.) */ /* First, we construct CTARG and STARG. CTARG(1) is */ /* just the target itself, and STARG(1,1) is just a zero */ /* vector, that is, the state of the target relative */ /* to itself. */ /* Then we follow the chain, filling up CTARG and STARG */ /* as we go. We use SPKSFS to search through loaded */ /* files to find the first segment applicable to CTARG(1) */ /* and time ET. Then we use SPKPVN to compute the state */ /* of the body CTARG(1) at ET in the segment that was found */ /* and get its center and frame of motion (CTARG(2) and TFRAME(2). */ /* We repeat the process for CTARG(2) and so on, until */ /* there is no data found for some CTARG(I) or until we */ /* reach the SSB. */ /* Next, we find centers and states in a similar manner */ /* for the observer. It's a similar construction as */ /* described above, but I is always 1. COBS and SOBS */ /* are overwritten with each new center and state, */ /* beginning at OBS. However, we stop when we encounter */ /* a common center of motion, that is when COBS is equal */ /* to CTARG(I) for some I. */ /* Finally, we compute the desired state of the target */ /* relative to the observer by subtracting the state of */ /* the observing body relative to the common node from */ /* the state of the target body relative to the common */ /* node. */ /* CTPOS is the position in CTARG of the common node. */ /* Since the upgrade to use hashes and counter bypass ZZNAMFRM */ /* became more efficient in looking up frame IDs than IRFNUM. So the */ /* original order of calls "IRFNUM first, NAMFRM second" was */ /* switched to "ZZNAMFRM first, IRFNUM second". */ /* The call to IRFNUM, now redundant for built-in inertial frames, */ /* was preserved to for a sole reason -- to still support the */ /* ancient and barely documented ability for the users to associate */ /* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */ /* frame code via CHGIRF's entry point IRFDEF. */ /* Note that in the case of ZZNAMFRM's failure to resolve name and */ /* IRFNUM's success to do so, the code returned by IRFNUM for */ /* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */ /* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */ /* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */ /* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */ /* should it change between the calls. */ zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len); if (refid == 0) { irfnum_(ref, &refid, ref_len); } if (refid == 0) { if (frstnp_(ref, ref_len) > 0) { setmsg_("The string supplied to specify the reference frame, ('#" "') contains non-printing characters. The two most commo" "n causes for this kind of error are: 1. an error in the " "call to ZZSPKGO1; 2. an uninitialized variable. ", ( ftnlen)215); errch_("#", ref, (ftnlen)1, ref_len); } else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) { setmsg_("The string supplied to specify the reference frame is b" "lank. The most common cause for this kind of error is a" "n uninitialized variable. ", (ftnlen)137); } else { setmsg_("The string supplied to specify the reference frame was " "'#'. This frame is not recognized. Possible causes for " "this error are: 1. failure to load the frame definition " "into the kernel pool; 2. An out-of-date edition of the t" "oolkit. ", (ftnlen)231); errch_("#", ref, (ftnlen)1, ref_len); } sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } } /* Fill in CTARG and STARG until no more data is found */ /* or until we reach the SSB. If the chain gets too */ /* long to fit in CTARG, that is if I equals CHLEN, */ /* then overwrite the last elements of CTARG and STARG. */ /* Note the check for FAILED in the loop. If SPKSFS */ /* or SPKPVN happens to fail during execution, and the */ /* current error handling action is to NOT abort, then */ /* FOUND may be stuck at TRUE, CTARG(I) will never */ /* become zero, and the loop will execute indefinitely. */ /* Construct CTARG and STARG. Begin by assigning the */ /* first elements: TARG and the state of TARG relative */ /* to itself. */ i__ = 1; ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, "zzspkgo1_", (ftnlen)615)] = *targ; found = TRUE_; cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)618)]); while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, "zzspkgo1_", (ftnlen)620)] != *obs && ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", i__2, "zzspkgo1_", (ftnlen)620)] != 0) { /* Find a file and segment that has state */ /* data for CTARG(I). */ spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "ctarg", i__1, "zzspkgo1_", (ftnlen)629)], et, &handle, descr, ident, &found, (ftnlen)40); if (found) { /* Get the state of CTARG(I) relative to some */ /* center of motion. This new center goes in */ /* CTARG(I+1) and the state is called STEMP. */ ++i__; spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen) 639)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)639)], & ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge( "ctarg", i__3, "zzspkgo1_", (ftnlen)639)]); /* Here's what we have. STARG is the state of CTARG(I-1) */ /* relative to CTARG(I) in reference frame TFRAME(I) */ /* If one of the routines above failed during */ /* execution, we just give up and check out. */ if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } } } tframe[0] = tframe[1]; /* If the loop above ended because we ran out of */ /* room in the arrays CTARG and STARG, then we */ /* continue finding states but we overwrite the */ /* last elements of CTARG and STARG. */ /* If, as a result, the first common node is */ /* overwritten, we'll just have to settle for */ /* the last common node. This will cause a small */ /* loss of precision, but it's better than other */ /* alternatives. */ if (i__ == 20) { while(found && ctarg[19] != 0 && ctarg[19] != *obs) { /* Find a file and segment that has state */ /* data for CTARG(CHLEN). */ spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40) ; if (found) { /* Get the state of CTARG(CHLEN) relative to */ /* some center of motion. The new center */ /* overwrites the old. The state is called */ /* STEMP. */ spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]); /* Add STEMP to the state of TARG relative to */ /* the old center to get the state of TARG */ /* relative to the new center. Overwrite */ /* the last element of STARG. */ if (tframe[19] == tmpfrm) { moved_(&starg[114], &c__6, vtemp); } else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && tframe[19] <= 21) { irfrot_(&tframe[19], &tmpfrm, rot); mxv_(rot, &starg[114], vtemp); mxv_(rot, &starg[117], &vtemp[3]); } else { zzfrmch1_(&tframe[19], &tmpfrm, et, stxfrm); if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } mxvg_(stxfrm, &starg[114], &c__6, &c__6, vtemp); } vaddg_(vtemp, stemp, &c__6, &starg[114]); tframe[19] = tmpfrm; /* If one of the routines above failed during */ /* execution, we just give up and check out. */ if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } } } } nct = i__; /* NCT is the number of elements in CTARG, */ /* the chain length. We have in hand the following information */ /* STARG(1...6,K) state of body */ /* CTARG(K-1) relative to body CTARG(K) in the frame */ /* TFRAME(K) */ /* For K = 2,..., NCT. */ /* CTARG(1) = TARG */ /* STARG(1...6,1) = ( 0, 0, 0, 0, 0, 0 ) */ /* TFRAME(1) = TFRAME(2) */ /* Now follow the observer's chain. Assign */ /* the first values for COBS and SOBS. */ cobs = *obs; cleard_(&c__6, sobs); /* Perhaps we have a common node already. */ /* If so it will be the last node on the */ /* list CTARG. */ /* We let CTPOS will be the position of the common */ /* node in CTARG if one is found. It will */ /* be zero if COBS is not found in CTARG. */ if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, "zzspkgo1_", (ftnlen)775)] == cobs) { ctpos = nct; cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "tframe", i__1, "zzspkgo1_", (ftnlen)777)]; } else { ctpos = 0; } /* Repeat the same loop as above, but each time */ /* we encounter a new center of motion, check to */ /* see if it is a common node. (When CTPOS is */ /* not zero, CTARG(CTPOS) is the first common node.) */ /* Note that we don't need a centers array nor a */ /* states array, just a single center and state */ /* is sufficient --- we just keep overwriting them. */ /* When the common node is found, we have everything */ /* we need in that one center (COBS) and state */ /* (SOBS-state of the target relative to COBS). */ found = TRUE_; nofrm = TRUE_; legs = 0; while(found && cobs != 0 && ctpos == 0) { /* Find a file and segment that has state */ /* data for COBS. */ spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40); if (found) { /* Get the state of COBS; call it STEMP. */ /* The center of motion of COBS becomes the */ /* new COBS. */ if (legs == 0) { spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs); } else { spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs); } if (nofrm) { nofrm = FALSE_; cframe = tmpfrm; } /* Add STEMP to the state of OBS relative to */ /* the old COBS to get the state of OBS */ /* relative to the new COBS. */ if (cframe == tmpfrm) { /* On the first leg of the state of the observer, we */ /* don't have to add anything, the state of the observer */ /* is already in SOBS. We only have to add when the */ /* number of legs in the observer state is one or greater. */ if (legs > 0) { vaddg_(sobs, stemp, &c__6, vtemp); moved_(vtemp, &c__6, sobs); } } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= 21) { irfrot_(&cframe, &tmpfrm, rot); mxv_(rot, sobs, vtemp); mxv_(rot, &sobs[3], &vtemp[3]); vaddg_(vtemp, stemp, &c__6, sobs); cframe = tmpfrm; } else { zzfrmch1_(&cframe, &tmpfrm, et, stxfrm); if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } mxvg_(stxfrm, sobs, &c__6, &c__6, vtemp); vaddg_(vtemp, stemp, &c__6, sobs); cframe = tmpfrm; } /* Check failed. We don't want to loop */ /* indefinitely. */ if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } /* We now have one more leg of the path for OBS. Set */ /* LEGS to reflect this. Then see if the new center */ /* is a common node. If not, repeat the loop. */ ++legs; ctpos = isrchi_(&cobs, &nct, ctarg); } } /* If CTPOS is zero at this point, it means we */ /* have not found a common node though we have */ /* searched through all the available data. */ if (ctpos == 0) { bodc2n_(targ, tname, &found, (ftnlen)40); if (found) { prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40); suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40); repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40) ; } else { intstr_(targ, tname, (ftnlen)40); } bodc2n_(obs, oname, &found, (ftnlen)40); if (found) { prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40); suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40); repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40); } else { intstr_(obs, oname, (ftnlen)40); } setmsg_("Insufficient ephemeris data has been loaded to compute the " "state of TARG relative to OBS at the ephemeris epoch #. ", ( ftnlen)115); etcal_(et, tstring, (ftnlen)80); errch_("TARG", tname, (ftnlen)4, (ftnlen)40); errch_("OBS", oname, (ftnlen)3, (ftnlen)40); errch_("#", tstring, (ftnlen)1, (ftnlen)80); sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20); chkout_("ZZSPKGO1", (ftnlen)8); return 0; } /* If CTPOS is not zero, then we have reached a */ /* common node, specifically, */ /* CTARG(CTPOS) = COBS = CENTER */ /* (in diagram below). The STATE of the target */ /* (TARG) relative to the observer (OBS) is just */ /* STARG(1,CTPOS) - SOBS. */ /* SOBS */ /* CENTER ---------------->OBS */ /* | . */ /* | . */ /* S | . E */ /* T | . T */ /* A | . A */ /* R | . T */ /* G | . S */ /* | . */ /* | . */ /* V L */ /* TARG */ /* And the light-time between them is just */ /* | STATE | */ /* LT = --------- */ /* c */ /* Compute the state of the target relative to CTARG(CTPOS) */ if (ctpos == 1) { tframe[0] = cframe; } i__1 = ctpos - 1; for (i__ = 2; i__ <= i__1; ++i__) { if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe" , i__2, "zzspkgo1_", (ftnlen)973)] == tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgo1_", ( ftnlen)973)]) { vaddg_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)975)], &starg[( i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : s_rnge("starg", i__3, "zzspkgo1_", (ftnlen)975)], &c__6, vtemp); moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", ( ftnlen)976)]); } else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( "tframe", i__3, "zzspkgo1_", (ftnlen)978)] > 0 && tframe[( i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgo1_", (ftnlen)978)] <= 21 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgo1_", ( ftnlen)978)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgo1_", (ftnlen)978)] <= 21) { irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgo1_", (ftnlen)980)], & tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( "tframe", i__3, "zzspkgo1_", (ftnlen)980)], rot); mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)981)], stemp); mxv_(rot, &starg[(i__2 = i__ * 6 - 3) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)982)], &stemp[ 3]); vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen) 983)], &c__6, vtemp); moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", ( ftnlen)984)]); } else { zzfrmch1_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgo1_", (ftnlen)988)], & tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge( "tframe", i__3, "zzspkgo1_", (ftnlen)988)], et, stxfrm); if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } mxvg_(stxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen)995)], & c__6, &c__6, stemp); vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", (ftnlen) 996)], &c__6, vtemp); moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo1_", ( ftnlen)997)]); } } /* To avoid unnecessary frame transformations we'll do */ /* a bit of extra decision making here. It's a lot */ /* faster to make logical checks than it is to compute */ /* frame transformations. */ if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen)1010)] == cframe) { vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)1012)], sobs, & c__6, state); } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "tframe", i__1, "zzspkgo1_", (ftnlen)1014)] == refid) { /* If the last frame associated with the target is already */ /* in the requested output frame, we convert the state of */ /* the observer to that frame and then subtract the state */ /* of the observer from the state of the target. */ if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { irfrot_(&cframe, &refid, rot); mxv_(rot, sobs, stemp); mxv_(rot, &sobs[3], &stemp[3]); } else { zzfrmch1_(&cframe, &refid, et, stxfrm); if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } mxvg_(stxfrm, sobs, &c__6, &c__6, stemp); } /* We've now transformed SOBS into the requested reference frame. */ /* Set CFRAME to reflect this. */ cframe = refid; vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)1046)], stemp, & c__6, state); } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen) 1049)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen)1049)] <= 21) { /* If both frames are inertial we use IRFROT instead of */ /* ZZFRMCH1 to get things into a common frame. */ irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "tframe", i__1, "zzspkgo1_", (ftnlen)1055)], &cframe, rot); mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)1056)], stemp); mxv_(rot, &starg[(i__1 = ctpos * 6 - 3) < 120 && 0 <= i__1 ? i__1 : s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)1057)], &stemp[3]); vsubg_(stemp, sobs, &c__6, state); } else { /* Use the more general routine ZZFRMCH1 to make the */ /* transformation. */ zzfrmch1_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo1_", (ftnlen)1065)], &cframe, et, stxfrm); if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } mxvg_(stxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : s_rnge("starg", i__1, "zzspkgo1_", (ftnlen)1072)], &c__6, & c__6, stemp); vsubg_(stemp, sobs, &c__6, state); } /* Finally, rotate as needed into the requested frame. */ if (cframe == refid) { /* We don't have to do anything in this case. */ } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) { /* Since both frames are inertial, we use the more direct */ /* routine IRFROT to get the transformation to REFID. */ irfrot_(&cframe, &refid, rot); mxv_(rot, state, stemp); mxv_(rot, &state[3], &stemp[3]); moved_(stemp, &c__6, state); } else { zzfrmch1_(&cframe, &refid, et, stxfrm); if (failed_()) { chkout_("ZZSPKGO1", (ftnlen)8); return 0; } mxvg_(stxfrm, state, &c__6, &c__6, stemp); moved_(stemp, &c__6, state); } *lt = vnorm_(state) / clight_(); chkout_("ZZSPKGO1", (ftnlen)8); return 0; } /* zzspkgo1_ */
/* $Procedure ZZEKRD04 ( EK, read class 4 column entry elements ) */ /* Subroutine */ int zzekrd04_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, integer *beg, integer *end, integer *ivals, logical *isnull, logical *found) { /* System generated locals */ integer i__1, i__2; /* Local variables */ integer base, nrec, nelt; extern integer zzekrp2n_(integer *, integer *, integer *); integer unit; extern /* Subroutine */ int zzekgfwd_(integer *, integer *, integer *, integer *), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_( integer *, integer *, integer *, integer *); integer p, nread; extern /* Subroutine */ int chkin_(char *, ftnlen); integer recno, ncols, ptemp, start; extern logical failed_(void); extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, integer *); integer remain, colidx, datptr, maxidx, minidx, ptrloc; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen); /* $ Abstract */ /* Read a specified element range from a column entry in a specified */ /* record in a class 4 column. Class 4 columns have integer arrays */ /* as column entries. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Record pointer. */ /* BEG I Start element index. */ /* END I End element index. */ /* IVALS O Integer values in column entry. */ /* ISNULL O Flag indicating whether column entry is null. */ /* FOUND O Flag indicating whether elements were found. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. */ /* SEGDSC is the descriptor of the segment from which data is */ /* to be read. */ /* COLDSC is the descriptor of the column from which data is */ /* to be read. */ /* RECPTR is a pointer to the record containing the column */ /* entry to be written. */ /* BEG, */ /* END are, respectively, the start and end indices of */ /* the contiguous range of elements to be read from */ /* the specified column entry. */ /* $ Detailed_Output */ /* IVALS are the values read from the specified column */ /* entry. The mapping of elements of the column entry */ /* to elements of IVALS is as shown below: */ /* Column entry element IVALS element */ /* -------------------- ------------- */ /* BEG 1 */ /* BEG+1 2 */ /* . . */ /* . . */ /* . . */ /* END END-BEG+1 */ /* IVALS is valid only if the output argument */ /* FOUND is returned .TRUE. */ /* ISNULL is a logical flag indicating whether the entry is */ /* null. ISNULL is set on output whether or not */ /* the range of elements designated by BEG and END */ /* exists. */ /* FOUND is a logical flag indicating whether the range */ /* of elements designated by BEG and END exists. */ /* If the number of elements in the specified column */ /* entry is not at least END, FOUND will be returned */ /* .FALSE. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If the specified column entry has not been initialized, the */ /* error SPICE(UNINITIALIZEDVALUE) is signalled. */ /* 3) If the ordinal position of the column specified by COLDSC */ /* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ /* 4) If an I/O error occurs while reading the indicated file, */ /* the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine is a utility for reading data from class 4 columns. */ /* $ Examples */ /* See EKRCEI. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in ZZEKGFWD call. */ /* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in ZZEKGFWD call. */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ nrec = segdsc[5]; /* Make sure the column exists. */ ncols = segdsc[4]; colidx = coldsc[8]; if (colidx < 1 || colidx > ncols) { chkin_("ZZEKRD04", (ftnlen)8); setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); errint_("#", &colidx, (ftnlen)1); errint_("#", &nrec, (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKRD04", (ftnlen)8); return 0; } /* Compute the data pointer location, and read the pointer. */ ptrloc = *recptr + 2 + colidx; dasrdi_(handle, &ptrloc, &ptrloc, &datptr); if (datptr > 0) { /* The entry is non-null. */ *isnull = FALSE_; /* Get the element count. Check for range specifications that */ /* can't be met. */ dasrdi_(handle, &datptr, &datptr, &nelt); if (*beg < 1 || *beg > nelt) { *found = FALSE_; return 0; } else if (*end < 1 || *end > nelt) { *found = FALSE_; return 0; } else if (*end < *beg) { *found = FALSE_; return 0; } /* The request is valid, so read the data. The first step is to */ /* locate the element at index BEG. */ zzekpgpg_(&c__3, &datptr, &p, &base); minidx = 1; maxidx = base + 254 - datptr; datptr += *beg; while(maxidx < *beg) { /* Locate the page on which the element is continued. */ i__1 = base + 255; i__2 = base + 255; dasrdi_(handle, &i__1, &i__2, &p); /* Determine the highest-indexed element of the column entry */ /* located on the current page. */ zzekpgbs_(&c__3, &p, &base); minidx = maxidx + 1; /* Computing MIN */ i__1 = maxidx + 254; maxidx = min(i__1,nelt); /* The following assignment will set DATPTR to the correct */ /* value on the last pass through this loop. */ datptr = base + 1 + (*beg - minidx); } /* At this point, P is the page on which the element having index */ /* BEG is located. BASE is the base address of this page. */ /* MAXIDX is the highest index of any element on the current page. */ remain = *end - *beg + 1; start = 1; /* Decide how many elements to read from the current page, and */ /* read them. */ /* Computing MIN */ i__1 = remain, i__2 = base + 254 - datptr + 1; nread = min(i__1,i__2); i__1 = datptr + nread - 1; dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]); remain -= nread; while(remain > 0 && ! failed_()) { /* Locate the page on which the element is continued. */ zzekgfwd_(handle, &c__3, &p, &ptemp); p = ptemp; zzekpgbs_(&c__3, &p, &base); datptr = base + 1; start += nread; nread = min(remain,254); i__1 = datptr + nread - 1; dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]); remain -= nread; } *found = ! failed_(); } else if (datptr == -2) { /* The value is null. */ *isnull = TRUE_; *found = TRUE_; } else if (datptr == -1) { /* The data value is absent. This is an error. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); chkin_("ZZEKRD04", (ftnlen)8); setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" "OLIDX = #; RECNO = #; EK = #", (ftnlen)87); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &colidx, (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25); chkout_("ZZEKRD04", (ftnlen)8); return 0; } else { /* The data pointer is corrupted. */ dashlu_(handle, &unit); chkin_("ZZEKRD04", (ftnlen)8); setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " "#; EK = #", (ftnlen)68); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &colidx, (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKRD04", (ftnlen)8); return 0; } return 0; } /* zzekrd04_ */
/* $Procedure DAFDC ( DAF delete comments ) */ /* Subroutine */ int dafdc_(integer *handle) { integer free; extern /* Subroutine */ int chkin_(char *, ftnlen); integer bward, fward, ncomr, nd; extern logical failed_(void); integer ni; extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen); char ifname[60]; extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char *, integer *, integer *, integer *, ftnlen), dafrrr_(integer *, integer *), chkout_(char *, ftnlen); extern logical return_(void); /* $ Abstract */ /* Delete the entire comment area of a previously opened binary */ /* DAF attached to HANDLE. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAF */ /* $ Keywords */ /* None. */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I The handle of a binary DAF opened for writing. */ /* $ Detailed_Input */ /* HANDLE The handle of a binary DAF that is to have its entire */ /* comment area deleted. The DAF must have been opened */ /* with write access. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the binary DAF attached to HANDLE is not open with write */ /* access, an error will be signalled by a routine called by */ /* this routine. */ /* $ Files */ /* See argument HANDLE in $ Detailed_Input. */ /* $ Particulars */ /* A binary DAF contains an area which is reserved for storing */ /* annotations or descriptive textual information about the data */ /* contained in a file. This area is referred to as the ``comment */ /* area'' of the file. The comment area of a DAF is a line */ /* oriented medium for storing textual information. The comment */ /* area preserves any leading or embedded white space in the line(s) */ /* of text which are stored, so that the appearance of the of */ /* information will be unchanged when it is retrieved (extracted) at */ /* some other time. Trailing blanks, however, are NOT preserved, */ /* due to the way that character strings are represented in */ /* standard Fortran 77. */ /* This routine will delete the entire comment area from the binary */ /* DAF attached to HANDLE. The size of the binary DAF will remain */ /* unchanged. The space that was used by the comment records */ /* is reclaimed. */ /* $ Examples */ /* Let */ /* HANDLE be the handle of a DAF which has been opened */ /* with write access. */ /* The call */ /* CALL DAFDC ( HANDLE ) */ /* deletes the entire comment area of the binary DAF attached to */ /* HANDLE. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 23-SEP-1994 (KRG) */ /* -& */ /* $ Index_Entries */ /* delete DAF comment area */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Length of a DAF file internal filename. */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("DAFDC", (ftnlen)5); } /* Verify that the DAF attached to HANDLE was opened with write */ /* access. */ dafsih_(handle, "WRITE", (ftnlen)5); if (failed_()) { chkout_("DAFDC", (ftnlen)5); return 0; } /* Read the file record to obtain the current number of comment */ /* records in the DAF attached to HANDLE. We will also get back some */ /* extra stuff that we do not use. */ dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60); ncomr = fward - 2; if (failed_()) { chkout_("DAFDC", (ftnlen)5); return 0; } /* Now we will attempt to remove the comment records, if there are */ /* any, otherwise we do nothing. */ if (ncomr > 0) { /* We have some comment records, so remove them. */ dafrrr_(handle, &ncomr); if (failed_()) { chkout_("DAFDC", (ftnlen)5); return 0; } } /* We're done now, so goodbye. */ chkout_("DAFDC", (ftnlen)5); return 0; } /* dafdc_ */
/* $Procedure LTIME ( Light Time ) */ /* Subroutine */ int ltime_(doublereal *etobs, integer *obs, char *dir, integer *targ, doublereal *ettarg, doublereal *elapsd, ftnlen dir_len) { /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ doublereal sobs[6], myet, c__; integer r__; extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); doublereal starg[6]; extern doublereal vdist_(doublereal *, doublereal *); extern integer rtrim_(char *, ftnlen); extern logical failed_(void); doublereal lt; extern doublereal clight_(void); integer bcentr; extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); extern logical return_(void); /* $ Abstract */ /* This routine computes the transmit (or receive) time */ /* of a signal at a specified target, given the receive */ /* (or transmit) time at a specified observer. The elapsed */ /* time between transmit and receive is also returned. */ /* $ 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 */ /* SPK */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* ETOBS I Epoch of a signal at some observer */ /* OBS I NAIF-id of some observer */ /* DIR I Direction the signal travels ( '->' or '<-' ) */ /* TARG I NAIF-id of the target object */ /* ETTARG O Epoch of the signal at the target */ /* ELAPSD O Time between transmit and receipt of the signal */ /* $ Detailed_Input */ /* ETOBS is an epoch expressed in ephemeris second (TDB) */ /* past the epoch of the J2000 reference system. */ /* This is the time at which an electromagnetic */ /* signal is "at" the observer. */ /* OBS is the NAIF-id of some observer. */ /* DIR is the direction the signal travels. The */ /* acceptable values are '->' and '<-'. When */ /* you read the calling sequence from left to */ /* right, the "arrow" given by DIR indicates */ /* which way the electromagnetic signal is travelling. */ /* If the argument list reads as below, */ /* ..., OBS, '->', TARG, ... */ /* the signal is travelling from the observer to the */ /* target. */ /* If the argument reads as */ /* ..., OBS, '<-', TARG */ /* the signal is travelling from the target to */ /* the observer. */ /* TARG is the NAIF-id of the target. */ /* $ Detailed_Output */ /* ETTARG is the epoch expressed in ephemeris seconds (TDB) */ /* past the epoch of the J2000 reference system */ /* at which the electromagnetic signal is "at" the */ /* target body. */ /* Note ETTARG is computed using only Newtonian */ /* assumptions about the propagation of light. */ /* ELAPSD is the number of ephemeris seconds (TDB) between */ /* transmission and receipt of the signal. */ /* ELAPSD = DABS( ETOBS - ETTARG ) */ /* $ Parameters */ /* None. */ /* $ Files */ /* None. */ /* $ Exceptions */ /* 1) If DIR is not one of '->' or '<-' the error */ /* 'SPICE(BADDIRECTION)' will be signalled. In this case */ /* ETTARG and ELAPSD will not be altered from their */ /* input values. */ /* 2) If insufficient ephemeris information is available to */ /* compute the outputs ETTARG and ELAPSD, or if observer */ /* or target is not recognized, the problems is diagnosed */ /* by a routine in the call tree of this routine. */ /* In this case, the value of ETTARG will be set to ETOBS */ /* and ELAPSD will be set to zero. */ /* $ Particulars */ /* Suppose a radio signal travels between two solar system */ /* objects. Given an ephemeris for the two objects, which way */ /* the signal is travelling, and the time when the signal is */ /* "at" at one of the objects (the observer OBS), this routine */ /* determines when the signal is "at" the other object (the */ /* target TARG). It also returns the elapsed time between */ /* transmission and receipt of the signal. */ /* $ Examples */ /* Example 1. */ /* ---------- */ /* Suppose a signal is transmitted at time ET from the Goldstone */ /* tracking site (id-code 399001) to a spacecraft whose id-code */ /* is -77. */ /* signal travelling to spacecraft */ /* * -._.-._.-._.-._.-._.-._.-._.-._.-> * */ /* Goldstone (OBS=399001) Spacecraft (TARG = -77) */ /* at epoch ETOBS(given) at epoch ETTARG(unknown) */ /* Assuming that all of the required SPICE kernels have been */ /* loaded, the code fragment below shows how to compute the */ /* time (ARRIVE) at which the signal arrives at the spacecraft */ /* and how long (HOWLNG) it took the signal to reach the spacecraft. */ /* (Note that we display the arrival time as the number of seconds */ /* past J2000.) */ /* OBS = 399001 */ /* TARG = -77 */ /* ETOBS = ET */ /* CALL LTIME ( ETOBS, OBS, '->', TARG, ARRIVE, HOWLNG ) */ /* CALL ETCAL */ /* WRITE (*,*) 'The signal arrived at time: ', ARRIVE */ /* WRITE (*,*) 'It took ', HOWLNG, ' seconds to get there.' */ /* Example 2. */ /* ---------- */ /* Suppose a signal is received at the Goldstone tracking sight */ /* at epoch ET from the spacecraft of the previous example. */ /* signal sent from spacecraft */ /* * <-._.-._.-._.-._.-._.-._.-._.-._.- * */ /* Goldstone (OBS=399001) Spacecraft (TARG = -77) */ /* at epoch ETOBS(given) at epoch ETTARG(unknown) */ /* Again assuming that all the required kernels have been loaded */ /* the code fragment below computes the epoch at which the */ /* signal was transmitted from the spacecraft. */ /* OBS = 399001 */ /* TARG = -77 */ /* ETOBS = ET */ /* CALL LTIME ( ETOBS, OBS, '<-', TARG, SENT, HOWLNG ) */ /* CALL ETCAL */ /* WRITE (*,*) 'The signal was transmitted at: ', SENT */ /* WRITE (*,*) 'It took ', HOWLNG, ' seconds to get here.' */ /* EXAMPLE 3 */ /* --------- */ /* Suppose there is a transponder on board the spacecraft of */ /* the previous examples that transmits a signal back to the */ /* sender exactly 1 microsecond after a signal arrives at */ /* the spacecraft. If we send a signal from Goldstone */ /* to the spacecraft and wait to receive it at Canberra. */ /* What will be the epoch at which the return signal arrives */ /* in Canberra? ( The id-code for Canberra is 399002 ). */ /* Again, assuming we've loaded all the necessary kernels, */ /* the fragment below will give us the answer. */ /* GSTONE = 399001 */ /* SC = -77 */ /* CANBER = 399002 */ /* ETGOLD = ET */ /* CALL LTIME ( ETGOLD, GSTONE, '->', SC, SCGET, LT1 ) */ /* Account for the microsecond delay between receipt and transmit */ /* SCSEND = SCGET + 0.000001 */ /* CALL LTIME ( SCSEND, SC, '->', CANBER, ETCANB, LT2 ) */ /* RNDTRP = ETCANB - ETGOLD */ /* WRITE (*,*) 'The signal arrives in Canberra at: ', ETCANB */ /* WRITE (*,*) 'Round trip time for the signal was: ', RNDTRP */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.1.2, 22-SEP-2004 (EDW) */ /* Placed Copyright after Abstract. */ /* - SPICELIB Version 1.1.1, 18-NOV-1996 (WLT) */ /* Errors in the examples section were corrected. */ /* - SPICELIB Version 1.1.0, 10-JUL-1996 (WLT) */ /* Added Copyright Notice to the header. */ /* - SPICELIB Version 1.0.0, 10-NOV-1995 (WLT) */ /* -& */ /* $ Index_Entries */ /* Compute uplink and downlink light time */ /* -& */ /* SPICELIB Functions */ /* Local Variables */ if (return_()) { return 0; } chkin_("LTIME", (ftnlen)5); /* First perform the obvious error check. */ if (s_cmp(dir, "->", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(dir, "<-", ( ftnlen)2, (ftnlen)2) != 0) { setmsg_("The direction specifier for the signal was '#' it must be " "either '->' or '<-'. ", (ftnlen)80); r__ = rtrim_(dir, (ftnlen)2); errch_("#", dir, (ftnlen)1, r__); sigerr_("SPICE(BADDIRECTION)", (ftnlen)19); chkout_("LTIME", (ftnlen)5); return 0; } /* We need two constants, the speed of light and the id-code */ /* for the solar system barycenter. */ c__ = clight_(); bcentr = 0; myet = *etobs; /* First get the barycenter relative states of the observer */ /* and target. */ spkgeo_(obs, &myet, "J2000", &bcentr, sobs, <, (ftnlen)5); spkgeo_(targ, &myet, "J2000", &bcentr, starg, <, (ftnlen)5); *elapsd = vdist_(sobs, starg) / c__; /* The rest is straight forward. We either add the elapsed */ /* time to get the next state or subtract the elapsed time. */ /* This depends on whether we are receiving or transmitting */ /* at the observer. */ /* Note that 3 iterations as performed here gives us */ /* Newtonian accuracy to the nanosecond level for all */ /* known objects in the solar system. The ephemeris */ /* is certain to be much worse than this. */ if (s_cmp(dir, "->", (ftnlen)2, (ftnlen)2) == 0) { *ettarg = myet + *elapsd; spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); *elapsd = vdist_(sobs, starg) / c__; *ettarg = myet + *elapsd; spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); *elapsd = vdist_(sobs, starg) / c__; *ettarg = myet + *elapsd; spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); *elapsd = vdist_(sobs, starg) / c__; *ettarg = myet + *elapsd; } else { *ettarg = myet - *elapsd; spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); *elapsd = vdist_(sobs, starg) / c__; *ettarg = myet - *elapsd; spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); *elapsd = vdist_(sobs, starg) / c__; *ettarg = myet - *elapsd; spkgeo_(targ, ettarg, "J2000", &bcentr, starg, <, (ftnlen)5); *elapsd = vdist_(sobs, starg) / c__; *ettarg = myet - *elapsd; } if (failed_()) { *ettarg = myet; *elapsd = 0.; } chkout_("LTIME", (ftnlen)5); return 0; } /* ltime_ */
/* $Procedure ZZEKIID1 ( EK, insert into index, d.p., type 1 ) */ /* Subroutine */ int zzekiid1_(integer *handle, integer *segdsc, integer * coldsc, doublereal *dkey, integer *recptr, logical *null) { /* System generated locals */ integer i__1; /* Local variables */ integer tree; extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, ftnlen), zzeklerd_(integer *, integer *, integer *, doublereal *, integer *, logical *, integer *, integer *), zzektrin_(integer *, integer *, integer *, integer *), chkin_(char *, ftnlen), errch_( char *, char *, ftnlen, ftnlen); integer dtype, itype; extern logical failed_(void); logical indexd; char column[32]; integer prvidx; extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *, ftnlen); integer prvptr; /* $ Abstract */ /* Insert into a type 1 EK index a record pointer associated with a */ /* d.p. key. The key and record pointer determine the insertion */ /* point via dictionary ordering on (value, record pointer) pairs. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Name Size */ /* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ /* Size of column name, in characters. */ /* End Include Section: EK Column Name Size */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Operator Codes */ /* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ /* Within the EK system, operators used in EK queries are */ /* represented by integer codes. The codes and their meanings are */ /* listed below. */ /* Relational expressions in EK queries have the form */ /* <column name> <operator> <value> */ /* For columns containing numeric values, the operators */ /* EQ, GE, GT, LE, LT, NE */ /* may be used; these operators have the same meanings as their */ /* Fortran counterparts. For columns containing character values, */ /* the list of allowed operators includes those in the above list, */ /* and in addition includes the operators */ /* LIKE, UNLIKE */ /* which are used to compare strings to a template. In the character */ /* case, the meanings of the parameters */ /* GE, GT, LE, LT */ /* match those of the Fortran lexical functions */ /* LGE, LGT, LLE, LLT */ /* The additional unary operators */ /* ISNULL, NOTNUL */ /* are used to test whether a value of any type is null. */ /* End Include Section: EK Operator Codes */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* DKEY I Double precision key. */ /* RECPTR I Record pointer. */ /* NULL I Null flag. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* SEGDSC is the segment descriptor of the segment */ /* containing the column specified by COLDSC. */ /* COLDSC is the column descriptor of the column to */ /* which the index corresponds. */ /* DKEY is a double precision key. */ /* RECPTR is a record pointer associated with the input key. */ /* NULL is a logical flag indicating whether the input */ /* value is null. */ /* $ Detailed_Output */ /* None. This routine operates by side effects. See $Particulars */ /* for a description of the effect of this routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If the data type of the input column is not double precision, */ /* the error SPICE(INVALIDTYPE) is signalled. */ /* 3) If the input column is not indexed, the error */ /* SPICE(NOTINDEXED) is signalled. */ /* 4) If the index type of the input column is not recognized, */ /* the error SPICE(INVALIDTYPE) is signalled. */ /* 5) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine updates the index of an EK segment to reflect the */ /* addition of a record to the segment. The index must be */ /* associated with a double precision, scalar column. The type of */ /* the double precision index must be 1. */ /* The ordinal position of the new item is determined by the key */ /* DKEY. The new item will follow the last item already present */ /* in the column having a value less than or equal to DKEY. */ /* In order to support the capability of creating an index for a */ /* column that has already been populated with data, this routine */ /* does not require that number of elements referenced by the */ /* input column's index match the number of elements in the column; */ /* the index is allowed to reference fewer elements. However, */ /* every record referenced by the index must be populated with data. */ /* $ Examples */ /* See ZZEKAD02. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */ /* Removed an unbalanced call to CHKOUT. */ /* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ if (failed_()) { return 0; } /* If the column's not indexed, we have no business being here. */ indexd = coldsc[5] != -1; if (! indexd) { zzekcnam_(handle, coldsc, column, (ftnlen)32); chkin_("ZZEKIID1", (ftnlen)8); setmsg_("Column # is not indexed.", (ftnlen)24); errch_("#", column, (ftnlen)1, (ftnlen)32); sigerr_("SPICE(NOTINDEXED)", (ftnlen)17); chkout_("ZZEKIID1", (ftnlen)8); return 0; } /* Check the column's data type. */ dtype = coldsc[1]; if (dtype != 2 && dtype != 4) { zzekcnam_(handle, coldsc, column, (ftnlen)32); chkin_("ZZEKIID1", (ftnlen)8); setmsg_("Column # should be DP or TIME but has type #.", (ftnlen)45); errch_("#", column, (ftnlen)1, (ftnlen)32); errint_("#", &dtype, (ftnlen)1); sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); chkout_("ZZEKIID1", (ftnlen)8); return 0; } itype = coldsc[5]; if (itype == 1) { /* Get the tree pointer from the column descriptor. */ tree = coldsc[6]; /* Locate the predecessor of the input key, record pointer pair. */ zzeklerd_(handle, segdsc, coldsc, dkey, recptr, null, &prvidx, & prvptr); /* Insert the new record pointer right after the item we've found. */ i__1 = prvidx + 1; zzektrin_(handle, &tree, &i__1, recptr); } else { zzekcnam_(handle, coldsc, column, (ftnlen)32); chkin_("ZZEKIID1", (ftnlen)8); setmsg_("Column # has index type #.", (ftnlen)26); errch_("#", column, (ftnlen)1, (ftnlen)32); errint_("#", &itype, (ftnlen)1); sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18); chkout_("ZZEKIID1", (ftnlen)8); return 0; } return 0; } /* zzekiid1_ */
/* $Procedure EKUCEC ( EK, update d.p. column entry ) */ /* Subroutine */ int ekucec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len) { integer unit; extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, integer *, ftnlen), zzekrbck_(char *, integer *, integer *, integer *, integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), zzektrdp_(integer *, integer *, integer *, integer *), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); integer class__, dtype; extern logical failed_(void); integer coldsc[11], segdsc[24]; logical isshad; extern /* Subroutine */ int dashlu_(integer *, integer *); integer recptr; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), ekshdw_(integer *, logical *), zzekue03_(integer *, integer *, integer *, integer *, char *, logical *, ftnlen), zzekue06_(integer *, integer *, integer *, integer *, integer *, char *, logical *, ftnlen); /* $ Abstract */ /* Update a character column entry in a specified EK record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGNO I Index of segment containing record. */ /* RECNO I Record in which entry is to be updated. */ /* COLUMN I Column name. */ /* NVALS I Number of values in in new column entry. */ /* CVALS I Character string values to add to column. */ /* ISNULL I Flag indicating whether column entry is null. */ /* $ Detailed_Input */ /* HANDLE is a file handle attached to an EK open for */ /* write access. */ /* SEGNO is the index of the segment containing the column */ /* entry to be updated. */ /* RECNO is the index of the record containing the column */ /* entry to be updated. This record number is */ /* relative to the start of the segment indicated by */ /* SEGNO; the first record in the segment has index 1. */ /* COLUMN is the name of the column containing the entry to */ /* be updated. */ /* NVALS, */ /* CVALS are, respectively, the number of values to add to */ /* the specified column and the set of values */ /* themselves. The data values are written in to the */ /* specifed column and record. */ /* If the column has fixed-size entries, then NVALS */ /* must equal the entry size for the specified column. */ /* For columns with variable-sized entries, the size */ /* of the new entry need not match the size of the */ /* entry it replaces. In particular, the new entry */ /* may be larger. */ /* ISNULL is a logical flag indicating whether the entry is */ /* null. If ISNULL is .FALSE., the column entry */ /* defined by NVALS and CVALS is added to the */ /* specified kernel file. */ /* If ISNULL is .TRUE., NVALS and CVALS are ignored. */ /* The contents of the column entry are undefined. */ /* If the column has fixed-length, variable-size */ /* entries, the number of entries is considered to */ /* be 1. */ /* The new entry may be null even though it replaces */ /* a non-null value, and vice versa. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If SEGNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 3) If COLUMN is not the name of a declared column, the error */ /* will be diagnosed by routines called by this routine. */ /* 4) If COLUMN specifies a column of whose data type is not */ /* CHARACTER, the error SPICE(WRONGDATATYPE) will */ /* be signalled. */ /* 5) If RECNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 6) If the specified column has fixed-size entries and NVALS */ /* does not match this size, the error will diagnosed by routines */ /* called by this routine. */ /* 7) If the specified column has variable-size entries and NVALS */ /* is non-positive, the error will diagnosed by routines */ /* called by this routine. */ /* 8) If an attempt is made to add a null value to a column that */ /* doesn't take null values, the error will diagnosed by routines */ /* called by this routine. */ /* 9) If COLUMN specifies a column of whose class is not */ /* a character class known to this routine, the error */ /* SPICE(NOCLASS) will be signalled. */ /* 10) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: it modifies the named */ /* EK file by adding data to the specified record in the specified */ /* column. Data may be added to a segment in random order; it is not */ /* necessary to fill in columns or rows sequentially. Data may only */ /* be added one logical element at a time. Partial assignments of */ /* logical elements are not supported. */ /* Since columns of data type TIME are implemented using double */ /* precision column classes, this routine may be used to update */ /* columns of type TIME. */ /* $ Examples */ /* 1) Replace the value in the third record of the column CCOL in */ /* the fifth segment of an EK file designated by HANDLE. Set */ /* the new value to '999'. */ /* CALL EKUCEC ( HANDLE, 5, 3, 'CCOL', 1, '999', .FALSE. ) */ /* 2) Same as (1), but this time add a null value. The argument */ /* '999' is ignored because the null flag is set to .TRUE. */ /* CALL EKUCEC ( HANDLE, 5, 3, 'CCOL', 1, '999', .TRUE. ) */ /* 3) Replace the entry in the third record of the column CARRAY in */ /* the fifth segment of an EK file designated by HANDLE. Set */ /* the new value using an array CBUFF of 10 string values. */ /* CALL EKUCEC ( HANDLE, 5, 3, 'CARRAY', 10, CBUFF, .FALSE. ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 20-JUN-1999 (WLT) */ /* Removed unbalanced call to CHKOUT. */ /* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ /* -& */ /* $ Index_Entries */ /* replace character entry in an EK column */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* First step: find the descriptor for the named segment. Using */ /* this descriptor, get the column descriptor. */ zzeksdsc_(handle, segno, segdsc); zzekcdsc_(handle, segdsc, column, coldsc, column_len); if (failed_()) { return 0; } /* This column had better be of character type. */ dtype = coldsc[1]; if (dtype != 1) { chkin_("EKUCEC", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Column # is of type #; EKUCEC only works with character col" "umns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)95); errch_("#", column, (ftnlen)1, column_len); errint_("#", &dtype, (ftnlen)1); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); chkout_("EKUCEC", (ftnlen)6); return 0; } /* Look up the record pointer for the target record. */ zzektrdp_(handle, &segdsc[6], recno, &recptr); /* Determine whether the EK is shadowed. */ ekshdw_(handle, &isshad); /* If the EK is shadowed, we must back up the current column entry */ /* if the entry has not already been backed up. ZZEKRBCK will */ /* handle this task. */ if (isshad) { zzekrbck_("UPDATE", handle, segdsc, coldsc, recno, (ftnlen)6); } /* Now it's time to carry out the replacement. */ class__ = coldsc[0]; if (class__ == 3) { /* Class 3 columns contain scalar character data. */ zzekue03_(handle, segdsc, coldsc, &recptr, cvals, isnull, cvals_len); } else if (class__ == 6) { /* Class 6 columns contain array-valued character data. */ zzekue06_(handle, segdsc, coldsc, &recptr, nvals, cvals, isnull, cvals_len); } else { /* This is an unsupported character column class. */ *segno = segdsc[1]; chkin_("EKUCEC", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Class # from input column descriptor is not a supported cha" "racter class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( ftnlen)115); errint_("#", &class__, (ftnlen)1); errch_("#", column, (ftnlen)1, column_len); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(NOCLASS)", (ftnlen)14); chkout_("EKUCEC", (ftnlen)6); return 0; } return 0; } /* ekucec_ */
/* $Procedure ZZSPKAS0 ( SPK, apparent state ) */ /* Subroutine */ int zzspkas0_(integer *targ, doublereal *et, char *ref, char *abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) { /* Initialized data */ static logical first = TRUE_; static char prvcor[5] = " "; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * ), zzspklt0_(integer *, doublereal *, char *, char *, doublereal * , doublereal *, doublereal *, doublereal *, ftnlen, ftnlen); static logical xmit; extern /* Subroutine */ int vequ_(doublereal *, doublereal *), zzstelab_( logical *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), zzprscor_(char *, logical *, ftnlen); integer refid; extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); doublereal pcorr[3]; static logical uselt; extern logical failed_(void); logical attblk[15]; doublereal dpcorr[3], corvel[3]; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen); doublereal corpos[3]; extern logical return_(void); static logical usestl; /* $ Abstract */ /* Given the state and acceleration of an observer relative to the */ /* solar system barycenter, return the state (position and velocity) */ /* of a target body relative to the observer, optionally corrected */ /* for light time and stellar aberration. All input and output */ /* vectors are expressed relative to an inertial reference frame. */ /* This routine supersedes SPKAPP. */ /* SPICE users normally should call the high-level API routines */ /* SPKEZR or SPKEZ rather than this routine. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPK */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ Abstract */ /* Include file zzabcorr.inc */ /* SPICE private file intended solely for the support of SPICE */ /* routines. Users should not include this file directly due */ /* to the volatile nature of this file */ /* The parameters below define the structure of an aberration */ /* correction attribute block. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Parameters */ /* An aberration correction attribute block is an array of logical */ /* flags indicating the attributes of the aberration correction */ /* specified by an aberration correction string. The attributes */ /* are: */ /* - Is the correction "geometric"? */ /* - Is light time correction indicated? */ /* - Is stellar aberration correction indicated? */ /* - Is the light time correction of the "converged */ /* Newtonian" variety? */ /* - Is the correction for the transmission case? */ /* - Is the correction relativistic? */ /* The parameters defining the structure of the block are as */ /* follows: */ /* NABCOR Number of aberration correction choices. */ /* ABATSZ Number of elements in the aberration correction */ /* block. */ /* GEOIDX Index in block of geometric correction flag. */ /* LTIDX Index of light time flag. */ /* STLIDX Index of stellar aberration flag. */ /* CNVIDX Index of converged Newtonian flag. */ /* XMTIDX Index of transmission flag. */ /* RELIDX Index of relativistic flag. */ /* The following parameter is not required to define the block */ /* structure, but it is convenient to include it here: */ /* CORLEN The maximum string length required by any aberration */ /* correction string */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */ /* -& */ /* Number of aberration correction choices: */ /* Aberration correction attribute block size */ /* (number of aberration correction attributes): */ /* Indices of attributes within an aberration correction */ /* attribute block: */ /* Maximum length of an aberration correction string: */ /* End of include file zzabcorr.inc */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* TARG I Target body. */ /* ET I Observer epoch. */ /* REF I Inertial reference frame of output state. */ /* ABCORR I Aberration correction flag. */ /* STOBS I State of the observer relative to the SSB. */ /* ACCOBS I Acceleration of the observer relative to the SSB. */ /* STARG O State of target. */ /* LT O One way light time between observer and target. */ /* DLT O Derivative of light time with respect to time. */ /* $ Detailed_Input */ /* TARG is the NAIF ID code for a target body. The target */ /* and observer define a state vector whose position */ /* component points from the observer to the target. */ /* ET is the ephemeris time, expressed as seconds past */ /* J2000 TDB, at which the state of the target body */ /* relative to the observer is to be computed. ET */ /* refers to time at the observer's location. */ /* REF is the inertial reference frame with respect to which */ /* the input state STOBS, the input acceleration ACCOBS, */ /* and the output state STARG are expressed. REF must be */ /* recognized by the SPICE Toolkit. The acceptable */ /* frames are listed in the Frames Required Reading, as */ /* well as in the SPICELIB routine CHGIRF. */ /* Case and blanks are not significant in the string */ /* REF. */ /* ABCORR indicates the aberration corrections to be applied */ /* to the state of the target body to account for one-way */ /* light time and stellar aberration. See the discussion */ /* in the header of SPKEZR for recommendations on */ /* how to choose aberration corrections. */ /* ABCORR may be any of the following: */ /* 'NONE' Apply no correction. Return the */ /* geometric state of the target body */ /* relative to the observer. */ /* The following values of ABCORR apply to the */ /* "reception" case in which photons depart from the */ /* target's location at the light-time corrected epoch */ /* ET-LT and *arrive* at the observer's location at ET: */ /* 'LT' Correct for one-way light time (also */ /* called "planetary aberration") using a */ /* Newtonian formulation. This correction */ /* yields the state of the target at the */ /* moment it emitted photons arriving at */ /* the observer at ET. */ /* The light time correction uses an */ /* iterative solution of the light time */ /* equation (see Particulars for details). */ /* The solution invoked by the 'LT' option */ /* uses one iteration. */ /* 'LT+S' Correct for one-way light time and */ /* stellar aberration using a Newtonian */ /* formulation. This option modifies the */ /* state obtained with the 'LT' option to */ /* account for the observer's velocity */ /* relative to the solar system */ /* barycenter. The result is the apparent */ /* state of the target---the position and */ /* velocity of the target as seen by the */ /* observer. */ /* 'CN' Converged Newtonian light time */ /* correction. In solving the light time */ /* equation, the 'CN' correction iterates */ /* until the solution converges (three */ /* iterations on all supported platforms). */ /* Whether the 'CN+S' solution is */ /* substantially more accurate than the */ /* 'LT' solution depends on the geometry */ /* of the participating objects and on the */ /* accuracy of the input data. In all */ /* cases this routine will execute more */ /* slowly when a converged solution is */ /* computed. See the Particulars section of */ /* SPKEZR for a discussion of precision of */ /* light time corrections. */ /* 'CN+S' Converged Newtonian light time */ /* correction and stellar aberration */ /* correction. */ /* The following values of ABCORR apply to the */ /* "transmission" case in which photons *depart* from */ /* the observer's location at ET and arrive at the */ /* target's location at the light-time corrected epoch */ /* ET+LT: */ /* 'XLT' "Transmission" case: correct for */ /* one-way light time using a Newtonian */ /* formulation. This correction yields the */ /* state of the target at the moment it */ /* receives photons emitted from the */ /* observer's location at ET. */ /* 'XLT+S' "Transmission" case: correct for */ /* one-way light time and stellar */ /* aberration using a Newtonian */ /* formulation This option modifies the */ /* state obtained with the 'XLT' option to */ /* account for the observer's velocity */ /* relative to the solar system */ /* barycenter. The position component of */ /* the computed target state indicates the */ /* direction that photons emitted from the */ /* observer's location must be "aimed" to */ /* hit the target. */ /* 'XCN' "Transmission" case: converged */ /* Newtonian light time correction. */ /* 'XCN+S' "Transmission" case: converged */ /* Newtonian light time correction and */ /* stellar aberration correction. */ /* Neither special nor general relativistic effects are */ /* accounted for in the aberration corrections applied */ /* by this routine. */ /* Case and blanks are not significant in the string */ /* ABCORR. */ /* STOBS is the geometric state of the observer relative to */ /* the solar system barycenter at ET. STOBS is expressed */ /* relative to the reference frame designated by REF. */ /* The target and observer define a state vector whose */ /* position component points from the observer to the */ /* target. */ /* ACCOBS is the geometric acceleration of the observer */ /* relative to the solar system barycenter at ET. This */ /* is the derivative with respect to time of the */ /* velocity portion of STOBS. ACCOBS is expressed */ /* relative to the reference frame designated by REF. */ /* ACCOBS is used for computing stellar aberration */ /* corrected velocity. If stellar aberration corrections */ /* are not specified by ABCORR, ACCOBS is ignored; the */ /* caller need not provide a valid input value in this */ /* case. */ /* $ Detailed_Output */ /* STARG is a Cartesian state vector representing the position */ /* and velocity of the target body relative to the */ /* specified observer. STARG is corrected for the */ /* specified aberrations, and is expressed with respect */ /* to the inertial reference frame designated by REF. */ /* The first three components of STARG represent the x-, */ /* y- and z-components of the target's position; last */ /* three components form the corresponding velocity */ /* vector. */ /* The position component of STARG points from the */ /* observer's location at ET to the aberration-corrected */ /* location of the target. Note that the sense of the */ /* position vector is independent of the direction of */ /* radiation travel implied by the aberration */ /* correction. */ /* Units are always km and km/sec. */ /* LT is the one-way light time between the observer and */ /* target in seconds. If the target state is corrected */ /* for light time, then LT is the one-way light time */ /* between the observer and the light time-corrected */ /* target location. */ /* DLT is the derivative with respect to barycentric */ /* dynamical time of the one way light time between */ /* target and observer: */ /* DLT = d(LT)/d(ET) */ /* DLT can also be described as the rate of change of */ /* one way light time. DLT is unitless, since LT and */ /* ET both have units of TDB seconds. */ /* If the observer and target are at the same position, */ /* then DLT is set to zero. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the value of ABCORR is not recognized, the error */ /* is diagnosed by a routine in the call tree of this */ /* routine. */ /* 2) If ABCORR calls for stellar aberration but not light */ /* time corrections, the error SPICE(NOTSUPPORTED) is */ /* signaled. */ /* 3) If ABCORR calls for relativistic light time corrections, the */ /* error SPICE(NOTSUPPORTED) is signaled. */ /* 4) If the reference frame requested is not a recognized */ /* inertial reference frame, the error SPICE(BADFRAME) */ /* is signaled. */ /* 5) If the state of the target relative to the solar system */ /* barycenter cannot be computed, the error will be diagnosed */ /* by routines in the call tree of this routine. */ /* 6) If the observer and target are at the same position, */ /* then DLT is set to zero. This situation could arise, */ /* for example, when the observer is Mars and the target */ /* is the Mars barycenter. */ /* $ Files */ /* This routine computes states using SPK files that have been */ /* loaded into the SPICE system, normally via the kernel loading */ /* interface routine FURNSH. Application programs typically load */ /* kernels once before this routine is called, for example during */ /* program initialization; kernels need not be loaded repeatedly. */ /* See the routine FURNSH and the SPK and KERNEL Required Reading */ /* for further information on loading (and unloading) kernels. */ /* If any of the ephemeris data used to compute STARG are expressed */ /* relative to a non-inertial frame in the SPK files providing those */ /* data, additional kernels may be needed to enable the reference */ /* frame transformations required to compute the state. Normally */ /* these additional kernels are PCK files or frame kernels. Any such */ /* kernels must already be loaded at the time this routine is */ /* called. */ /* $ Particulars */ /* This routine supports higher-level SPK API routines that can */ /* perform both light time and stellar aberration corrections. */ /* User applications normally will not need to call this routine */ /* directly. However, this routine can improve run-time efficiency */ /* in situations where many targets are observed from the same */ /* location at the same time. In such cases, the state and */ /* acceleration of the observer relative to the solar system */ /* barycenter need be computed only once per look-up epoch. */ /* When apparent positions, rather than apparent states, are */ /* required, consider using the high-level position-only API */ /* routines */ /* SPKPOS */ /* SPKEZP */ /* or the low-level, position-only analog of this routine */ /* SPKAPO */ /* In general, the position-only routines are more efficient. */ /* See the header of the routine SPKEZR for a detailed discussion */ /* of aberration corrections. */ /* $ Examples */ /* 1) Look up a sequence of states of the Moon as seen from the */ /* Earth. Use light time and stellar aberration corrections. */ /* Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */ /* compute subsequent states at intervals of 1 hour. For each */ /* epoch, display the states, the one way light time between */ /* target and observer, and the rate of change of the one way */ /* light time. */ /* Use the following meta-kernel to specify the kernels to */ /* load: */ /* KPL/MK */ /* This meta-kernel is intended to support operation of SPICE */ /* example programs. The kernels shown here should not be */ /* assumed to contain adequate or correct versions of data */ /* required by SPICE-based user applications. */ /* In order for an application to use this meta-kernel, the */ /* kernels referenced here must be present in the user's */ /* current working directory. */ /* \begindata */ /* KERNELS_TO_LOAD = ( 'de418.bsp', */ /* 'pck00008.tpc', */ /* 'naif0008.tls' ) */ /* \begintext */ /* The code example follows: */ /* PROGRAM EX1 */ /* IMPLICIT NONE */ /* C */ /* C Local constants */ /* C */ /* C The meta-kernel name shown here refers to a file whose */ /* C contents are those shown above. This file and the kernels */ /* C it references must exist in your current working directory. */ /* C */ /* CHARACTER*(*) META */ /* PARAMETER ( META = 'example.mk' ) */ /* C */ /* C Use a time step of 1 hour; look up 5 states. */ /* C */ /* DOUBLE PRECISION STEP */ /* PARAMETER ( STEP = 3600.0D0 ) */ /* INTEGER MAXITR */ /* PARAMETER ( MAXITR = 5 ) */ /* C */ /* C Local variables */ /* C */ /* DOUBLE PRECISION ACC ( 3 ) */ /* DOUBLE PRECISION DLT */ /* DOUBLE PRECISION ET */ /* DOUBLE PRECISION ET0 */ /* DOUBLE PRECISION LT */ /* DOUBLE PRECISION STATE ( 6 ) */ /* DOUBLE PRECISION STATE0 ( 6 ) */ /* DOUBLE PRECISION STATE2 ( 6 ) */ /* DOUBLE PRECISION STOBS ( 6 ) */ /* DOUBLE PRECISION TDELTA */ /* INTEGER I */ /* C */ /* C Load the SPK and LSK kernels via the meta-kernel. */ /* C */ /* CALL FURNSH ( META ) */ /* C */ /* C Convert the start time to seconds past J2000 TDB. */ /* C */ /* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ /* C */ /* C Step through a series of epochs, looking up a */ /* C state vector at each one. */ /* C */ /* DO I = 1, MAXITR */ /* ET = ET0 + (I-1)*STEP */ /* C */ /* C Look up a state vector at epoch ET using the */ /* C following inputs: */ /* C */ /* C Target: Moon (NAIF ID code 301) */ /* C Reference frame: J2000 */ /* C Aberration correction: Light time and stellar */ /* C aberration ('LT+S') */ /* C Observer: Earth (NAIF ID code 399) */ /* C */ /* C Before we can execute this computation, we'll need the */ /* C geometric state and accleration of the observer relative */ /* C to the solar system barycenter at ET, expressed */ /* C relative to the J2000 reference frame. First find */ /* C the state: */ /* C */ /* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ /* C */ /* C Next compute the acceleration. We numerically */ /* C differentiate the velocity using a quadratic */ /* C approximation: */ /* C */ /* TDELTA = 1.D0 */ /* CALL SPKSSB ( 399, ET-TDELTA, 'J2000', STATE0 ) */ /* CALL SPKSSB ( 399, ET+TDELTA, 'J2000', STATE2 ) */ /* CALL QDERIV ( 3, STATE0(4), STATE2(4), TDELTA, ACC ) */ /* C */ /* C Now compute the desired state vector: */ /* C */ /* CALL SPKAPS ( 301, ET, 'J2000', 'LT+S', */ /* . STOBS, ACC, STATE, LT, DLT ) */ /* WRITE (*,*) 'ET = ', ET */ /* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ /* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ /* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ /* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ /* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ /* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ /* WRITE (*,*) 'One-way light time (s): ', LT */ /* WRITE (*,*) 'Light time rate: ', DLT */ /* WRITE (*,*) ' ' */ /* END DO */ /* END */ /* The output produced by this program will vary somewhat as */ /* a function of the platform on which the program is built and */ /* executed. On a PC/Linux/g77 platform, the following output */ /* was produced: */ /* ET = 0. */ /* J2000 x-position (km): -291584.614 */ /* J2000 y-position (km): -266693.406 */ /* J2000 z-position (km): -76095.6532 */ /* J2000 x-velocity (km/s): 0.643439157 */ /* J2000 y-velocity (km/s): -0.666065874 */ /* J2000 z-velocity (km/s): -0.301310063 */ /* One-way light time (s): 1.34231061 */ /* Light time rate: 1.07316909E-07 */ /* ET = 3600. */ /* J2000 x-position (km): -289256.459 */ /* J2000 y-position (km): -269080.605 */ /* J2000 z-position (km): -77177.3528 */ /* J2000 x-velocity (km/s): 0.64997032 */ /* J2000 y-velocity (km/s): -0.660148253 */ /* J2000 z-velocity (km/s): -0.299630418 */ /* One-way light time (s): 1.34269395 */ /* Light time rate: 1.05652599E-07 */ /* ET = 7200. */ /* J2000 x-position (km): -286904.897 */ /* J2000 y-position (km): -271446.417 */ /* J2000 z-position (km): -78252.9655 */ /* J2000 x-velocity (km/s): 0.656443883 */ /* J2000 y-velocity (km/s): -0.654183552 */ /* J2000 z-velocity (km/s): -0.297928533 */ /* One-way light time (s): 1.34307131 */ /* Light time rate: 1.03990457E-07 */ /* ET = 10800. */ /* J2000 x-position (km): -284530.133 */ /* J2000 y-position (km): -273790.671 */ /* J2000 z-position (km): -79322.4117 */ /* J2000 x-velocity (km/s): 0.662859505 */ /* J2000 y-velocity (km/s): -0.648172247 */ /* J2000 z-velocity (km/s): -0.296204558 */ /* One-way light time (s): 1.34344269 */ /* Light time rate: 1.02330665E-07 */ /* ET = 14400. */ /* J2000 x-position (km): -282132.378 */ /* J2000 y-position (km): -276113.202 */ /* J2000 z-position (km): -80385.612 */ /* J2000 x-velocity (km/s): 0.669216846 */ /* J2000 y-velocity (km/s): -0.642114815 */ /* J2000 z-velocity (km/s): -0.294458645 */ /* One-way light time (s): 1.3438081 */ /* Light time rate: 1.00673404E-07 */ /* $ Restrictions */ /* 1) This routine should not be used to compute geometric states. */ /* Instead, use SPKEZR, SPKEZ, or SPKGEO. SPKGEO, which is called */ /* by SPKEZR and SPKEZ, introduces less round-off error when the */ /* observer and target have a common center that is closer to */ /* both objects than is the solar system barycenter. */ /* 2) The kernel files to be used by SPKAPS must be loaded */ /* (normally by the SPICELIB kernel loader FURNSH) before */ /* this routine is called. */ /* 3) Unlike most other SPK state computation routines, this */ /* routine requires that the output state be relative to an */ /* inertial reference frame. */ /* $ Literature_References */ /* SPK Required Reading. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 04-JUL-2014 (NJB) */ /* Discussion of light time corrections was updated. Assertions */ /* that converged light time corrections are unlikely to be */ /* useful were removed. */ /* Last update was 15-APR-2014 (NJB) */ /* Added a FAILED() call to prevent numeric problems */ /* resulting from uninitialized values. */ /* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ /* -& */ /* $ Index_Entries */ /* low-level aberration-corrected state computation */ /* low-level light time and stellar aberration correction */ /* -& */ /* $ Revisions */ /* None. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Saved variables */ /* Initial values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("ZZSPKAS0", (ftnlen)8); if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) { /* The aberration correction flag differs from the value it */ /* had on the previous call, if any. Analyze the new flag. */ zzprscor_(abcorr, attblk, abcorr_len); if (failed_()) { chkout_("ZZSPKAS0", (ftnlen)8); return 0; } /* The aberration correction flag is recognized; save it. */ s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len); /* Set logical flags indicating the attributes of the requested */ /* correction: */ /* XMIT is .TRUE. when the correction is for transmitted */ /* radiation. */ /* USELT is .TRUE. when any type of light time correction */ /* (normal or converged Newtonian) is specified. */ /* USECN indicates converged Newtonian light time correction. */ /* The above definitions are consistent with those used by */ /* ZZPRSCOR. */ xmit = attblk[4]; uselt = attblk[1]; usestl = attblk[2]; if (usestl && ! uselt) { setmsg_("Aberration correction flag # calls for stellar aberrati" "on but not light time corrections. This combination is n" "ot expected.", (ftnlen)123); errch_("#", abcorr, (ftnlen)1, abcorr_len); sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); chkout_("ZZSPKAS0", (ftnlen)8); return 0; } else if (attblk[5]) { setmsg_("Aberration correction flag # calls for relativistic lig" "ht time correction.", (ftnlen)74); errch_("#", abcorr, (ftnlen)1, abcorr_len); sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); chkout_("ZZSPKAS0", (ftnlen)8); return 0; } first = FALSE_; } /* See if the reference frame is a recognized inertial frame. */ irfnum_(ref, &refid, ref_len); if (refid == 0) { setmsg_("The requested frame '#' is not a recognized inertial frame. " , (ftnlen)60); errch_("#", ref, (ftnlen)1, ref_len); sigerr_("SPICE(BADFRAME)", (ftnlen)15); chkout_("ZZSPKAS0", (ftnlen)8); return 0; } /* Get the state of the target relative to the observer, */ /* optionally corrected for light time. */ zzspklt0_(targ, et, ref, abcorr, stobs, starg, lt, dlt, ref_len, abcorr_len); if (failed_()) { chkout_("ZZSPKAS0", (ftnlen)8); return 0; } /* If stellar aberration corrections are not needed, we're */ /* already done. */ if (! usestl) { chkout_("ZZSPKAS0", (ftnlen)8); return 0; } /* Get the stellar aberration correction and its time derivative. */ zzstelab_(&xmit, accobs, &stobs[3], starg, pcorr, dpcorr); /* Adding the stellar aberration correction to the light */ /* time-corrected target position yields the position corrected for */ /* both light time and stellar aberration. */ vadd_(pcorr, starg, corpos); vequ_(corpos, starg); /* Velocity is treated in an analogous manner. */ vadd_(dpcorr, &starg[3], corvel); vequ_(corvel, &starg[3]); chkout_("ZZSPKAS0", (ftnlen)8); return 0; } /* zzspkas0_ */
/* $Procedure SGFPKT ( Generic Segment: Fetch data packets ) */ /* Subroutine */ int sgfpkt_(integer *handle, doublereal *descr, integer * first, integer *last, doublereal *values, integer *ends) { /* System generated locals */ integer i__1; /* Local variables */ integer size, b, e, i__; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal dtemp[2]; integer begin1, begin2; extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, doublereal *); extern logical failed_(void); extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *, integer *), sigerr_(char *, ftnlen); integer mypdrb; extern /* Subroutine */ int chkout_(char *, ftnlen); integer soffst; extern /* Subroutine */ int setmsg_(char *, ftnlen); integer mypktb, voffst; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); integer mynpdr; extern logical return_(void); integer mypdrt, mynpkt, mypkto, mypksz; /* $ Abstract */ /* Given the descriptor for a generic segment in a DAF file */ /* associated with HANDLE, fetch the data packets indexed from FIRST */ /* to LAST from the packet partition of the generic segment. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAF Required Reading */ /* $ Keywords */ /* GENERIC SEGMENTS */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* HANDLE I The file handle attached to an open DAF. */ /* DESCR I The descriptor associated with a generic segment. */ /* FIRST I The index of the first data packet to fetch. */ /* LAST I The index of the last data packet to fetch. */ /* VALUES O The data packets that have been fetched. */ /* ENDS O An array of pointers to the ends of the packets. */ /* $ Detailed_Input */ /* HANDLE is the handle of a DAF opened for reading that */ /* contains the segment described by DESCR. */ /* DESCR is the descriptor of the segment with the desired */ /* constant values. This must be the descriptor for a */ /* generic segment in the DAF associated with HANDLE. */ /* FIRST is the index of the first value to fetch from the */ /* constants section of the DAF segment described */ /* by DESCR. */ /* LAST is the index of the last value to fetch from the */ /* constants section of the DAF segment described */ /* by DESCR */ /* $ Detailed_Output */ /* VALUES is the array of values constructed by concatenating */ /* requested packets one after the other into */ /* an array. Pictorially we can represent VALUES */ /* as: */ /* +--------------------------+ */ /* | first requested packet | */ /* +--------------------------+ */ /* | second requested packet | */ /* +--------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------+ */ /* | first requested packet | */ /* +--------------------------+ */ /* ENDS is an array of pointers to the ends of the */ /* fetched packets. ENDS(1) gives the index */ /* of the last item of the first packet fetched. */ /* ENDS(2) gives the index of the last item of */ /* the second packet fetched, etc. */ /* $ Parameters */ /* This subroutine makes use of parameters defined in the file */ /* 'sgparam.inc'. */ /* $ Files */ /* See the description of HANDLE above. */ /* $ Exceptions */ /* 1) The error SPICE(REQUESTOUTOFBOUNDS) will be signalled */ /* if FIRST is less than 1 or LAST is greater than the */ /* number of packets. */ /* 2) The error SPICE(REQUESTOUTOFORDER) will be signalled */ /* if LAST is less than FIRST. */ /* 3) The error SPICE(UNKNOWNPACKETDIR) will be signalled if */ /* the packet directory structure is unrecognized. The most */ /* likely cause of this error is that an upgrade to your */ /* version of the SPICE toolkit is needed. */ /* $ Particulars */ /* This routine fetches requested packets from a generic */ /* DAF segment. The two arrays returned have the following */ /* relationship to one another. The first packet returned */ /* resides in VALUES between indexes 1 and ENDS(1). If a */ /* second packet is returned it resides in VALUES between */ /* indices ENDS(1)+1 and ENDS(2). This relations ship is */ /* repeated so that if I is greater than 1 and at least I */ /* packets were returned then the I'th packet resides in */ /* VALUES between index ENDS(I-1) + 1 and ENDS(I). */ /* $ Examples */ /* Suppose that you have located a generic DAF segment (as */ /* identified by the contents of a segment descriptor). The */ /* fragment of code below shows how you could fetch packets */ /* 3 through 7 (assuming that many packets are present). */ /* from the segment. */ /* Declarations: */ /* DOUBLE PRECISION MYPKSZ (<enough room to hold all packets>) */ /* INTEGER ENDS ( 5 ) */ /* INTEGER MYNPKT */ /* get the number of packets */ /* CALL SGMETA ( HANDLE, DESCR, NPKT, MYNPKT ) */ /* finally, fetch the packets from the segment. */ /* IF ( 7 .LE. MYNPKT ) THEN */ /* CALL SGFPKT ( HANDLE, DESCR, 3, 7, MYPKSZ, ENDS ) */ /* END IF */ /* $ Restrictions */ /* The segment described by DESCR must be a generic segment, */ /* otherwise the results of this routine are not predictable. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* W.L. Taber (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */ /* Replaced DAFRDA calls with DAFGDA. */ /* - SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB) */ /* Found and fixed a bug in the calculation of the beginning */ /* address for variable length packet fetching. The base address */ /* for the packet directory was not added into the value. This */ /* bug went unnoticed because of a bug in SGSEQW, entry SGWES, */ /* that put absolute addresses into the packet directory rather */ /* than addresses that were relative to the start of the DAF */ /* array. The bug in SGSEQW has also been fixed. */ /* - SPICELIB Version 1.0.0, 06-JAN-1994 (KRG) (WLT) */ /* -& */ /* $ Index_Entries */ /* fetch packets from a generic segment */ /* -& */ /* Spicelib Functions */ /* Local Parameters */ /* Include the mnemonic values. */ /* Local Variables */ /* $ Abstract */ /* Parameter declarations for the generic segments subroutines. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAF Required Reading */ /* $ Keywords */ /* GENERIC SEGMENTS */ /* $ Particulars */ /* This include file contains the parameters used by the generic */ /* segments subroutines, SGxxxx. A generic segment is a */ /* generalization of a DAF array which places a particular structure */ /* on the data contained in the array, as described below. */ /* This file defines the mnemonics that are used for the index types */ /* allowed in generic segments as well as mnemonics for the meta data */ /* items which are used to describe a generic segment. */ /* A DAF generic segment contains several logical data partitions: */ /* 1) A partition for constant values to be associated with each */ /* data packet in the segment. */ /* 2) A partition for the data packets. */ /* 3) A partition for reference values. */ /* 4) A partition for a packet directory, if the segment contains */ /* variable sized packets. */ /* 5) A partition for a reference value directory. */ /* 6) A reserved partition that is not currently used. This */ /* partition is only for the use of the NAIF group at the Jet */ /* Propulsion Laboratory (JPL). */ /* 7) A partition for the meta data which describes the locations */ /* and sizes of other partitions as well as providing some */ /* additional descriptive information about the generic */ /* segment. */ /* +============================+ */ /* | Constants | */ /* +============================+ */ /* | Packet 1 | */ /* |----------------------------| */ /* | Packet 2 | */ /* |----------------------------| */ /* | . | */ /* | . | */ /* | . | */ /* |----------------------------| */ /* | Packet N | */ /* +============================+ */ /* | Reference Values | */ /* +============================+ */ /* | Packet Directory | */ /* +============================+ */ /* | Reference Directory | */ /* +============================+ */ /* | Reserved Area | */ /* +============================+ */ /* | Segment Meta Data | */ /* +----------------------------+ */ /* Only the placement of the meta data at the end of a generic */ /* segment is required. The other data partitions may occur in any */ /* order in the generic segment because the meta data will contain */ /* pointers to their appropriate locations within the generic */ /* segment. */ /* The meta data for a generic segment should only be obtained */ /* through use of the subroutine SGMETA. The meta data should not be */ /* written through any mechanism other than the ending of a generic */ /* segment begun by SGBWFS or SGBWVS using SGWES. */ /* $ Restrictions */ /* 1) If new reference index types are added, the new type(s) should */ /* be defined to be the consecutive integer(s) after the last */ /* defined reference index type used. In this way a value for */ /* the maximum allowed index type may be maintained. This value */ /* must also be updated if new reference index types are added. */ /* 2) If new meta data items are needed, mnemonics for them must be */ /* added to the end of the current list of mnemonics and before */ /* the NMETA mnemonic. In this way compatibility with files having */ /* a different, but smaller, number of meta data items may be */ /* maintained. See the description and example below. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* K.R. Gehringer (JPL) */ /* W.L. Taber (JPL) */ /* F.S. Turner (JPL) */ /* $ Literature_References */ /* Generic Segments Required Reading. */ /* DAF Required Reading. */ /* $ Version */ /* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */ /* Header update: equations for comptutations of packet indices */ /* for the cases of index types 0 and 1 were corrected. */ /* - SPICELIB Version 1.1.0, 25-09-98 (FST) */ /* Added parameter MNMETA, the minimum number of meta data items */ /* that must be present in a generic DAF segment. */ /* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */ /* -& */ /* Mnemonics for the type of reference value index. */ /* Two forms of indexing are provided: */ /* 1) An implicit form of indexing based on using two values, a */ /* starting value, which will have an index of 1, and a step */ /* size between reference values, which are used to compute an */ /* index and a reference value associated with a specified key */ /* value. See the descriptions of the implicit types below for */ /* the particular formula used in each case. */ /* 2) An explicit form of indexing based on a reference value for */ /* each data packet. */ /* Reference Index Type 0 */ /* ---------------------- */ /* Implied index. The index and reference value of a data packet */ /* associated with a specified key value are computed from the two */ /* generic segment reference values using the formula below. The two */ /* generic segment reference values, REF(1) and REF(2), represent, */ /* respectively, a starting value and a step size between reference */ /* values. The index of the data packet associated with a key value */ /* of VALUE is given by: */ /* / VALUE - REF(1) \ */ /* INDEX = 1 + INT | -------------------- | */ /* \ REF(2) / */ /* and the reference value associated with VALUE is given by: */ /* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ /* Reference Index Type 1 */ /* ---------------------- */ /* Implied index. The index and reference value of a data packet */ /* associated with a specified key value are computed from the two */ /* generic segment reference values using the formula below. The two */ /* generic segment reference values, REF(1) and REF(2), represent, */ /* respectively, a starting value and a step size between reference */ /* values. The index of the data packet associated with a key value */ /* of VALUE is given by: */ /* / VALUE - REF(1) \ */ /* INDEX = 1 + INT | 0.5 + -------------------- | */ /* \ REF(2) / */ /* and the reference value associated with VALUE is given by: */ /* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */ /* We get the larger index in the event that VALUE is halfway between */ /* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */ /* Reference Index Type 2 */ /* ---------------------- */ /* Explicit index. In this case the number of packets must equal the */ /* number of reference values. The index of the packet associated */ /* with a key value of VALUE is the index of the last reference item */ /* that is strictly less than VALUE. The reference values must be in */ /* ascending order, REF(I) < REF(I+1). */ /* Reference Index Type 3 */ /* ---------------------- */ /* Explicit index. In this case the number of packets must equal the */ /* number of reference values. The index of the packet associated */ /* with a key value of VALUE is the index of the last reference item */ /* that is less than or equal to VALUE. The reference values must be */ /* in ascending order, REF(I) < REF(I+1). */ /* Reference Index Type 4 */ /* ---------------------- */ /* Explicit index. In this case the number of packets must equal the */ /* number of reference values. The index of the packet associated */ /* with a key value of VALUE is the index of the reference item */ /* that is closest to the value of VALUE. In the event of a "tie" */ /* the larger index is selected. The reference values must be in */ /* ascending order, REF(I) < REF(I+1). */ /* These parameters define the valid range for the index types. An */ /* index type code, MYTYPE, for a generic segment must satisfy the */ /* relation MNIDXT <= MYTYPE <= MXIDXT. */ /* The following meta data items will appear in all generic segments. */ /* Other meta data items may be added if a need arises. */ /* 1) CONBAS Base Address of the constants in a generic segment. */ /* 2) NCON Number of constants in a generic segment. */ /* 3) RDRBAS Base Address of the reference directory for a */ /* generic segment. */ /* 4) NRDR Number of items in the reference directory of a */ /* generic segment. */ /* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */ /* generic segment. */ /* 6) REFBAS Base Address of the reference items for a generic */ /* segment. */ /* 7) NREF Number of reference items in a generic segment. */ /* 8) PDRBAS Base Address of the Packet Directory for a generic */ /* segment. */ /* 9) NPDR Number of items in the Packet Directory of a generic */ /* segment. */ /* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */ /* segment. */ /* 11) PKTBAS Base Address of the Packets for a generic segment. */ /* 12) NPKT Number of Packets in a generic segment. */ /* 13) RSVBAS Base Address of the Reserved Area in a generic */ /* segment. */ /* 14) NRSV Number of items in the reserved area of a generic */ /* segment. */ /* 15) PKTSZ Size of the packets for a segment with fixed width */ /* data packets or the size of the largest packet for a */ /* segment with variable width data packets. */ /* 16) PKTOFF Offset of the packet data from the start of a packet */ /* record. Each data packet is placed into a packet */ /* record which may have some bookkeeping information */ /* prepended to the data for use by the generic */ /* segments software. */ /* 17) NMETA Number of meta data items in a generic segment. */ /* Meta Data Item 1 */ /* ----------------- */ /* Meta Data Item 2 */ /* ----------------- */ /* Meta Data Item 3 */ /* ----------------- */ /* Meta Data Item 4 */ /* ----------------- */ /* Meta Data Item 5 */ /* ----------------- */ /* Meta Data Item 6 */ /* ----------------- */ /* Meta Data Item 7 */ /* ----------------- */ /* Meta Data Item 8 */ /* ----------------- */ /* Meta Data Item 9 */ /* ----------------- */ /* Meta Data Item 10 */ /* ----------------- */ /* Meta Data Item 11 */ /* ----------------- */ /* Meta Data Item 12 */ /* ----------------- */ /* Meta Data Item 13 */ /* ----------------- */ /* Meta Data Item 14 */ /* ----------------- */ /* Meta Data Item 15 */ /* ----------------- */ /* Meta Data Item 16 */ /* ----------------- */ /* If new meta data items are to be added to this list, they should */ /* be added above this comment block as described below. */ /* INTEGER NEW1 */ /* PARAMETER ( NEW1 = PKTOFF + 1 ) */ /* INTEGER NEW2 */ /* PARAMETER ( NEW2 = NEW1 + 1 ) */ /* INTEGER NEWEST */ /* PARAMETER ( NEWEST = NEW2 + 1 ) */ /* and then the value of NMETA must be changed as well to be: */ /* INTEGER NMETA */ /* PARAMETER ( NMETA = NEWEST + 1 ) */ /* Meta Data Item 17 */ /* ----------------- */ /* Maximum number of meta data items. This is always set equal to */ /* NMETA. */ /* Minimum number of meta data items that must be present in a DAF */ /* generic segment. This number is to remain fixed even if more */ /* meta data items are added for compatibility with old DAF files. */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("SGFPKT", (ftnlen)6); /* Perform the needed initialization */ sgmeta_(handle, descr, &c__12, &mynpkt); sgmeta_(handle, descr, &c__10, &mypdrt); sgmeta_(handle, descr, &c__16, &mypkto); sgmeta_(handle, descr, &c__15, &mypksz); sgmeta_(handle, descr, &c__11, &mypktb); if (failed_()) { chkout_("SGFPKT", (ftnlen)6); return 0; } /* Perform checks on the inputs for reasonableness. */ if (*first < 1 || *last > mynpkt) { setmsg_("The range of packets requested extends beyond the available" " packet data. The packet data is available for indexes 1 to" " #. You've requested data from # to #. ", (ftnlen)159); errint_("#", &mynpkt, (ftnlen)1); errint_("#", first, (ftnlen)1); errint_("#", last, (ftnlen)1); sigerr_("SPICE(REQUESTOUTOFBOUNDS)", (ftnlen)25); chkout_("SGFPKT", (ftnlen)6); return 0; } if (*last < *first) { setmsg_("The last packet requested, #, is before the first packet re" "quested, #. ", (ftnlen)71); errint_("#", last, (ftnlen)1); errint_("#", first, (ftnlen)1); sigerr_("SPICE(REQUESTOUTOFORDER)", (ftnlen)24); chkout_("SGFPKT", (ftnlen)6); return 0; } /* We've passed the sanity tests, if the packet directory structure */ /* is recognized fetch the values and ends. We assume that we are */ /* reading data from a correctly constructed generic segment, so we */ /* do not need to worry about the type of reference index, as this is */ /* not needed to fetch a data packet. */ /* Currently, only two packet directory types are supported, and this */ /* subroutine is the only place that this is documented. The types */ /* have values zero (0) and one (1) for, respectively, fixed size */ /* packets and variable size packets. */ if (mypdrt == 0) { /* All packets have the same size MYPKSZ so the address of the */ /* start of the first packet and end of the last packet are easily */ /* computed. */ if (mypkto == 0) { /* Compute tha addresses for the packet data in the generic */ /* segment. */ b = mypktb + (*first - 1) * mypksz + 1; e = mypktb + *last * mypksz; /* Get the packet data all in one shot since we know it's */ /* contiguous. */ dafgda_(handle, &b, &e, values); } else { /* Compute the addresses for the packet data in the generic */ /* segment. Remember that we need to account for an offset */ /* here to get to the start of the actual data packet. */ size = mypksz + mypkto; /* Get the packet data. Because there is an offset from the */ /* address to the start of the packet data, we need to get */ /* the data one packet at a time rather than all at once. */ i__1 = *last; for (i__ = *first; i__ <= i__1; ++i__) { soffst = (i__ - 1) * size + 1; voffst = (i__ - *first) * mypksz + 1; b = mypktb + soffst + mypkto; e = mypktb + soffst + mypksz; dafgda_(handle, &b, &e, &values[voffst - 1]); if (failed_()) { chkout_("SGFPKT", (ftnlen)6); return 0; } } } /* Compute the ends for each of the data packets. This is the */ /* same for both of the cases above because we have fixed size */ /* data packets. */ i__1 = *last - *first + 1; for (i__ = 1; i__ <= i__1; ++i__) { ends[i__ - 1] = i__ * mypksz; } } else { /* In addition to the other meta data items already retrieved, we */ /* will also need a few others. */ sgmeta_(handle, descr, &c__8, &mypdrb); sgmeta_(handle, descr, &c__9, &mynpdr); if (failed_()) { chkout_("SGFPKT", (ftnlen)6); return 0; } /* Each packet has a different size, so we need to fetch each one */ /* individually, keeping track of the ends and things. We assume */ /* that there is enough room in the array of values to hold all of */ /* the packets. For the variable packet case, however, we do not */ /* need to treat the implicit indexing and explicit indexing cases */ /* separately. */ voffst = 1; i__1 = *last - *first + 1; for (i__ = 1; i__ <= i__1; ++i__) { /* Compute the addresses in the generic segment for the */ /* beginning of data packets I and I+1. We need these to */ /* compute the size of the packet. */ b = mypdrb + *first + i__ - 1; e = b + 1; /* Get the beginning addresses for the two data packets and */ /* convert them into integers. */ dafgda_(handle, &b, &e, dtemp); if (failed_()) { chkout_("SGFPKT", (ftnlen)6); return 0; } begin1 = (integer) dtemp[0]; begin2 = (integer) dtemp[1]; /* Compute the size of data packet I, remembering to deal with */ /* the packet offset that might be present, and the beginning */ /* and ending addresses for the packet data. */ size = begin2 - begin1 - mypkto; b = mypktb + begin1; e = b + size - 1; /* Get the data for packet I. */ dafgda_(handle, &b, &e, &values[voffst - 1]); if (failed_()) { chkout_("SGFPKT", (ftnlen)6); return 0; } /* Compute the end for packet I and store it. */ voffst += size; ends[i__ - 1] = voffst - 1; } } chkout_("SGFPKT", (ftnlen)6); return 0; } /* sgfpkt_ */
/* $Procedure WNCOMD ( Complement a DP window ) */ /* Subroutine */ int wncomd_(doublereal *left, doublereal *right, doublereal * window, doublereal *result) { integer card, i__; extern integer cardd_(doublereal *); extern /* Subroutine */ int chkin_(char *, ftnlen); extern logical failed_(void); extern /* Subroutine */ int scardd_(integer *, doublereal *), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), wninsd_(doublereal *, doublereal *, doublereal *); extern logical return_(void); /* $ Abstract */ /* Determine the complement of a double precision window with */ /* respect to the interval [LEFT,RIGHT]. */ /* $ 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 */ /* WINDOWS */ /* $ Keywords */ /* WINDOWS */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* LEFT, */ /* RIGHT I Left, right endpoints of complement interval. */ /* WINDOW I Input window. */ /* RESULT O Complement of WINDOW with respect to [LEFT,RIGHT]. */ /* $ Detailed_Input */ /* LEFT, */ /* RIGHT are the left and right endpoints of the complement */ /* interval. */ /* WINDOW is the window to be complemented. */ /* $ Detailed_Output */ /* RESULT is the output window, containing the complement */ /* of WINDOW with respect to the interval from LEFT */ /* to RIGHT. If the output window is not large enough */ /* to contain the result, as many intervals as will */ /* fit are returned. */ /* RESULT must be distinct from WINDOW. */ /* $ Parameters */ /* None. */ /* $ Particulars */ /* Mathematically, the complement of a window contains those */ /* points that are not contained in the window. That is, the */ /* complement of the set of closed intervals */ /* [ a(1), b(1) ], [ a(2), b(2) ], ..., [ a(n), b(n) ] */ /* is the set of open intervals */ /* ( -inf, a(1) ), ( b(1), a(2) ), ..., ( b(n), +inf ) */ /* Because Fortran offers no satisfactory representation of */ /* infinity, we must take the complement with respect to a */ /* finite interval. */ /* In addition, Fortran offers no satisfactory floating point */ /* representation of open intervals. Therefore, the complement */ /* of a floating point window is closure of the set theoretical */ /* complement. In short, the floating point complement of the */ /* window */ /* [ a(1), b(1) ], [ a(2), b(2) ], ..., [ a(n), b(n) ] */ /* with respect to the interval from LEFT to RIGHT is the */ /* intersection of the windows */ /* ( -inf, a(1) ], [ b(1), a(2) ], ..., [ b(n), +inf ) */ /* and */ /* [ LEFT, RIGHT ] */ /* Note that floating point intervals of measure zero (singleton */ /* intervals) in the original window are replaced by gaps of */ /* measure zero, which are filled. Thus, complementing a floating */ /* point window twice does not necessarily yield the original */ /* window. */ /* $ Examples */ /* Let WINDOW contain the intervals */ /* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */ /* Then the floating point complement of WINDOW with respect */ /* to [2,20] contains the intervals */ /* [ 3, 7 ] [ 11, 20 ] */ /* and the complement with respect to [ 0, 100 ] contains */ /* [ 0, 1 ] [ 3, 7 ] [ 11, 23 ] [ 27, 100 ] */ /* $ Exceptions */ /* If LEFT is greater than RIGHT, the error SPICE(BADENDPOINTS) is */ /* signalled. */ /* $ Files */ /* None. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* H.A. Neilan (JPL) */ /* W.L. Taber (JPL) */ /* I.M. Underwood (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */ /* -& */ /* $ Index_Entries */ /* complement a d.p. window */ /* -& */ /* $ Revisions */ /* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */ /* Contents of the Required_Reading section was */ /* changed from "None." to "WINDOWS". Also, the */ /* declaration of the unused variable J was removed. */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Set up the error processing. */ if (return_()) { return 0; } chkin_("WNCOMD", (ftnlen)6); /* Get the cardinality of the input window. */ card = cardd_(window); /* Empty out the result window before proceeding. */ scardd_(&c__0, result); /* Check to see if the input interval is valid. If it is not, signal */ /* an error and return. */ if (*left > *right) { setmsg_("WNCOMD: Left endpoint may not exceed right endpoint.", ( ftnlen)52); sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19); chkout_("WNCOMD", (ftnlen)6); return 0; } /* There are two trivial cases: the window is empty, or it does not */ /* intersect the input interval. In either case, the complement is */ /* the entire interval. */ if (card == 0 || window[6] >= *right || window[card + 5] <= *left) { wninsd_(left, right, result); chkout_("WNCOMD", (ftnlen)6); return 0; } /* Let WINDOW represent the set of intervals */ /* [a1,b1], [a2,b2], ..., [aN,bN] */ /* Then the closure of the complement of WINDOW in the reals is */ /* (-infinity,a1], [b1,a2], [b2,a3], ..., [bN, infinity) */ /* Thus the sequence of endpoints of WINDOW is also the sequence */ /* of finite endpoints of its complement. Moreover, these endpoints */ /* are simply "shifted" from their original positions in WINDOW. */ /* This makes finding the complement of WINDOW with respect to */ /* a given interval almost trivial. */ /* Find the first right not less than the beginning of the input */ /* interval. */ i__ = 2; while(i__ <= card && window[i__ + 5] < *left) { i__ += 2; } /* If the beginning of the input interval doesn't split an interval */ /* in the input window, the complement begins with LEFT. */ if (i__ <= card && window[i__ + 4] > *left) { wninsd_(left, &window[i__ + 4], result); } /* Start schlepping endpoints [b(i),a(i+1)] from the input window */ /* to the output window. Stop when we find one of our new right */ /* endpoints exceeds the end of the input interval. */ while(! failed_() && i__ < card && window[i__ + 6] < *right) { wninsd_(&window[i__ + 5], &window[i__ + 6], result); i__ += 2; } /* If the end of the input interval doesn't split an interval */ /* in the input window, the complement ends with RIGHT. */ if (i__ <= card && window[i__ + 5] < *right) { wninsd_(&window[i__ + 5], right, result); } chkout_("WNCOMD", (ftnlen)6); return 0; } /* wncomd_ */
/* $Procedure ZZDDHF2H ( Private --- DDH Filename to Handle ) */ /* Subroutine */ int zzddhf2h_(char *fname, integer *ftabs, integer *ftamh, integer *ftarc, integer *ftbff, integer *fthan, char *ftnam, integer * ftrtm, doublereal *ftmnm, integer *nft, integer *utcst, integer * uthan, logical *utlck, integer *utlun, integer *nut, logical *exists, logical *opened, integer *handle, logical *found, doublereal *mnm, ftnlen fname_len, ftnlen ftnam_len) { /* System generated locals */ olist o__1; cllist cl__1; inlist ioin__1; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), f_open( olist *), f_clos(cllist *); /* Local variables */ integer unit; extern doublereal zzddhmnm_(integer *); extern /* Subroutine */ int zzddhgtu_(integer *, integer *, logical *, integer *, integer *, integer *), zzddhrmu_(integer *, integer *, integer *, integer *, logical *, integer *, integer *); integer i__; extern /* Subroutine */ int chkin_(char *, ftnlen); integer rchar; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); extern integer rtrim_(char *, ftnlen); extern logical failed_(void); extern integer isrchi_(integer *, integer *, integer *); logical locopn; extern /* Subroutine */ int sigerr_(char *, ftnlen); integer uindex; logical locexs; extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); /* $ 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. */ /* Convert filename to a handle. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* PRIVATE */ /* $ Declarations */ /* $ Abstract */ /* Parameter declarations for the DAF/DAS handle manager. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAF, DAS */ /* $ Keywords */ /* PRIVATE */ /* $ Particulars */ /* This include file contains parameters defining limits and */ /* integer codes that are utilized in the DAF/DAS handle manager */ /* routines. */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* F.S. Turner (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 2.5.0, 10-MAR-2014 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-INTEL. */ /* - SPICELIB Version 2.4.0, 10-MAR-2014 (BVS) */ /* Updated for PC-LINUX-64BIT-IFORT. */ /* - SPICELIB Version 2.3.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-GFORTRAN. */ /* - SPICELIB Version 2.2.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */ /* - SPICELIB Version 2.1.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GCC_C. */ /* - SPICELIB Version 2.0.0, 12-APR-2012 (BVS) */ /* Increased FTSIZE (from 1000 to 5000). */ /* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL. */ /* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-CC_C. */ /* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ /* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ /* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */ /* Updated for PC-WINDOWS-64BIT-IFORT. */ /* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */ /* Updated for PC-LINUX-64BIT-GFORTRAN. */ /* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */ /* Updated for PC-64BIT-MS_C. */ /* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-INTEL_C. */ /* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-IFORT. */ /* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-GFORTRAN. */ /* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */ /* Updated for PC-LINUX-GFORTRAN. */ /* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */ /* Updated for MAC-OSX-GFORTRAN. */ /* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */ /* Updated for PC-LINUX-IFORT. */ /* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */ /* Updated for PC-LINUX-64BIT-GCC_C. */ /* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-INTEL_C. */ /* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-IFORT. */ /* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */ /* Updated for PC-WINDOWS-IFORT. */ /* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-GCC_C. */ /* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN_C. */ /* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN. */ /* - SPICELIB Version 1.0.1, 17-JUL-2002 */ /* Added MAC-OSX environments. */ /* - SPICELIB Version 1.0.0, 07-NOV-2001 */ /* -& */ /* Unit and file table size parameters. */ /* FTSIZE is the maximum number of files (DAS and DAF) that a */ /* user may have open simultaneously. */ /* RSVUNT is the number of units protected from being locked */ /* to a particular handle by ZZDDHHLU. */ /* SCRUNT is the number of units protected for use by scratch */ /* files. */ /* UTSIZE is the maximum number of logical units this manager */ /* will utilize at one time. */ /* Access method enumeration. These parameters are used to */ /* identify which access method is associated with a particular */ /* handle. They need to be synchronized with the STRAMH array */ /* defined in ZZDDHGSD in the following fashion: */ /* STRAMH ( READ ) = 'READ' */ /* STRAMH ( WRITE ) = 'WRITE' */ /* STRAMH ( SCRTCH ) = 'SCRATCH' */ /* STRAMH ( NEW ) = 'NEW' */ /* These values are used in the file table variable FTAMH. */ /* Binary file format enumeration. These parameters are used to */ /* identify which binary file format is associated with a */ /* particular handle. They need to be synchronized with the STRBFF */ /* array defined in ZZDDHGSD in the following fashion: */ /* STRBFF ( BIGI3E ) = 'BIG-IEEE' */ /* STRBFF ( LTLI3E ) = 'LTL-IEEE' */ /* STRBFF ( VAXGFL ) = 'VAX-GFLT' */ /* STRBFF ( VAXDFL ) = 'VAX-DFLT' */ /* These values are used in the file table variable FTBFF. */ /* Some random string lengths... more documentation required. */ /* For now this will have to suffice. */ /* Architecture enumeration. These parameters are used to identify */ /* which file architecture is associated with a particular handle. */ /* They need to be synchronized with the STRARC array defined in */ /* ZZDDHGSD in the following fashion: */ /* STRARC ( DAF ) = 'DAF' */ /* STRARC ( DAS ) = 'DAS' */ /* These values will be used in the file table variable FTARC. */ /* For the following environments, record length is measured in */ /* characters (bytes) with eight characters per double precision */ /* number. */ /* Environment: Sun, Sun FORTRAN */ /* Source: Sun Fortran Programmer's Guide */ /* Environment: PC, MS FORTRAN */ /* Source: Microsoft Fortran Optimizing Compiler User's Guide */ /* Environment: Macintosh, Language Systems FORTRAN */ /* Source: Language Systems FORTRAN Reference Manual, */ /* Version 1.2, page 12-7 */ /* Environment: PC/Linux, g77 */ /* Source: Determined by experiment. */ /* Environment: PC, Lahey F77 EM/32 Version 4.0 */ /* Source: Lahey F77 EM/32 Language Reference Manual, */ /* page 144 */ /* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */ /* Source: FORTRAN/9000 Reference-Series 700 Computers, */ /* page 5-110 */ /* Environment: NeXT Mach OS (Black Hardware), */ /* Absoft Fortran Version 3.2 */ /* Source: NAIF Program */ /* The following parameter defines the size of a string used */ /* to store a filenames on this target platform. */ /* The following parameter controls the size of the character record */ /* buffer used to read data from non-native files. */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* FNAME I Name of the file to convert to a handle. */ /* FTABS, */ /* FTAMH, */ /* FTARC, */ /* FTBFF, */ /* FTHAN, */ /* FTNAM, */ /* FTRTM, */ /* FTMNM I File table. */ /* NFT I Number of entries in the file table. */ /* UTCST, */ /* UTHAN, */ /* UTLCK, */ /* UTLUN I/O Unit table. */ /* NUT I/O Number of entries in the unit table. */ /* EXISTS O Logical indicating if FNAME exists. */ /* OPENED O Logical indicating if FNAME is opened. */ /* HANDLE O Handle associated with FNAME. */ /* FOUND O Logical indicating if FNAME's HANDLE was found. */ /* MNM O Unique DP (Magic NuMber) associated with FNAME. */ /* $ Detailed_Input */ /* FNAME is the name of the file to locate in the file table. */ /* FTABS, */ /* FTAMH, */ /* FTARC, */ /* FTBFF, */ /* FTHAN, */ /* FTNAM, */ /* FTRTM, */ /* FTMNM are the arrays respectively containing the absolute */ /* value of the handle, access method, architecture, */ /* binary file format, handle, name, RTRIM and */ /* magic number columns of the file table. */ /* NFT is the number of entries in the file table. */ /* UTCST, */ /* UTHAN, */ /* UTLCK, */ /* UTLUN are the arrays respectively containing the cost, */ /* handle, locked, and logical unit columns of the unit */ /* table. */ /* NUT is the number of entries in the unit table. */ /* $ Detailed_Output */ /* UTCST, */ /* UTHAN, */ /* UTLCK, */ /* UTLUN are the arrays respectively containing the cost, */ /* handle, locked, and logical unit columns of the unit */ /* table. If ZZDDHF2H requires a logical unit, then */ /* it will borrow one from the unit table. Depending */ /* on the state of the table passed in from the caller */ /* one of three possible scenarios may occur (Recall */ /* that 'zero-cost' rows are ones whose units are */ /* reserved with RESLUN and not currently connected */ /* to any file.) */ /* A 'zero-cost' row exists in the table, in */ /* which case the row is used temporarily and */ /* may be removed depending on the number of entries */ /* in the file table (NFT). */ /* The unit table is full (NUT=UTSIZE), in which */ /* case the unit with the lowest cost that is not */ /* locked to its handle will be disconnected, used, */ /* and then returned to the table as a 'zero-cost' */ /* row before returning to the caller. */ /* The unit table is not full (NUT<UTSIZE) and there */ /* are no 'zero-cost' rows. In this case NUT is */ /* temporarily increased by one, and the new row */ /* is used. After this routine no longer requires */ /* the unit, depending on the number of entries in */ /* the file table (NFT) the row may be left in the */ /* table as a 'zero-handle' row or removed entirely. */ /* In the event an error is signaled, the contents of the */ /* unit table are placed into a usable state before */ /* returning to the caller. */ /* NUT is the number of entries in the unit table. Since */ /* this routine borrows a unit from the unit table, which */ /* may involve allocation of a new unit, this value may */ /* change. */ /* EXISTS is a logical if set to TRUE, indicates that FNAME */ /* exists. If FALSE, FNAME does not exist. In the event */ /* an exception is signaled the value is undefined. */ /* OPENED is a logical if set to TRUE, indicates that FNAME */ /* is opened and attached to a logical unit. If FALSE, */ /* FNAME is not attached to a unit. In the event an */ /* exception is signaled the value is undefined. */ /* HANDLE is the handle in the file table associated with */ /* FNAME. If FOUND is FALSE, then HANDLE is returned as */ /* 0. */ /* FOUND is a logical if TRUE indicates that FNAME was found */ /* in the file table. If FALSE indicates that it was not */ /* located. */ /* MNM is a unique (enough) DP number -- the Magic NuMber -- */ /* associated with FNAME computed by this examining the */ /* file contents. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If any of the INQUIRE statments this routine performs fail, */ /* the error SPICE(INQUIREFAILED) is signaled. FOUND is set to */ /* FALSE and HANDLE to 0. */ /* 2) If the attempt to open FNAME fails, then SPICE(FILEOPENFAILED) */ /* is signaled. FOUND is set to FALSE, and HANDLE to 0. */ /* 3) If FNAME is determined not to be loaded into the file table */ /* then FOUND is set to FALSE and HANDLE is set to 0. */ /* $ Files */ /* If the file named by FNAME is not connected to a logical unit, */ /* this routine will open it for direct access to complete its */ /* examination. */ /* $ Particulars */ /* This routine encapsulates the logic necessary to determine if */ /* a particular filename names a file already loaded into the */ /* DAF/DAS handle manager. If it discovers the file is loaded, */ /* the routine returns the handle to the caller. */ /* $ Examples */ /* See ZZDDHFNH for sample usage. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* F.S. Turner (JPL) */ /* E.D. Wright (JPL) */ /* B.V. Semenov (JPL) */ /* $ Version */ /* - SPICELIB Version 3.0.0, 26-APR-2012 (BVS) */ /* Changed calling sequence to include FTMNM and MNM. Change */ /* algorithm to compute MNM and use it to bypass n^2 INQUIREs */ /* for files opened for READ access, if possible. */ /* - SPICELIB Version 2.0.1, 24-APR-2003 (EDW) */ /* Added MAC-OSX-F77 to the list of platforms */ /* that require READONLY to read write protected */ /* kernels. */ /* - SPICELIB Version 2.0.0, 05-AUG-2002 (FST) */ /* Bug fix: this module was updated to allow proper loading */ /* of read-only files on VAX environments. */ /* - SPICELIB Version 1.0.0, 04-OCT-2001 (FST) */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 2.0.0, 05-AUG-2002 (FST) */ /* An OPEN statement that is exercised by this module under */ /* certain circumstances, failed to pass the non-standard */ /* READONLY option for the VAX environments. This had the */ /* undesirable side-effect of not permitting files available */ /* only for READ access to be opened. */ /* This file was promoted from a standard portable module */ /* to a master file. */ /* -& */ /* SPICELIB Functions */ /* Local Variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZDDHF2H", (ftnlen)8); } /* First check to see if FNAME is blank. If so, set FOUND to .FALSE. */ /* and return. ZZDDHOPN prevents any blank filenames from being */ /* loaded into the file table. */ if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) { *found = FALSE_; *handle = 0; *opened = FALSE_; *exists = FALSE_; chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* Start by trimming the file name in preparation for the INQUIRE. */ rchar = rtrim_(fname, fname_len); /* Now INQUIRE on the input file FNAME. */ ioin__1.inerr = 1; ioin__1.infilen = rchar; ioin__1.infile = fname; ioin__1.inex = &locexs; ioin__1.inopen = &locopn; ioin__1.innum = &unit; ioin__1.innamed = 0; ioin__1.inname = 0; ioin__1.inacc = 0; ioin__1.inseq = 0; ioin__1.indir = 0; ioin__1.infmt = 0; ioin__1.inform = 0; ioin__1.inunf = 0; ioin__1.inrecl = 0; ioin__1.innrec = 0; ioin__1.inblank = 0; iostat = f_inqu(&ioin__1); /* Check IOSTAT for failure. */ if (iostat != 0) { *found = FALSE_; *handle = 0; setmsg_("INQUIRE failed. Value of IOSTAT was #.", (ftnlen)38); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* First, set some of the output arguments. Remember, some */ /* systems consider non-existant files as open. Compensate for */ /* this unusual behavior. */ *exists = locexs; *opened = locopn && *exists; /* Now check to see if the file exists. If it does not, then */ /* set FOUND to false and HANDLE to 0 as non-existant files */ /* can not possibly be present in the file table. */ if (! (*exists)) { *found = FALSE_; *handle = 0; chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* Now check to see if the file is opened. If it is, we need to */ /* determine whether or not the logical unit to which it is */ /* attached is present in the unit table. */ if (*opened) { /* Since the file is opened, see if we can find its unit */ /* in the unit table. */ uindex = isrchi_(&unit, nut, utlun); /* When UINDEX is 0, the file is opened, but not by */ /* the DAF/DAS handle manager. Set FOUND to FALSE, HANDLE */ /* to 0, and return to the caller. */ if (uindex == 0) { *handle = 0; *found = FALSE_; chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* If we end up here, then we found UNIT in the unit table. */ /* Set FOUND to TRUE if the handle associated with UNIT is */ /* non-zero. */ *handle = uthan[uindex - 1]; *found = *handle != 0; chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* At this point, we took action for all simple cases. Now */ /* we need to find out if FNAME is one of the files in the */ /* file table that isn't open. To determine this, we open FNAME, */ /* and then INQUIRE on every file in the table. To do this, we */ /* need a unit. Get one. */ zzddhgtu_(utcst, uthan, utlck, utlun, nut, &uindex); if (failed_()) { *handle = 0; *found = FALSE_; chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* Now open the file (which we know exists and isn't open). Since */ /* we effectively are just borrowing this unit, we are not going to */ /* set UTHAN or UTCST from the defaults that ZZDDHGTU sets up. */ o__1.oerr = 1; o__1.ounit = utlun[uindex - 1]; o__1.ofnmlen = rchar; o__1.ofnm = fname; o__1.orl = 1024; o__1.osta = "OLD"; o__1.oacc = "DIRECT"; o__1.ofm = 0; o__1.oblnk = 0; iostat = f_open(&o__1); /* Check IOSTAT. */ if (iostat != 0) { /* Since an error has occurred, set FOUND to false and HANDLE */ /* to 0. */ *found = FALSE_; *handle = 0; /* Close the unit and remove it from the unit table. */ cl__1.cerr = 0; cl__1.cunit = utlun[uindex - 1]; cl__1.csta = 0; f_clos(&cl__1); zzddhrmu_(&uindex, nft, utcst, uthan, utlck, utlun, nut); /* Signal the error and return. */ setmsg_("Attempt to open file '#' failed. Value of IOSTAT was #.", ( ftnlen)55); errch_("#", fname, (ftnlen)1, fname_len); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21); chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* Get a unique enough DP number -- the Magic NuMber (MNM) ;) -- for */ /* this file. */ *mnm = zzddhmnm_(&utlun[uindex - 1]); /* Now loop through all the files in the file table. Unfortunately */ /* we have no other choice. */ i__ = 1; *found = FALSE_; while(i__ <= *nft && ! (*found)) { /* If this file's magic number is non-zero and is different from */ /* the magic number of the currently checked, opened-for-READ */ /* file, we will declare that these files are not the same file */ /* and will skip INQUIRE. In all other cases we will do INQUIRE */ /* and check UNITs. */ if (*mnm != 0. && (*mnm != ftmnm[i__ - 1] && ftamh[i__ - 1] == 1)) { /* These files are not the same file. Clear IOSTAT and set */ /* UNIT to not match the UNIT of the input file. */ iostat = 0; unit = utlun[uindex - 1] + 1; } else { /* Do the INQUIRE. ;( */ ioin__1.inerr = 1; ioin__1.infilen = ftrtm[i__ - 1]; ioin__1.infile = ftnam + (i__ - 1) * ftnam_len; ioin__1.inex = &locexs; ioin__1.inopen = &locopn; ioin__1.innum = &unit; ioin__1.innamed = 0; ioin__1.inname = 0; ioin__1.inacc = 0; ioin__1.inseq = 0; ioin__1.indir = 0; ioin__1.infmt = 0; ioin__1.inform = 0; ioin__1.inunf = 0; ioin__1.inrecl = 0; ioin__1.innrec = 0; ioin__1.inblank = 0; iostat = f_inqu(&ioin__1); } /* Check IOSTAT. */ if (iostat != 0) { /* Since we have an error condition, set FOUND to FALSE */ /* and HANDLE to 0. */ *found = FALSE_; *handle = 0; /* Close the unit and clean up the unit table. */ cl__1.cerr = 0; cl__1.cunit = utlun[uindex - 1]; cl__1.csta = 0; f_clos(&cl__1); zzddhrmu_(&uindex, nft, utcst, uthan, utlck, utlun, nut); /* Signal the error and return. */ setmsg_("INQUIRE failed. Value of IOSTAT was #.", (ftnlen)38); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20); chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* Now check to see if FILE exists, is currently open. and */ /* its UNIT matches UTLUN(UINDEX). */ if (locexs && locopn && unit == utlun[uindex - 1]) { *handle = fthan[i__ - 1]; *found = TRUE_; /* Otherwise, continue searching. */ } else { ++i__; } } /* Check to see if we found the file in the file table. */ if (! (*found)) { *handle = 0; } /* Close the unit and clean up the unit table. */ cl__1.cerr = 0; cl__1.cunit = utlun[uindex - 1]; cl__1.csta = 0; f_clos(&cl__1); zzddhrmu_(&uindex, nft, utcst, uthan, utlck, utlun, nut); chkout_("ZZDDHF2H", (ftnlen)8); return 0; } /* zzddhf2h_ */