/* $Procedure CKW01 ( C-Kernel, write segment to C-kernel, data type 1 ) */ /* Subroutine */ int ckw01_(integer *handle, doublereal *begtim, doublereal * endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal * avvs, ftnlen ref_len, ftnlen segid_len) { /* System generated locals */ integer i__1, i__2; doublereal d__1; /* Local variables */ integer ndir, i__; extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *); doublereal descr[5]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); integer index, value; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_( doublereal *, integer *), dafbna_(integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); integer refcod; extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); extern integer lastnb_(char *, ftnlen); doublereal dirent; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); extern logical vzerog_(doublereal *, integer *), return_(void); doublereal dcd[2]; integer icd[6]; /* $ Abstract */ /* Add a type 1 segment to a C-kernel. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* CK */ /* DAF */ /* SCLK */ /* $ Keywords */ /* POINTING */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of an open CK file. */ /* BEGTIM I The beginning encoded SCLK of the segment. */ /* ENDTIM I The ending encoded SCLK of the segment. */ /* INST I The NAIF instrument ID code. */ /* REF I The reference frame of the segment. */ /* AVFLAG I True if the segment will contain angular velocity. */ /* SEGID I Segment identifier. */ /* NREC I Number of pointing records. */ /* SCLKDP I Encoded SCLK times. */ /* QUATS I SPICE quaternions representing instrument pointing. */ /* AVVS I Angular velocity vectors. */ /* $ Detailed_Input */ /* HANDLE is the handle of the CK file to which the segment will */ /* be written. The file must have been opened with write */ /* access. */ /* BEGTIM is the beginning encoded SCLK time of the segment. This */ /* value should be less than or equal to the first time in */ /* the segment. */ /* ENDTIM is the encoded SCLK time at which the segment ends. */ /* This value should be greater than or equal to the last */ /* time in the segment. */ /* INST is the NAIF integer ID code for the instrument. */ /* REF is a character string which specifies the */ /* reference frame of the segment. This should be one of */ /* the frames supported by the SPICELIB routine NAMFRM */ /* which is an entry point of FRAMEX. */ /* AVFLAG is a logical flag which indicates whether or not the */ /* segment will contain angular velocity. */ /* SEGID is the segment identifier. A CK segment identifier may */ /* contain up to 40 characters. */ /* NREC is the number of pointing instances in the segment. */ /* SCLKDP are the encoded spacecraft clock times associated with */ /* each pointing instance. These times must be strictly */ /* increasing. */ /* QUATS is an array of SPICE-style quaternions representing a */ /* sequence of C-matrices. See the discussion of */ /* quaternion styles in Particulars below. */ /* AVVS are the angular velocity vectors ( optional ). */ /* If AVFLAG is FALSE then this array is ignored by the */ /* routine, however it still must be supplied as part of */ /* the calling sequence. */ /* $ Detailed_Output */ /* None. See Files section. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is not the handle of a C-kernel opened for writing */ /* the error will be diagnosed by routines called by this */ /* routine. */ /* 2) If SEGID is more than 40 characters long, the error */ /* SPICE(SEGIDTOOLONG) is signalled. */ /* 3) If SEGID contains any nonprintable characters, the error */ /* SPICE(NONPRINTABLECHARS) is signalled. */ /* 4) If the first encoded SCLK time is negative then the error */ /* SPICE(INVALIDSCLKTIME) is signalled. If any subsequent times */ /* are negative the error SPICE(TIMESOUTOFORDER) is signalled. */ /* 5) If the encoded SCLK times are not strictly increasing, */ /* the error SPICE(TIMESOUTOFORDER) is signalled. */ /* 6) If BEGTIM is greater than SCLKDP(1) or ENDTIM is less than */ /* SCLKDP(NREC), the error SPICE(INVALIDDESCRTIME) is */ /* signalled. */ /* 7) If the name of the reference frame is not one of those */ /* supported by the routine NAMFRM, the error */ /* SPICE(INVALIDREFFRAME) is signalled. */ /* 8) If NREC, the number of pointing records, is less than or */ /* equal to 0, the error SPICE(INVALIDNUMRECS) is signalled. */ /* 9) If the squared length of any quaternion differes from 1 */ /* by more than 1.0D-2, the error SPICE(NONUNITQUATERNION) is */ /* signalled. */ /* $ Files */ /* This routine adds a type 1 segment to a C-kernel. The C-kernel */ /* may be either a new one or an existing one opened for writing. */ /* $ Particulars */ /* For a detailed description of a type 1 CK segment please see the */ /* CK Required Reading. */ /* This routine relieves the user from performing the repetitive */ /* calls to the DAF routines necessary to construct a CK segment. */ /* Quaternion Styles */ /* ----------------- */ /* There are different "styles" of quaternions used in */ /* science and engineering applications. Quaternion styles */ /* are characterized by */ /* - The order of quaternion elements */ /* - The quaternion multiplication formula */ /* - The convention for associating quaternions */ /* with rotation matrices */ /* Two of the commonly used styles are */ /* - "SPICE" */ /* > Invented by Sir William Rowan Hamilton */ /* > Frequently used in mathematics and physics textbooks */ /* - "Engineering" */ /* > Widely used in aerospace engineering applications */ /* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ /* Quaternions of any other style must be converted to SPICE */ /* quaternions before they are passed to SPICELIB routines. */ /* Relationship between SPICE and Engineering Quaternions */ /* ------------------------------------------------------ */ /* Let M be a rotation matrix such that for any vector V, */ /* M*V */ /* is the result of rotating V by theta radians in the */ /* counterclockwise direction about unit rotation axis vector A. */ /* Then the SPICE quaternions representing M are */ /* (+/-) ( cos(theta/2), */ /* sin(theta/2) A(1), */ /* sin(theta/2) A(2), */ /* sin(theta/2) A(3) ) */ /* while the engineering quaternions representing M are */ /* (+/-) ( -sin(theta/2) A(1), */ /* -sin(theta/2) A(2), */ /* -sin(theta/2) A(3), */ /* cos(theta/2) ) */ /* For both styles of quaternions, if a quaternion q represents */ /* a rotation matrix M, then -q represents M as well. */ /* Given an engineering quaternion */ /* QENG = ( q0, q1, q2, q3 ) */ /* the equivalent SPICE quaternion is */ /* QSPICE = ( q3, -q0, -q1, -q2 ) */ /* Associating SPICE Quaternions with Rotation Matrices */ /* ---------------------------------------------------- */ /* Let FROM and TO be two right-handed reference frames, for */ /* example, an inertial frame and a spacecraft-fixed frame. Let the */ /* symbols */ /* V , V */ /* FROM TO */ /* denote, respectively, an arbitrary vector expressed relative to */ /* the FROM and TO frames. Let M denote the transformation matrix */ /* that transforms vectors from frame FROM to frame TO; then */ /* V = M * V */ /* TO FROM */ /* where the expression on the right hand side represents left */ /* multiplication of the vector by the matrix. */ /* Then if the unit-length SPICE quaternion q represents M, where */ /* q = (q0, q1, q2, q3) */ /* the elements of M are derived from the elements of q as follows: */ /* +- -+ */ /* | 2 2 | */ /* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ /* | | */ /* | | */ /* | 2 2 | */ /* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ /* | | */ /* | | */ /* | 2 2 | */ /* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ /* | | */ /* +- -+ */ /* Note that substituting the elements of -q for those of q in the */ /* right hand side leaves each element of M unchanged; this shows */ /* that if a quaternion q represents a matrix M, then so does the */ /* quaternion -q. */ /* To map the rotation matrix M to a unit quaternion, we start by */ /* decomposing the rotation matrix as a sum of symmetric */ /* and skew-symmetric parts: */ /* 2 */ /* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ /* symmetric skew-symmetric */ /* OMEGA is a skew-symmetric matrix of the form */ /* +- -+ */ /* | 0 -n3 n2 | */ /* | | */ /* OMEGA = | n3 0 -n1 | */ /* | | */ /* | -n2 n1 0 | */ /* +- -+ */ /* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ /* of M and theta is M's rotation angle. Note that N and theta */ /* are not unique. */ /* Let */ /* C = cos(theta/2) */ /* S = sin(theta/2) */ /* Then the unit quaternions Q corresponding to M are */ /* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ /* The mappings between quaternions and the corresponding rotations */ /* are carried out by the SPICELIB routines */ /* Q2M {quaternion to matrix} */ /* M2Q {matrix to quaternion} */ /* M2Q always returns a quaternion with scalar part greater than */ /* or equal to zero. */ /* SPICE Quaternion Multiplication Formula */ /* --------------------------------------- */ /* Given a SPICE quaternion */ /* Q = ( q0, q1, q2, q3 ) */ /* corresponding to rotation axis A and angle theta as above, we can */ /* represent Q using "scalar + vector" notation as follows: */ /* s = q0 = cos(theta/2) */ /* v = ( q1, q2, q3 ) = sin(theta/2) * A */ /* Q = s + v */ /* Let Q1 and Q2 be SPICE quaternions with respective scalar */ /* and vector parts s1, s2 and v1, v2: */ /* Q1 = s1 + v1 */ /* Q2 = s2 + v2 */ /* We represent the dot product of v1 and v2 by */ /* <v1, v2> */ /* and the cross product of v1 and v2 by */ /* v1 x v2 */ /* Then the SPICE quaternion product is */ /* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */ /* If Q1 and Q2 represent the rotation matrices M1 and M2 */ /* respectively, then the quaternion product */ /* Q1*Q2 */ /* represents the matrix product */ /* M1*M2 */ /* $ Examples */ /* C */ /* C This example writes a type 1 C-kernel segment for the */ /* C Galileo scan platform to a previously opened file attached to */ /* C HANDLE. */ /* C */ /* C Assume arrays of quaternions, angular velocities, and the */ /* C associated SCLK times are produced elsewhere. */ /* C */ /* . */ /* . */ /* . */ /* C */ /* C The subroutine CKW01 needs the following items for the */ /* C segment descriptor: */ /* C */ /* C 1) SCLK limits of the segment. */ /* C 2) Instrument code. */ /* C 3) Reference frame. */ /* C 4) The angular velocity flag. */ /* C */ /* BEGTIM = SCLK ( 1 ) */ /* ENDTIM = SCLK ( NREC ) */ /* INST = -77001 */ /* REF = 'J2000' */ /* AVFLAG = .TRUE. */ /* SEGID = 'GLL SCAN PLT - DATA TYPE 1' */ /* C */ /* C Write the segment. */ /* C */ /* CALL CKW01 ( HANDLE, BEGTIM, ENDTIM, INST, REF, AVFLAG, */ /* . SEGID, NREC, SCLKDP, QUATS, AVVS ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* K.R. Gehringer (JPL) */ /* N.J. Bachman (JPL) */ /* J.M. Lynch (JPL) */ /* $ Version */ /* - SPICELIB Version 3.0.0, 01-JUN-2010 (NJB) */ /* The check for non-unit quaternions has been replaced */ /* with a check for zero-length quaternions. */ /* - SPICELIB Version 2.2.0, 26-FEB-2008 (NJB) */ /* Updated header; added information about SPICE */ /* quaternion conventions. */ /* Minor typo in a long error message was corrected. */ /* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */ /* Added check to make sure that all quaternions are unit */ /* length to single precision. */ /* - SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) */ /* The routine was upgraded to support non-inertial reference */ /* frames. */ /* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ /* Removed all references to a specific method of opening the CK */ /* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ /* $ Files, and $ Examples sections of the header. It is assumed */ /* that a person using this routine has some knowledge of the DAF */ /* system and the methods for obtaining file handles. */ /* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ /* If the number of pointing records is not positive an error */ /* is now signalled. */ /* FAILED is checked after the call to DAFBNA. */ /* The variable HLDCLK was removed from the loop where the times */ /* were checked. */ /* - 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, 30-AUG-1991 (JML) (NJB) */ /* -& */ /* $ Index_Entries */ /* write ck type_1 pointing data segment */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */ /* Removed all references to a specific method of opening the CK */ /* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */ /* $ Files, and $ Examples sections of the header. It is assumed */ /* that a person using this routine has some knowledge of the DAF */ /* system and the methods for obtaining file handles. */ /* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */ /* If the number of pointing records is not positive an error */ /* is now signalled. */ /* FAILED is checked after the call to DAFBNA. */ /* The variable HLDCLK was removed from the loop where the times */ /* were checked. */ /* - 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, 30-AUG-1991 (JML) (NJB) */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* SIDLEN is the maximum number of characters allowed in a CK */ /* segment identifier. */ /* NDC is the size of a packed CK segment descriptor. */ /* ND is the number of double precision components in a CK */ /* segment descriptor. */ /* NI is the number of integer components in a CK segment */ /* descriptor. */ /* DTYPE is the data type of the segment that this routine */ /* operates on. */ /* FPRINT is the integer value of the first printable ASCII */ /* character. */ /* LPRINT is the integer value of the last printable ASCII */ /* character. */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("CKW01", (ftnlen)5); /* The first thing that we will do is create the segment descriptor. */ /* The structure of the segment descriptor is as follows. */ /* DCD( 1 ) and DCD( 2 ) -- SCLK limits of the segment. */ /* ICD( 1 ) -- Instrument code. */ /* ICD( 2 ) -- Reference frame ID. */ /* ICD( 3 ) -- Data type of the segment. */ /* ICD( 4 ) -- Angular rates flag. */ /* ICD( 5 ) -- Beginning address of segment. */ /* ICD( 6 ) -- Ending address of segment. */ /* Make sure that there is a positive number of pointing records. */ if (*nrec <= 0) { setmsg_("# is an invalid number of pointing instances for type 1.", ( ftnlen)56); errint_("#", nrec, (ftnlen)1); sigerr_("SPICE(INVALIDNUMREC)", (ftnlen)20); chkout_("CKW01", (ftnlen)5); return 0; } /* Check that the SCLK bounds on the segment are reasonable. */ if (*begtim > sclkdp[0]) { setmsg_("The first d.p. component of the descriptor is invalid. DCD(" "1) = # and SCLKDP(1) = # ", (ftnlen)84); errdp_("#", begtim, (ftnlen)1); errdp_("#", sclkdp, (ftnlen)1); sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); chkout_("CKW01", (ftnlen)5); return 0; } if (*endtim < sclkdp[*nrec - 1]) { setmsg_("The second d.p. component of the descriptor is invalid. DCD" "(2) = # and SCLKDP(NREC) = # ", (ftnlen)88); errdp_("#", endtim, (ftnlen)1); errdp_("#", &sclkdp[*nrec - 1], (ftnlen)1); sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23); chkout_("CKW01", (ftnlen)5); return 0; } dcd[0] = *begtim; dcd[1] = *endtim; /* Get the NAIF integer code for the reference frame. */ namfrm_(ref, &refcod, ref_len); if (refcod == 0) { setmsg_("The reference frame # is not supported.", (ftnlen)39); errch_("#", ref, (ftnlen)1, ref_len); sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); chkout_("CKW01", (ftnlen)5); return 0; } /* Assign values to the integer components of the segment descriptor. */ icd[0] = *inst; icd[1] = refcod; icd[2] = 1; if (*avflag) { icd[3] = 1; } else { icd[3] = 0; } /* Now pack the segment descriptor. */ dafps_(&c__2, &c__6, dcd, icd, descr); /* Check that all the characters in the segid can be printed. */ i__1 = lastnb_(segid, segid_len); for (i__ = 1; i__ <= i__1; ++i__) { value = *(unsigned char *)&segid[i__ - 1]; if (value < 32 || value > 126) { setmsg_("The segment identifier contains nonprintable characters", (ftnlen)55); sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); chkout_("CKW01", (ftnlen)5); return 0; } } /* Also 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_("CKW01", (ftnlen)5); return 0; } /* Now check that the encoded SCLK times are positive and strictly */ /* increasing. */ /* Check that the first time is nonnegative. */ if (sclkdp[0] < 0.) { setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37); errdp_("#", sclkdp, (ftnlen)1); sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22); chkout_("CKW01", (ftnlen)5); return 0; } /* Now check that the times are ordered properly. */ i__1 = *nrec; for (i__ = 2; i__ <= i__1; ++i__) { if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) { setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)" " = # and SCLKDP(#) = #.", (ftnlen)78); errint_("#", &i__, (ftnlen)1); errdp_("#", &sclkdp[i__ - 1], (ftnlen)1); i__2 = i__ - 1; errint_("#", &i__2, (ftnlen)1); errdp_("#", &sclkdp[i__ - 2], (ftnlen)1); sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); chkout_("CKW01", (ftnlen)5); return 0; } } /* Make sure that the quaternions are non-zero. This is just */ /* a check for uninitialized data. */ i__1 = *nrec; for (i__ = 1; i__ <= i__1; ++i__) { if (vzerog_(&quats[(i__ << 2) - 4], &c__4)) { setmsg_("The quaternion at index # has magnitude zero.", (ftnlen) 45); errint_("#", &i__, (ftnlen)1); sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21); chkout_("CKW01", (ftnlen)5); return 0; } } /* No more checks, begin writing the segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("CKW01", (ftnlen)5); return 0; } /* Now add the quaternions and optionally, the angular velocity */ /* vectors. */ if (*avflag) { i__1 = *nrec; for (i__ = 1; i__ <= i__1; ++i__) { dafada_(&quats[(i__ << 2) - 4], &c__4); dafada_(&avvs[i__ * 3 - 3], &c__3); } } else { i__1 = *nrec; for (i__ = 1; i__ <= i__1; ++i__) { dafada_(&quats[(i__ << 2) - 4], &c__4); } } /* Add the SCLK times. */ dafada_(sclkdp, nrec); /* The time tag directory. The Ith element is defined to be the */ /* average of the (I*100)th and the (I*100+1)st SCLK time. */ ndir = (*nrec - 1) / 100; index = 100; i__1 = ndir; for (i__ = 1; i__ <= i__1; ++i__) { dirent = (sclkdp[index - 1] + sclkdp[index]) / 2.; dafada_(&dirent, &c__1); index += 100; } /* Finally, the number of records. */ d__1 = (doublereal) (*nrec); dafada_(&d__1, &c__1); /* End the segment. */ dafena_(); chkout_("CKW01", (ftnlen)5); return 0; } /* ckw01_ */
/* $Procedure CKW05 ( Write CK segment, type 5 ) */ /* Subroutine */ int ckw05_(integer *handle, integer *subtyp, integer *degree, doublereal *begtim, doublereal *endtim, integer *inst, char *ref, logical *avflag, char *segid, integer *n, doublereal *sclkdp, doublereal *packts, doublereal *rate, integer *nints, doublereal * starts, ftnlen ref_len, ftnlen segid_len) { /* System generated locals */ integer i__1, i__2; doublereal d__1; /* Local variables */ integer addr__, i__; extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *); doublereal descr[5]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), 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 chrcod, refcod; extern integer bsrchd_(doublereal *, integer *, doublereal *); extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); extern integer lastnb_(char *, ftnlen); integer packsz; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); extern integer lstltd_(doublereal *, integer *, doublereal *); extern logical vzerog_(doublereal *, integer *), return_(void); integer winsiz; extern logical odd_(integer *); /* $ Abstract */ /* Write a type 5 segment to a CK file. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* CK */ /* NAIF_IDS */ /* ROTATION */ /* TIME */ /* $ Keywords */ /* POINTING */ /* FILES */ /* $ Declarations */ /* $ Abstract */ /* Declare parameters specific to CK type 05. */ /* $ 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 */ /* CK */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */ /* -& */ /* CK type 5 subtype codes: */ /* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */ /* and quaternion derivatives only, no angular velocity */ /* vector provided. Quaternion elements are listed */ /* first, followed by derivatives. Angular velocity is */ /* derived from the quaternions and quaternion */ /* derivatives. */ /* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */ /* only. Angular velocity is derived by differentiating */ /* the interpolating polynomials. */ /* Subtype 2: Hermite interpolation, 14-element packets. */ /* Quaternion and angular angular velocity vector, as */ /* well as derivatives of each, are provided. The */ /* quaternion comes first, then quaternion derivatives, */ /* then angular velocity and its derivatives. */ /* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */ /* and angular velocity vector provided. The quaternion */ /* comes first. */ /* Packet sizes associated with the various subtypes: */ /* End of file ck05.inc. */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of an CK file open for writing. */ /* SUBTYP I CK type 5 subtype code. */ /* DEGREE I Degree of interpolating polynomials. */ /* BEGTIM I Start time of interval covered by segment. */ /* ENDTIM I End time of interval covered by segment. */ /* INST I NAIF code for a s/c instrument or structure. */ /* REF I Reference frame name. */ /* AVFLAG I True if the segment will contain angular velocity. */ /* SEGID I Segment identifier. */ /* N I Number of packets. */ /* SCLKDP I Encoded SCLK times. */ /* PACKTS I Array of packets. */ /* RATE I Nominal SCLK rate in seconds per tick. */ /* NINTS I Number of intervals. */ /* STARTS I Encoded SCLK interval start times. */ /* MAXDEG P Maximum allowed degree of interpolating polynomial. */ /* $ Detailed_Input */ /* HANDLE is the file handle of a CK file that has been */ /* opened for writing. */ /* SUBTYP is an integer code indicating the subtype of the */ /* the segment to be created. */ /* DEGREE is the degree of the polynomials used to */ /* interpolate the quaternions contained in the input */ /* packets. All components of the quaternions are */ /* interpolated by polynomials of fixed degree. */ /* BEGTIM, */ /* ENDTIM are the beginning and ending encoded SCLK times */ /* for which the segment provides pointing */ /* information. BEGTIM must be less than or equal to */ /* ENDTIM, and at least one data packet must have a */ /* time tag T such that */ /* BEGTIM < T < ENDTIM */ /* - - */ /* INST is the NAIF integer code for the instrument or */ /* structure for which a segment is to be created. */ /* REF is the NAIF name for a reference frame relative to */ /* which the pointing information for INST is */ /* specified. */ /* AVFLAG is a logical flag which indicates whether or not */ /* the segment will contain angular velocity. */ /* SEGID is the segment identifier. A CK segment */ /* identifier may contain up to 40 characters. */ /* N is the number of packets in the input packet */ /* array. */ /* SCLKDP are the encoded spacecraft clock times associated */ /* with each pointing instance. These times must be */ /* strictly increasing. */ /* PACKTS contains a time-ordered array of data packets */ /* representing the orientation of INST relative to */ /* the frame REF. Each packet contains a SPICE-style */ /* quaternion and optionally, depending on the */ /* segment subtype, attitude derivative data, from */ /* which a C-matrix and an angular velocity vector */ /* may be derived. */ /* See the discussion of quaternion styles in */ /* Particulars below. */ /* The C-matrix represented by the Ith data packet is */ /* a rotation matrix that transforms the components */ /* of a vector expressed in the base frame specified */ /* by REF to components expressed in the instrument */ /* fixed frame at the time SCLKDP(I). */ /* Thus, if a vector V has components x, y, z in the */ /* base frame, then V has components x', y', z' */ /* in the instrument fixed frame where: */ /* [ x' ] [ ] [ x ] */ /* | y' | = | CMAT | | y | */ /* [ z' ] [ ] [ z ] */ /* The attitude derivative information in PACKTS(I) */ /* gives the angular velocity of the instrument fixed */ /* frame at time SCLKDP(I) with respect to the */ /* reference frame specified by REF. */ /* The direction of an angular velocity vector gives */ /* the right-handed axis about which the instrument */ /* fixed reference frame is rotating. The magnitude */ /* of the vector is the magnitude of the */ /* instantaneous velocity of the rotation, in radians */ /* per second. */ /* Packet contents and the corresponding */ /* interpolation methods depend on the segment */ /* subtype, and are as follows: */ /* Subtype 0: Hermite interpolation, 8-element */ /* packets. Quaternion and quaternion */ /* derivatives only, no angular */ /* velocity vector provided. */ /* Quaternion elements are listed */ /* first, followed by derivatives. */ /* Angular velocity is derived from */ /* the quaternions and quaternion */ /* derivatives. */ /* Subtype 1: Lagrange interpolation, 4-element */ /* packets. Quaternion only. Angular */ /* velocity is derived by */ /* differentiating the interpolating */ /* polynomials. */ /* Subtype 2: Hermite interpolation, 14-element */ /* packets. Quaternion and angular */ /* angular velocity vector, as well as */ /* derivatives of each, are provided. */ /* The quaternion comes first, then */ /* quaternion derivatives, then */ /* angular velocity and its */ /* derivatives. */ /* Subtype 3: Lagrange interpolation, 7-element */ /* packets. Quaternion and angular */ /* velocity vector provided. The */ /* quaternion comes first. */ /* Angular velocity is always specified relative to */ /* the base frame. */ /* RATE is the nominal rate of the spacecraft clock */ /* associated with INST. Units are seconds per */ /* tick. RATE is used to scale angular velocity */ /* to radians/second. */ /* NINTS is the number of intervals that the pointing */ /* instances are partitioned into. */ /* STARTS are the start times of each of the interpolation */ /* intervals. These times must be strictly increasing */ /* and must coincide with times for which the segment */ /* contains pointing. */ /* $ 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. If the value of MAXDEG is increased, */ /* the SPICELIB routine CKPFS must be changed */ /* accordingly. In particular, the size of the */ /* record passed to CKRnn and CKEnn must be */ /* increased, and comments describing the record size */ /* must be changed. */ /* $ Exceptions */ /* If any of the following exceptions occur, this routine will return */ /* without creating a new segment. */ /* 1) If HANDLE is not the handle of a C-kernel opened for writing */ /* the error will be diagnosed by routines called by this */ /* routine. */ /* 2) If the last non-blank character of SEGID occurs past index 40, */ /* the error SPICE(SEGIDTOOLONG) is signaled. */ /* 3) If SEGID contains any nonprintable characters, the error */ /* SPICE(NONPRINTABLECHARS) is signaled. */ /* 4) If the first encoded SCLK time is negative then the error */ /* SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times */ /* are negative the error will be detected in exception (5). */ /* 5) If the encoded SCLK times are not strictly increasing, */ /* the error SPICE(TIMESOUTOFORDER) is signaled. */ /* 6) If the name of the reference frame is not one of those */ /* supported by the routine FRAMEX, the error */ /* SPICE(INVALIDREFFRAME) is signaled. */ /* 7) If the number of packets N is not at least 1, the error */ /* SPICE(TOOFEWPACKETS) will be signaled. */ /* 8) If NINTS, the number of interpolation intervals, is less than */ /* or equal to 0, the error SPICE(INVALIDNUMINTS) is signaled. */ /* 9) If the encoded SCLK interval start times are not strictly */ /* increasing, the error SPICE(TIMESOUTOFORDER) is signaled. */ /* 10) If an interval start time does not coincide with a time for */ /* which there is an actual pointing instance in the segment, */ /* then the error SPICE(INVALIDSTARTTIME) is signaled. */ /* 11) This routine assumes that the rotation between adjacent */ /* quaternions that are stored in the same interval has a */ /* rotation angle of THETA radians, where */ /* 0 < THETA < pi. */ /* _ */ /* The routines that evaluate the data in the segment produced */ /* by this routine cannot distinguish between rotations of THETA */ /* radians, where THETA is in the interval [0, pi), and */ /* rotations of */ /* THETA + 2 * k * pi */ /* radians, where k is any integer. These "large" rotations will */ /* yield invalid results when interpolated. You must ensure that */ /* the data stored in the segment will not be subject to this */ /* sort of ambiguity. */ /* 12) If any quaternion has magnitude zero, the error */ /* SPICE(ZEROQUATERNION) is signaled. */ /* 13) If the interpolation window size implied by DEGREE is not */ /* even, the error SPICE(INVALIDDEGREE) is signaled. The window */ /* size is DEGREE+1 for Lagrange subtypes and is (DEGREE+1)/2 */ /* for Hermite subtypes. */ /* 14) If an unrecognized subtype code is supplied, the error */ /* SPICE(NOTSUPPORTED) is signaled. */ /* 15) If DEGREE is not at least 1 or is greater than MAXDEG, the */ /* error SPICE(INVALIDDEGREE) is signaled. */ /* 16) If the segment descriptor bounds are out of order, the */ /* error SPICE(BADDESCRTIMES) is signaled. */ /* 17) If there is no element of SCLKDP that lies between BEGTIM and */ /* ENDTIM inclusive, the error SPICE(EMPTYSEGMENT) is signaled. */ /* 18) If RATE is zero, the error SPICE(INVALIDVALUE) is signaled. */ /* $ Files */ /* A new type 5 CK segment is written to the CK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes a CK type 5 data segment to the open CK */ /* file according to the format described in the type 5 section of */ /* the CK Required Reading. The CK file must have been opened with */ /* write access. */ /* Quaternion Styles */ /* ----------------- */ /* There are different "styles" of quaternions used in */ /* science and engineering applications. Quaternion styles */ /* are characterized by */ /* - The order of quaternion elements */ /* - The quaternion multiplication formula */ /* - The convention for associating quaternions */ /* with rotation matrices */ /* Two of the commonly used styles are */ /* - "SPICE" */ /* > Invented by Sir William Rowan Hamilton */ /* > Frequently used in mathematics and physics textbooks */ /* - "Engineering" */ /* > Widely used in aerospace engineering applications */ /* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ /* Quaternions of any other style must be converted to SPICE */ /* quaternions before they are passed to SPICELIB routines. */ /* Relationship between SPICE and Engineering Quaternions */ /* ------------------------------------------------------ */ /* Let M be a rotation matrix such that for any vector V, */ /* M*V */ /* is the result of rotating V by theta radians in the */ /* counterclockwise direction about unit rotation axis vector A. */ /* Then the SPICE quaternions representing M are */ /* (+/-) ( cos(theta/2), */ /* sin(theta/2) A(1), */ /* sin(theta/2) A(2), */ /* sin(theta/2) A(3) ) */ /* while the engineering quaternions representing M are */ /* (+/-) ( -sin(theta/2) A(1), */ /* -sin(theta/2) A(2), */ /* -sin(theta/2) A(3), */ /* cos(theta/2) ) */ /* For both styles of quaternions, if a quaternion q represents */ /* a rotation matrix M, then -q represents M as well. */ /* Given an engineering quaternion */ /* QENG = ( q0, q1, q2, q3 ) */ /* the equivalent SPICE quaternion is */ /* QSPICE = ( q3, -q0, -q1, -q2 ) */ /* Associating SPICE Quaternions with Rotation Matrices */ /* ---------------------------------------------------- */ /* Let FROM and TO be two right-handed reference frames, for */ /* example, an inertial frame and a spacecraft-fixed frame. Let the */ /* symbols */ /* V , V */ /* FROM TO */ /* denote, respectively, an arbitrary vector expressed relative to */ /* the FROM and TO frames. Let M denote the transformation matrix */ /* that transforms vectors from frame FROM to frame TO; then */ /* V = M * V */ /* TO FROM */ /* where the expression on the right hand side represents left */ /* multiplication of the vector by the matrix. */ /* Then if the unit-length SPICE quaternion q represents M, where */ /* q = (q0, q1, q2, q3) */ /* the elements of M are derived from the elements of q as follows: */ /* +- -+ */ /* | 2 2 | */ /* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ /* | | */ /* | | */ /* | 2 2 | */ /* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ /* | | */ /* | | */ /* | 2 2 | */ /* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ /* | | */ /* +- -+ */ /* Note that substituting the elements of -q for those of q in the */ /* right hand side leaves each element of M unchanged; this shows */ /* that if a quaternion q represents a matrix M, then so does the */ /* quaternion -q. */ /* To map the rotation matrix M to a unit quaternion, we start by */ /* decomposing the rotation matrix as a sum of symmetric */ /* and skew-symmetric parts: */ /* 2 */ /* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ /* symmetric skew-symmetric */ /* OMEGA is a skew-symmetric matrix of the form */ /* +- -+ */ /* | 0 -n3 n2 | */ /* | | */ /* OMEGA = | n3 0 -n1 | */ /* | | */ /* | -n2 n1 0 | */ /* +- -+ */ /* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ /* of M and theta is M's rotation angle. Note that N and theta */ /* are not unique. */ /* Let */ /* C = cos(theta/2) */ /* S = sin(theta/2) */ /* Then the unit quaternions Q corresponding to M are */ /* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ /* The mappings between quaternions and the corresponding rotations */ /* are carried out by the SPICELIB routines */ /* Q2M {quaternion to matrix} */ /* M2Q {matrix to quaternion} */ /* M2Q always returns a quaternion with scalar part greater than */ /* or equal to zero. */ /* SPICE Quaternion Multiplication Formula */ /* --------------------------------------- */ /* Given a SPICE quaternion */ /* Q = ( q0, q1, q2, q3 ) */ /* corresponding to rotation axis A and angle theta as above, we can */ /* represent Q using "scalar + vector" notation as follows: */ /* s = q0 = cos(theta/2) */ /* v = ( q1, q2, q3 ) = sin(theta/2) * A */ /* Q = s + v */ /* Let Q1 and Q2 be SPICE quaternions with respective scalar */ /* and vector parts s1, s2 and v1, v2: */ /* Q1 = s1 + v1 */ /* Q2 = s2 + v2 */ /* We represent the dot product of v1 and v2 by */ /* <v1, v2> */ /* and the cross product of v1 and v2 by */ /* v1 x v2 */ /* Then the SPICE quaternion product is */ /* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */ /* If Q1 and Q2 represent the rotation matrices M1 and M2 */ /* respectively, then the quaternion product */ /* Q1*Q2 */ /* represents the matrix product */ /* M1*M2 */ /* $ Examples */ /* Suppose that you have data packets and are prepared to produce */ /* a segment of type 5 in a CK file. */ /* The following code fragment could be used to add the new segment */ /* to a previously opened CK file attached to HANDLE. The file must */ /* have been opened with write access. */ /* C */ /* C Create a segment identifier. */ /* C */ /* SEGID = 'MY_SAMPLE_CK_TYPE_5_SEGMENT' */ /* C */ /* C Write the segment. */ /* C */ /* CALL CKW05 ( HANDLE, SUBTYP, DEGREE, BEGTIM, ENDTIM, */ /* . INST, REF, AVFLAG, SEGID, N, */ /* . SCLKDP, PACKTS, RATE, NINTS, STARTS ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* K.R. Gehringer (JPL) */ /* J.M. Lynch (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */ /* The check for non-unit quaternions has been replaced */ /* with a check for zero-length quaternions. */ /* - SPICELIB Version 1.1.0, 26-FEB-2008 (NJB) */ /* Updated header; added information about SPICE */ /* quaternion conventions. */ /* Minor typo in a long error message was corrected. */ /* - SPICELIB Version 1.0.1, 07-JAN-2005 (NJB) */ /* Description in Detailed_Input header section of */ /* constraints on BEGTIM and ENDTIM was corrected. */ /* - SPICELIB Version 1.0.0, 30-AUG-2002 (NJB) (KRG) (JML) (WLT) */ /* -& */ /* $ Index_Entries */ /* write ck type_5 data segment */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */ /* The check for non-unit quaternions has been replaced */ /* with a check for zero-length quaternions. */ /* This change was made to accommodate CK generation, */ /* via the non-SPICE utility MEX2KER, for European missions. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Packet structure parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("CKW05", (ftnlen)5); } /* Make sure that the number of packets is positive. */ if (*n < 1) { setmsg_("At least 1 packet is required for CK type 5. Number of pack" "ets supplied: #", (ftnlen)75); errint_("#", n, (ftnlen)1); sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20); chkout_("CKW05", (ftnlen)5); return 0; } /* Make sure that there is a positive number of interpolation */ /* intervals. */ if (*nints <= 0) { setmsg_("# is an invalid number of interpolation intervals for type " "5.", (ftnlen)61); errint_("#", nints, (ftnlen)1); sigerr_("SPICE(INVALIDNUMINTS)", (ftnlen)21); chkout_("CKW05", (ftnlen)5); return 0; } /* Get the NAIF integer code for the reference frame. */ namfrm_(ref, &refcod, ref_len); if (refcod == 0) { setmsg_("The reference frame # is not supported.", (ftnlen)39); errch_("#", ref, (ftnlen)1, ref_len); sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22); chkout_("CKW05", (ftnlen)5); 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_("CKW05", (ftnlen)5); 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_("CKW05", (ftnlen)5); return 0; } } /* Now check that the encoded SCLK times are positive and strictly */ /* increasing. */ /* Check that the first time is nonnegative. */ if (sclkdp[0] < 0.) { setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37); errdp_("#", sclkdp, (ftnlen)1); sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22); chkout_("CKW05", (ftnlen)5); return 0; } /* Now check that the times are ordered properly. */ i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) { setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)" " = # and SCLKDP(#) = #.", (ftnlen)78); errint_("#", &i__, (ftnlen)1); errdp_("#", &sclkdp[i__ - 1], (ftnlen)1); i__2 = i__ - 1; errint_("#", &i__2, (ftnlen)1); errdp_("#", &sclkdp[i__ - 2], (ftnlen)1); sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); chkout_("CKW05", (ftnlen)5); return 0; } } /* Now check that the interval start times are ordered properly. */ i__1 = *nints; for (i__ = 2; i__ <= i__1; ++i__) { if (starts[i__ - 1] <= starts[i__ - 2]) { setmsg_("The interval start times are not strictly increasing. S" "TARTS(#) = # and STARTS(#) = #.", (ftnlen)86); errint_("#", &i__, (ftnlen)1); errdp_("#", &starts[i__ - 1], (ftnlen)1); i__2 = i__ - 1; errint_("#", &i__2, (ftnlen)1); errdp_("#", &starts[i__ - 2], (ftnlen)1); sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); chkout_("CKW05", (ftnlen)5); return 0; } } /* Now make sure that all of the interval start times coincide with */ /* one of the times associated with the actual pointing. */ i__1 = *nints; for (i__ = 1; i__ <= i__1; ++i__) { /* We know the SCLKDP array is ordered, so a binary search is */ /* ok. */ if (bsrchd_(&starts[i__ - 1], n, sclkdp) == 0) { setmsg_("Interval start time number # is invalid. STARTS(#) = *", (ftnlen)54); errint_("#", &i__, (ftnlen)1); errint_("#", &i__, (ftnlen)1); errdp_("*", &starts[i__ - 1], (ftnlen)1); sigerr_("SPICE(INVALIDSTARTTIME)", (ftnlen)23); chkout_("CKW05", (ftnlen)5); return 0; } } /* Set the window, packet size and angular velocity flag, all of */ /* which are functions of the subtype. */ if (*subtyp == 0) { winsiz = (*degree + 1) / 2; packsz = 8; } else if (*subtyp == 1) { winsiz = *degree + 1; packsz = 4; } else if (*subtyp == 2) { winsiz = (*degree + 1) / 2; packsz = 14; } else if (*subtyp == 3) { winsiz = *degree + 1; packsz = 7; } else { setmsg_("CK type 5 subtype <#> is not supported.", (ftnlen)39); errint_("#", subtyp, (ftnlen)1); sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); chkout_("CKW05", (ftnlen)5); return 0; } /* Make sure that the quaternions are non-zero. This is just */ /* a check for uninitialized data. */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /* We have to address the quaternion explicitly, since the shape */ /* of the packet array is not known at compile time. */ addr__ = packsz * (i__ - 1) + 1; if (vzerog_(&packts[addr__ - 1], &c__4)) { setmsg_("The quaternion at index # has magnitude zero.", (ftnlen) 45); errint_("#", &i__, (ftnlen)1); sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21); chkout_("CKW05", (ftnlen)5); return 0; } } /* Make sure that the degree of the interpolating polynomials is */ /* in range. */ if (*degree < 1 || *degree > 15) { setmsg_("The interpolating polynomials have degree #; the valid degr" "ee range is [1, #]", (ftnlen)77); errint_("#", degree, (ftnlen)1); errint_("#", &c__15, (ftnlen)1); sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); chkout_("CKW05", (ftnlen)5); return 0; } /* Make sure that the window size is even. If not, the input */ /* DEGREE is incompatible with the subtype. */ if (odd_(&winsiz)) { setmsg_("The interpolating polynomials have degree #; for CK type 5," " the degree must be equivalent to 3 mod 4 for Hermite interp" "olation and odd for for Lagrange interpolation.", (ftnlen)166) ; errint_("#", degree, (ftnlen)1); sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); chkout_("CKW05", (ftnlen)5); return 0; } /* If we made it this far, we're ready to start writing the segment. */ /* Create the segment descriptor. */ /* Assign values to the integer components of the segment descriptor. */ ic[0] = *inst; ic[1] = refcod; ic[2] = 5; if (*avflag) { ic[3] = 1; } else { ic[3] = 0; } dc[0] = *begtim; dc[1] = *endtim; /* Make sure the descriptor times are in increasing order. */ if (*endtim < *begtim) { setmsg_("Descriptor bounds are non-increasing: #:#", (ftnlen)41); errdp_("#", begtim, (ftnlen)1); errdp_("#", endtim, (ftnlen)1); sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); chkout_("CKW05", (ftnlen)5); return 0; } /* Make sure that at least one time tag lies between BEGTIM and */ /* ENDTIM. The first time tag not less than BEGTIM must exist */ /* and must be less than or equal to ENDTIM. */ i__ = lstltd_(begtim, n, sclkdp); if (i__ == *n) { setmsg_("All time tags are less than segment start time #.", (ftnlen) 49); errdp_("#", begtim, (ftnlen)1); sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19); chkout_("CKW05", (ftnlen)5); return 0; } else if (sclkdp[i__] > *endtim) { setmsg_("No time tags lie between the segment start time # and segme" "nt end time #", (ftnlen)72); errdp_("#", begtim, (ftnlen)1); errdp_("#", endtim, (ftnlen)1); sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19); chkout_("CKW05", (ftnlen)5); return 0; } /* The clock rate must be non-zero. */ if (*rate == 0.) { setmsg_("The SCLK rate RATE was zero.", (ftnlen)28); sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19); chkout_("CKW05", (ftnlen)5); return 0; } /* Now pack the segment descriptor. */ dafps_(&c__2, &c__6, dc, ic, descr); /* Begin a new segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("CKW05", (ftnlen)5); return 0; } /* The type 5 segment structure is eloquently described by this */ /* diagram from the CK Required Reading: */ /* +-----------------------+ */ /* | Packet 1 | */ /* +-----------------------+ */ /* | Packet 2 | */ /* +-----------------------+ */ /* . */ /* . */ /* . */ /* +-----------------------+ */ /* | Packet N | */ /* +-----------------------+ */ /* | Epoch 1 | */ /* +-----------------------+ */ /* | Epoch 2 | */ /* +-----------------------+ */ /* . */ /* . */ /* . */ /* +----------------------------+ */ /* | Epoch N | */ /* +----------------------------+ */ /* | Epoch 100 | (First directory) */ /* +----------------------------+ */ /* . */ /* . */ /* . */ /* +----------------------------+ */ /* | Epoch ((N-1)/100)*100 | (Last directory) */ /* +----------------------------+ */ /* | Start time 1 | */ /* +----------------------------+ */ /* | Start time 2 | */ /* +----------------------------+ */ /* . */ /* . */ /* . */ /* +----------------------------+ */ /* | Start time M | */ /* +----------------------------+ */ /* | Start time 100 | (First interval start */ /* +----------------------------+ time directory) */ /* . */ /* . */ /* . */ /* +----------------------------+ */ /* | Start time ((M-1)/100)*100 | (Last interval start */ /* +----------------------------+ time directory) */ /* | Seconds per tick | */ /* +----------------------------+ */ /* | Subtype code | */ /* +----------------------------+ */ /* | Window size | */ /* +----------------------------+ */ /* | Number of interp intervals | */ /* +----------------------------+ */ /* | Number of packets | */ /* +----------------------------+ */ i__1 = *n * packsz; dafada_(packts, &i__1); dafada_(sclkdp, n); i__1 = (*n - 1) / 100; for (i__ = 1; i__ <= i__1; ++i__) { dafada_(&sclkdp[i__ * 100 - 1], &c__1); } /* Now add the interval start times. */ dafada_(starts, nints); /* And the directory of interval start times. The directory of */ /* start times will simply be every (DIRSIZ)th start time. */ i__1 = (*nints - 1) / 100; for (i__ = 1; i__ <= i__1; ++i__) { dafada_(&starts[i__ * 100 - 1], &c__1); } /* Add the SCLK rate, segment subtype, window size, interval */ /* count, and packet count. */ dafada_(rate, &c__1); d__1 = (doublereal) (*subtyp); dafada_(&d__1, &c__1); d__1 = (doublereal) winsiz; dafada_(&d__1, &c__1); d__1 = (doublereal) (*nints); dafada_(&d__1, &c__1); d__1 = (doublereal) (*n); dafada_(&d__1, &c__1); /* As long as nothing went wrong, end the segment. */ if (! failed_()) { dafena_(); } chkout_("CKW05", (ftnlen)5); return 0; } /* ckw05_ */
/* $Procedure SPKW17 ( SPK, write a type 17 segment ) */ /* Subroutine */ int spkw17_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal * decpol, ftnlen frame_len, ftnlen segid_len) { /* System generated locals */ integer i__1; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ doublereal a, h__; integer i__; doublereal k; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal descr[5]; extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *); integer value; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_( doublereal *, integer *), dafbna_(integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); doublereal record[12]; extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), spkpds_(integer *, integer *, char *, integer *, doublereal *, doublereal *, doublereal *, ftnlen); extern logical return_(void); doublereal ecc; /* $ Abstract */ /* Write an SPK segment of type 17 given a type 17 data 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 */ /* SPK */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of an SPK file open for writing. */ /* BODY I Body code for ephemeris object. */ /* CENTER I Body code for the center of motion of the body. */ /* FRAME I The reference frame of the states. */ /* FIRST I First valid time for which states can be computed. */ /* LAST I Last valid time for which states can be computed. */ /* SEGID I Segment identifier. */ /* EPOCH I Epoch of elements in seconds past J2000 */ /* EQEL I Array of equinoctial elements */ /* RAPOL I Right Ascension of the pole of the reference plane */ /* DECPOL I Declination of the pole of the reference plane */ /* $ Detailed_Input */ /* HANDLE is the file handle of an SPK file that has been */ /* opened for writing. */ /* BODY is the NAIF ID for the body whose states are */ /* to be recorded in an SPK file. */ /* CENTER is the NAIF ID for the center of motion associated */ /* with BODY. */ /* FRAME is the reference frame that states are referenced to, */ /* for example 'J2000'. */ /* FIRST are the bounds on the ephemeris times, expressed as */ /* LAST seconds past J2000. */ /* SEGID is the segment identifier. An SPK segment identifier */ /* may contain up to 40 characters. */ /* EPOCH is the epoch of equinoctial elements in seconds */ /* past the J2000 epoch. */ /* EQEL is an array of 9 double precision numbers that */ /* are the equinoctial elements for some orbit relative */ /* to the equatorial frame of a central body. */ /* ( The z-axis of the equatorial frame is the direction */ /* of the pole of the central body relative to FRAME. */ /* The x-axis is given by the cross product of the */ /* Z-axis of FRAME with the direction of the pole of */ /* the central body. The Y-axis completes a right */ /* handed frame. ) */ /* The specific arrangement of the elements is spelled */ /* out below. The following terms are used in the */ /* discussion of elements of EQEL */ /* INC --- inclination of the orbit */ /* ARGP --- argument of periapse */ /* NODE --- longitude of the ascending node */ /* E --- eccentricity of the orbit */ /* EQEL(1) is the semi-major axis (A) of the orbit in km. */ /* EQEL(2) is the value of H at the specified epoch. */ /* ( E*SIN(ARGP+NODE) ). */ /* EQEL(3) is the value of K at the specified epoch */ /* ( E*COS(ARGP+NODE) ). */ /* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */ /* the epoch of the elements measured in radians. */ /* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */ /* the specified epoch. */ /* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */ /* the specified epoch. */ /* EQEL(7) is the rate of the longitude of periapse */ /* (dARGP/dt + dNODE/dt ) at the epoch of */ /* the elements. This rate is assumed to hold */ /* for all time. The rate is measured in */ /* radians per second. */ /* EQEL(8) is the derivative of the mean longitude */ /* ( dM/dt + dARGP/dt + dNODE/dt ). This */ /* rate is assumed to be constant and is */ /* measured in radians/second. */ /* EQEL(9) is the rate of the longitude of the ascending */ /* node ( dNODE/dt). This rate is measured */ /* in radians per second. */ /* RAPOL Right Ascension of the pole of the reference plane */ /* relative to FRAME measured in radians. */ /* DECPOL Declination of the pole of the reference plane */ /* relative to FRAME measured in radians. */ /* $ Detailed_Output */ /* None. A type 17 segment is written to the file attached */ /* to HANDLE. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the semi-major axis is less than or equal to zero, the error */ /* 'SPICE(BADSEMIAXIS)' is signalled. */ /* 2) If the eccentricity of the orbit corresponding to the values */ /* of H and K ( EQEL(2) and EQEL(3) ) is greater than 0.9 the */ /* error 'SPICE(ECCOUTOFRANGE)' is signalled. */ /* 3) If the segment identifier has more than 40 non-blank characters */ /* the error 'SPICE(SEGIDTOOLONG)' is signalled. */ /* 4) If the segment identifier contains non-printing characters */ /* the error 'SPICE(NONPRINTABLECHARS)' is signalled. */ /* 5) If there are inconsistencies in the BODY, CENTER, FRAME or */ /* FIRST and LAST times, the problem will be diagnosed by */ /* a routine in the call tree of this routine. */ /* $ Files */ /* A new type 17 SPK segment is written to the SPK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an SPK type 17 data segment to the open SPK */ /* file according to the format described in the type 17 section of */ /* the SPK Required Reading. The SPK file must have been opened with */ /* write access. */ /* $ Examples */ /* Suppose that at time EPOCH you have the classical elements */ /* of some BODY relative to the equatorial frame of some central */ /* body CENTER. These can be converted to equinoctial elements */ /* and stored in an SPK file as a type 17 segment so that this */ /* body can be used within the SPK subsystem of the SPICE system. */ /* Below is a list of the variables used to represent the */ /* classical elements */ /* Variable Meaning */ /* -------- ---------------------------------- */ /* A Semi-major axis in km */ /* ECC Eccentricity of orbit */ /* INC Inclination of orbit */ /* NODE Longitude of the ascending node at epoch */ /* OMEGA Argument of periapse at epoch */ /* M Mean anomaly at epoch */ /* DMDT Mean anomaly rate in radians/second */ /* DNODE Rate of change of longitude of ascending node */ /* in radians/second */ /* DOMEGA Rate of change of argument of periapse in */ /* radians/second */ /* EPOCH is the epoch of the elements in seconds past */ /* the J2000 epoch. */ /* These elements are converted to equinoctial elements (in */ /* the order compatible with type 17) as shown below. */ /* EQEL(1) = A */ /* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */ /* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */ /* EQEL(4) = M + OMEGA + NODE */ /* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */ /* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */ /* EQEL(7) = DOMEGA */ /* EQEL(8) = DOMEGA + DMDT + DNODE */ /* EQEL(9) = DNODE */ /* C */ /* C Now add the segment. */ /* C */ /* CALL SPKW17 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ /* . SEGID, EPOCH, EQEL, RAPOL, DECPOL ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 24-Jun-1999 (WLT) */ /* Corrected typographical errors in the header. */ /* - SPICELIB Version 1.0.0, 8-Jan-1997 (WLT) */ /* -& */ /* $ Index_Entries */ /* Write a type 17 spk segment */ /* -& */ /* SPICELIB Functions */ /* Local Variables */ /* Segment descriptor size */ /* Segment identifier size */ /* SPK data type */ /* Range of printing characters */ /* Number of items in a segment */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("SPKW17", (ftnlen)6); /* Fetch the various entities from the inputs and put them into */ /* the data record, first the epoch. */ record[0] = *epoch; /* The trajectory pole vector. */ moved_(eqel, &c__9, &record[1]); record[10] = *rapol; record[11] = *decpol; a = record[1]; h__ = record[2]; k = record[3]; ecc = sqrt(h__ * h__ + k * k); /* Check all the inputs here for obvious failures. It's much */ /* better to check them now and quit than it is to get a bogus */ /* segment into an SPK file and diagnose it later. */ if (a <= 0.) { setmsg_("The semimajor axis supplied to the SPK type 17 evaluator wa" "s non-positive. This value must be positive. The value supp" "lied was #.", (ftnlen)130); errdp_("#", &a, (ftnlen)1); sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18); chkout_("SPKW17", (ftnlen)6); return 0; } else if (ecc > .9) { setmsg_("The eccentricity supplied for a type 17 segment is greater " "than 0.9. It must be less than 0.9.The value supplied to th" "e type 17 evaluator was #. ", (ftnlen)146); errdp_("#", &ecc, (ftnlen)1); sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22); chkout_("SPKW17", (ftnlen)6); return 0; } /* Make sure the segment identifier is not too long. */ if (lastnb_(segid, segid_len) > 40) { setmsg_("Segment identifier contains more than 40 characters.", ( ftnlen)52); sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); chkout_("SPKW17", (ftnlen)6); return 0; } /* Make sure the segment identifier has only printing characters. */ i__1 = lastnb_(segid, segid_len); for (i__ = 1; i__ <= i__1; ++i__) { value = *(unsigned char *)&segid[i__ - 1]; if (value < 32 || value > 126) { setmsg_("The segment identifier contains the nonprintable charac" "ter having ascii code #.", (ftnlen)79); errint_("#", &value, (ftnlen)1); sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); chkout_("SPKW17", (ftnlen)6); return 0; } } /* All of the obvious checks have been performed on the input */ /* record. Create the segment descriptor. (FIRST and LAST are */ /* checked by SPKPDS as well as consistency between BODY and CENTER). */ spkpds_(body, center, frame, &c__17, first, last, descr, frame_len); if (failed_()) { chkout_("SPKW17", (ftnlen)6); return 0; } /* Begin a new segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("SPKW17", (ftnlen)6); return 0; } dafada_(record, &c__12); if (! failed_()) { dafena_(); } chkout_("SPKW17", (ftnlen)6); return 0; } /* spkw17_ */
/* $Procedure DAFT2B ( DAF, text to binary ) */ /* Subroutine */ int daft2b_(integer *text, char *binary, integer *resv, ftnlen binary_len) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_rsle(void), s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char * , integer, char *, integer); /* Local variables */ char name__[1000*2]; integer more, i__; extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *); char tarch[8]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); integer chunk, isize, lsize; char ttype[8]; extern /* Subroutine */ int idw2at_(char *, char *, char *, ftnlen, ftnlen, ftnlen), dafada_(doublereal *, integer *); doublereal dc[125]; extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, ftnlen); integer ic[250]; extern /* Subroutine */ int dafena_(void); integer nd; extern logical failed_(void); integer ni, handle; extern /* Subroutine */ int dafcls_(integer *); char ifname[60*2]; extern /* Subroutine */ int dafopn_(char *, integer *, integer *, char *, integer *, integer *, ftnlen, ftnlen); doublereal buffer[1024]; char idword[8]; extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); doublereal sum[125]; /* Fortran I/O blocks */ static cilist io___5 = { 1, 0, 1, 0, 0 }; static cilist io___6 = { 1, 0, 1, 0, 0 }; static cilist io___13 = { 1, 0, 1, 0, 0 }; static cilist io___15 = { 1, 0, 1, 0, 0 }; static cilist io___17 = { 1, 0, 1, 0, 0 }; static cilist io___20 = { 1, 0, 1, 0, 0 }; static cilist io___23 = { 1, 0, 1, 0, 0 }; static cilist io___25 = { 1, 0, 1, 0, 0 }; static cilist io___27 = { 1, 0, 1, 0, 0 }; static cilist io___28 = { 1, 0, 1, 0, 0 }; static cilist io___29 = { 1, 0, 1, 0, 0 }; static cilist io___30 = { 1, 0, 1, 0, 0 }; /* $ Abstract */ /* Deprecated. The routine DAFTB supersedes this routine. */ /* NAIF supports this routine only to provide backward */ /* compatibility. */ /* Reconstruct a binary DAF from a text file opened by */ /* the calling program. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAF */ /* $ Keywords */ /* FILES */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* TEXT I Logical unit connected to text file. */ /* BINARY I Name of a binary DAF to be created. */ /* RESV I Number of records to reserve. */ /* BSIZE P Buffer size. */ /* $ Detailed_Input */ /* TEXT is a logical unit number, to which a text file has */ /* been connected by the calling program, and into */ /* which the contents of binary DAF have been */ /* written. The file pointer should be placed just */ /* before the file ID word. */ /* BINARY is the name of a binary DAF to be created. */ /* The binary DAF contains the same data as the */ /* text file, but in a form more suitable for use */ /* by application programs. */ /* RESV is the number of records to be reserved in the */ /* binary DAF. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* BSIZE is the size of the buffer used to read array elements */ /* from the text file. No single group of elements should */ /* contains more than BSIZE elements. */ /* $ Exceptions */ /* 1) If for some reason the text file cannot be read, */ /* the error SPICE(DAFREADFAIL) is signalled. */ /* 2) If the architecture of the file is not DAF, as specified by */ /* the ID word, the error SPICE(NOTADAFFILE) will be signalled. */ /* 3) If the text file does not contain matching internal file */ /* names, the error SPICE(DAFNOIFNMATCH) is signalled. */ /* 4) If the text file does not contain matching array names, */ /* the error SPICE(DAFNONAMEMATCH) is signalled. */ /* 5) If the buffer size is not sufficient, the error */ /* SPICE(DAFOVERFLOW) is signalled. */ /* $ Files */ /* See arguments TEXT, BINARY. */ /* $ Particulars */ /* This routine has been made obsolete by the new DAF text to binary */ /* conversion routine DAFTB. This routine remains available for */ /* reasons of backward compatibility. We strongly recommend that you */ /* use the new conversion routines for any new software development. */ /* Please see the header of the routine DAFTB for details. */ /* This routine is necessary for converting older DAF text files into */ /* their equivalent binary formats, as DAFTB uses a different text */ /* file format that is incompatible with the text file format */ /* expected by this routine. */ /* Any binary DAF may be transferred between heterogeneous */ /* Fortran environments by converting it to an equivalent file */ /* containing only ASCII characters. Such a file can be transferred */ /* almost universally, using any number of established protocols */ /* (Kermit, FTP, and so on). Once transferred, the ASCII file can */ /* be reconverted to a binary DAF, using the representations */ /* native to the new host environment. */ /* There are two pairs of routines that can be used to convert */ /* DAFs between binary and ASCII. The first pair, DAFB2A */ /* and DAFA2B, works with complete files. That is, DAFB2A creates */ /* a complete ASCII file containing all of the information in */ /* a particular binary DAF, and nothing else; this file can */ /* be fed directly into DAFA2B to produce a complete binary DAF. */ /* In each case, the names of the files are specified. */ /* A related pair of routines, DAFB2T and DAFT2B, assume that */ /* the ASCII data are to be stored in the midst of a text file. */ /* This allows the calling program to surround the data with */ /* standardized labels, to append several binary DAFs into a */ /* single text file, and so on. */ /* Note that you must select the number of records to be reserved */ /* in the binary DAF. The contents of reserved records are ignored */ /* by the normal transfer process. */ /* $ Examples */ /* DAFB2A and DAFA2B are typically used for simple transfers. */ /* If A.DAF is a binary DAF in environment 1, it can be transferred */ /* to environment 2 in three steps. */ /* 1) Convert it to ASCII: */ /* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */ /* 2) Transfer the ASCII file, using FTP, Kermit, or some other */ /* file transfer utility: */ /* ftp> put a.ascii */ /* 3) Convert it to binary on the new machine, */ /* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */ /* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */ /* environment. */ /* If the file needs to contain other information---a standard */ /* label, for instance---the first and third steps must be modified */ /* to use DAFB2T and DAFT2B. The first step becomes */ /* (Open a text file) */ /* (Write the label) */ /* CALL DAFB2T ( BINARY, UNIT ) */ /* (Close the text file) */ /* The third step becomes */ /* (Open the text file) */ /* (Read the label) */ /* CALL DAFT2B ( UNIT, BINARY, RESV ) */ /* (Close the text file) */ /* $ Restrictions */ /* DAFT2B cannot be executed while any other DAF is open */ /* for writing. */ /* $ Literature_References */ /* NAIF Document 167.0, "Double Precision Array Files (DAF) */ /* Specification and User's Guide" */ /* $ Author_and_Institution */ /* K. R. Gehringer (JPL) */ /* J.E. McLean (JPL) */ /* I.M. Underwood (JPL) */ /* $ Version */ /* - SPICELIB Version 3.0.1, 26-JUL-2012 (EDW) */ /* Edited Abstract section to use "Deprecated" keyword */ /* and state replacement routine. */ /* Eliminated unneeded Revisions section. */ /* - SPICELIB Version 3.0.0, 04-OCT-1993 (KRG) */ /* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ /* relevant. */ /* Added the error SPICE(NOTADAFFILE) if this routine is called */ /* with a file that does not contain an ID word identifying the */ /* file as a DAF file. */ /* There were no checks of the IOSTAT variable after attempting to */ /* read from the text file, a single test of the IOSTAT variable */ /* was made at the end of the routine. This was not adequate to */ /* detect errors when writing to the text file. So after all of */ /* these read statements, an IF ... END IF block was added to */ /* signal an error if IOSTAT .NE. 0. */ /* IF ( IOSTAT .NE. 0 ) THEN */ /* CALL SETMSG ( 'The attempt to read from file ''#''' // */ /* . ' failed. IOSTAT = #.' ) */ /* CALL ERRFNM ( '#', UNIT ) */ /* CALL SIGERR ( 'SPICE(DAFREADFAIL)' ) */ /* CALL CHKOUT ( 'DAFT2B' ) */ /* RETURN */ /* END IF */ /* Removed the code from the end of the routine that purported to */ /* check for read errors: */ /* C */ /* C If any read screws up, they should all screw up. Why */ /* C make a billion separate checks? */ /* C */ /* IF ( IOSTAT .NE. 0 ) THEN */ /* CALL SETMSG ( 'Value of IOSTAT was: #. ' ) */ /* CALL ERRINT ( '#', IOSTAT ) */ /* CALL SIGERR ( 'SPICE(DAFREADFAIL)' ) */ /* END IF */ /* The answer to the question is: */ /* You have to do a billion separate checks because the IOSTAT */ /* value is only valid for the most recently executed read. */ /* Added a statment to the $ Particulars section to the effect */ /* that this routine has been made obsolete by the introduction of */ /* the routine DAFTB, and that we strongly recommend the use of */ /* the new routine. This routine must, however, be used when */ /* converting older text files to binary, as the old and new */ /* formats are not compatible. */ /* Modified the $ Abstract section to reflect the fact that this */ /* routine is obsolete and maintained for purposes of backward */ /* compatibility only. */ /* - SPICELIB Version 2.0.2, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 2.0.1, 6-AUG-1990 (HAN) */ /* Header documentation was corrected. This routine will */ /* convert a file containing either ID word, 'NAIF/DAF' or */ /* 'NAIF/NIP'. (Previous versions of SPICELIB software used */ /* the ID word 'NAIF/NIP'.) */ /* - SPICELIB Version 2.0.0, 2-AUG-1990 (JEM) */ /* The previous version of this routine always failed and */ /* signalled the error SPICE(DAFNOIDWORD) because of a faulty */ /* logical expression in an error-checking IF statement. */ /* The error SPICE(DAFNOIDWORD) should be signalled if the */ /* next non-blank line in the text file does not begin with the */ /* word 'NAIF/DAF' AND does not begin with the word 'NAIF/NIP'. */ /* Previously the logic was incorrect causing the error to be */ /* signalled every time no matter what the word was. The */ /* correction consisted of replacing '.OR.' with '.AND.' */ /* in the logical expression. */ /* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ /* Literature references added to the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ /* -& */ /* $ Index_Entries */ /* text daf to binary */ /* -& */ /* SPICELIB functions */ /* Local Parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("DAFT2B", (ftnlen)6); } s_copy(idword, " ", (ftnlen)8, (ftnlen)1); s_copy(tarch, " ", (ftnlen)8, (ftnlen)1); s_copy(ttype, " ", (ftnlen)8, (ftnlen)1); /* We should be positioned and ready to read the file ID word from */ /* the text file, so let's try it. */ io___5.ciunit = *text; iostat = s_rsle(&io___5); if (iostat != 0) { goto L100001; } iostat = do_lio(&c__9, &c__1, idword, (ftnlen)8); if (iostat != 0) { goto L100001; } iostat = e_rsle(); L100001: if (iostat != 0) { setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } /* Split the ID word into an architecture and type, and verify that */ /* the architecture is 'DAF'. If it is not, this is the wrong */ /* routine, and an error will be signalled. */ idw2at_(idword, tarch, ttype, (ftnlen)8, (ftnlen)8, (ftnlen)8); if (s_cmp(tarch, "DAF", (ftnlen)8, (ftnlen)3) != 0) { setmsg_("File architecture is not 'DAF' for file '#'", (ftnlen)43); errfnm_("#", text, (ftnlen)1); sigerr_("SPICE(NOTADAFFILE)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } io___6.ciunit = *text; iostat = s_rsle(&io___6); if (iostat != 0) { goto L100002; } iostat = do_lio(&c__3, &c__1, (char *)&nd, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_lio(&c__3, &c__1, (char *)&ni, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_lio(&c__9, &c__1, ifname, (ftnlen)60); if (iostat != 0) { goto L100002; } iostat = e_rsle(); L100002: if (iostat != 0) { setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } /* Open the new binary file. */ dafopn_(binary, &nd, &ni, ifname, resv, &handle, binary_len, (ftnlen)60); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } /* Each array is preceded by a '1', which indicates that more */ /* arrays are to come. The array itself begins with the name */ /* and the summary components, and ends with the name again. */ /* The contents are written in arbitrary chunks. The final */ /* chunk is followed by a '0', which indicates that no chunks */ /* remain. The names must match, or the array should not */ /* be terminated normally. */ /* If the chunks in the file are bigger than the local buffer */ /* size, we are in trouble. */ lsize = nd + (ni - 1) / 2 + 1; isize = lsize << 3; io___13.ciunit = *text; iostat = s_rsle(&io___13); if (iostat != 0) { goto L100003; } iostat = do_lio(&c__3, &c__1, (char *)&more, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100003; } iostat = e_rsle(); L100003: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } while(more > 0) { io___15.ciunit = *text; iostat = s_rsle(&io___15); if (iostat != 0) { goto L100004; } iostat = do_lio(&c__9, &c__1, name__, isize); if (iostat != 0) { goto L100004; } iostat = e_rsle(); L100004: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } io___17.ciunit = *text; iostat = s_rsle(&io___17); if (iostat != 0) { goto L100005; } i__1 = nd; for (i__ = 1; i__ <= i__1; ++i__) { iostat = do_lio(&c__5, &c__1, (char *)&dc[(i__2 = i__ - 1) < 125 && 0 <= i__2 ? i__2 : s_rnge("dc", i__2, "daft2b_", ( ftnlen)465)], (ftnlen)sizeof(doublereal)); if (iostat != 0) { goto L100005; } } iostat = e_rsle(); L100005: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } io___20.ciunit = *text; iostat = s_rsle(&io___20); if (iostat != 0) { goto L100006; } i__2 = ni - 2; for (i__ = 1; i__ <= i__2; ++i__) { iostat = do_lio(&c__3, &c__1, (char *)&ic[(i__1 = i__ - 1) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, "daft2b_", ( ftnlen)480)], (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100006; } } iostat = e_rsle(); L100006: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } dafps_(&nd, &ni, dc, ic, sum); dafbna_(&handle, sum, name__, isize); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } io___23.ciunit = *text; iostat = s_rsle(&io___23); if (iostat != 0) { goto L100007; } iostat = do_lio(&c__3, &c__1, (char *)&chunk, (ftnlen)sizeof(integer)) ; if (iostat != 0) { goto L100007; } iostat = e_rsle(); L100007: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } while(chunk > 0) { if (chunk > 1024) { dafcls_(&handle); setmsg_("Buffer size exceeded. Increase to #.", (ftnlen)36); errint_("#", &chunk, (ftnlen)1); sigerr_("SPICE(DAFOVERFLOW)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } else { io___25.ciunit = *text; iostat = s_rsle(&io___25); if (iostat != 0) { goto L100008; } i__1 = chunk; for (i__ = 1; i__ <= i__1; ++i__) { iostat = do_lio(&c__5, &c__1, (char *)&buffer[(i__2 = i__ - 1) < 1024 && 0 <= i__2 ? i__2 : s_rnge("buffer", i__2, "daft2b_", (ftnlen)533)], (ftnlen)sizeof( doublereal)); if (iostat != 0) { goto L100008; } } iostat = e_rsle(); L100008: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTA" "T = #.", (ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } dafada_(buffer, &chunk); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } } io___27.ciunit = *text; iostat = s_rsle(&io___27); if (iostat != 0) { goto L100009; } iostat = do_lio(&c__3, &c__1, (char *)&chunk, (ftnlen)sizeof( integer)); if (iostat != 0) { goto L100009; } iostat = e_rsle(); L100009: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = " "#.", (ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } } io___28.ciunit = *text; iostat = s_rsle(&io___28); if (iostat != 0) { goto L100010; } iostat = do_lio(&c__9, &c__1, name__ + 1000, isize); if (iostat != 0) { goto L100010; } iostat = e_rsle(); L100010: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } if (s_cmp(name__, name__ + 1000, isize, isize) != 0) { dafcls_(&handle); setmsg_("Array name mismatch: # and #.", (ftnlen)29); errch_("#", name__, (ftnlen)1, isize); errch_("#", name__ + 1000, (ftnlen)1, isize); sigerr_("SPICE(DAFNONAMEMATCH)", (ftnlen)21); chkout_("DAFT2B", (ftnlen)6); return 0; } else { dafena_(); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } } io___29.ciunit = *text; iostat = s_rsle(&io___29); if (iostat != 0) { goto L100011; } iostat = do_lio(&c__3, &c__1, (char *)&more, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100011; } iostat = e_rsle(); L100011: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } } /* The final '0' indicates that no arrays remain. The first shall */ /* be last: the internal file name brings up the rear. If it doesn't */ /* match the one at the front, complain. */ io___30.ciunit = *text; iostat = s_rsle(&io___30); if (iostat != 0) { goto L100012; } iostat = do_lio(&c__9, &c__1, ifname + 60, (ftnlen)60); if (iostat != 0) { goto L100012; } iostat = e_rsle(); L100012: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } if (s_cmp(ifname, ifname + 60, (ftnlen)60, (ftnlen)60) != 0) { dafcls_(&handle); setmsg_("Internal file name mismatch: # and #", (ftnlen)36); errch_("#", ifname, (ftnlen)1, (ftnlen)60); errch_("#", ifname + 60, (ftnlen)1, (ftnlen)60); sigerr_("SPICE(DAFNOIFNMATCH)", (ftnlen)20); chkout_("DAFT2B", (ftnlen)6); return 0; } /* Close the DAF file we just created. */ dafcls_(&handle); chkout_("DAFT2B", (ftnlen)6); return 0; } /* daft2b_ */
/* $Procedure SPKW21 ( Write SPK segment, type 21 ) */ /* Subroutine */ int spkw21_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, integer *n, integer *dlsize, doublereal *dlines, doublereal *epochs, ftnlen frame_len, ftnlen segid_len) { /* System generated locals */ integer dlines_dim1, dlines_offset, i__1, i__2, i__3; doublereal d__1; /* Local variables */ integer i__, j; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal descr[5]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *, integer *), dafbna_(integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); integer chrcod, refcod, maxdim; extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen); doublereal prvepc; extern /* Subroutine */ int setmsg_(char *, ftnlen); integer maxdsz; extern /* Subroutine */ int errint_(char *, integer *, ftnlen), spkpds_( integer *, integer *, char *, integer *, doublereal *, doublereal *, doublereal *, ftnlen); extern logical return_(void); /* $ Abstract */ /* Write a type 21 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 */ /* NAIF_IDS */ /* SPK */ /* TIME */ /* $ Keywords */ /* EPHEMERIS */ /* FILES */ /* $ Declarations */ /* $ Abstract */ /* Declare parameters specific to SPK type 21. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPK */ /* $ Keywords */ /* SPK */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 25-DEC-2013 (NJB) */ /* -& */ /* MAXTRM is the maximum number of terms allowed in each */ /* component of the difference table contained in a type */ /* 21 SPK difference line. MAXTRM replaces the fixed */ /* table parameter value of 15 used in SPK type 1 */ /* segments. */ /* Type 21 segments have variable size. Let MAXDIM be */ /* the dimension of each component of the difference */ /* table within each difference line. Then the size */ /* DLSIZE of the difference line is */ /* ( 4 * MAXDIM ) + 11 */ /* MAXTRM is the largest allowed value of MAXDIM. */ /* End of include file spk21.inc. */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of an SPK file open for writing. */ /* BODY I NAIF code for an ephemeris object. */ /* CENTER I NAIF 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. */ /* N I Number of difference lines in segment. */ /* DLSIZE I Difference line size. */ /* DLINES I Array of difference lines. */ /* EPOCHS I Coverage end times of difference lines. */ /* MAXTRM P Maximum number of terms per difference table */ /* component. */ /* $ Detailed_Input */ /* HANDLE is the file 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 start and stop times of */ /* the time interval over which the segment defines */ /* the state of BODY. */ /* SEGID is the segment identifier. An SPK segment */ /* identifier may contain up to 40 characters. */ /* N is the number of difference lines in the input */ /* difference line array. */ /* DLSIZE is the size of each difference line data structure */ /* in the difference line array input DLINES. Let */ /* MAXDIM be the dimension of each component of the */ /* difference table within each difference line. Then */ /* the size DLSIZE of the difference line is */ /* ( 4 * MAXDIM ) + 11 */ /* DLINES contains a time-ordered array of difference lines. */ /* The Ith difference line occupies elements (1,I) */ /* through (MAXDIM,I) of DLINES, where MAXDIM is */ /* as described above in the description of DLSIZE. */ /* Each difference line represents the state (x, y, */ /* z, dx/dt, dy/dt, dz/dt, in kilometers and */ /* kilometers per second) of BODY relative to CENTER, */ /* specified relative to FRAME, for an interval of */ /* time. The time interval covered by the Ith */ /* difference line ends at the Ith element of the */ /* array EPOCHS (described below). The interval */ /* covered by the first difference line starts at the */ /* segment start time. */ /* The contents of a difference line are as shown */ /* below: */ /* Dimension Description */ /* --------- ---------------------------------- */ /* 1 Reference epoch of difference line */ /* MAXDIM Stepsize function vector */ /* 1 Reference position vector, x */ /* 1 Reference velocity vector, x */ /* 1 Reference position vector, y */ /* 1 Reference velocity vector, y */ /* 1 Reference position vector, z */ /* 1 Reference velocity vector, z */ /* MAXDIM,3 Modified divided difference */ /* arrays (MDAs) */ /* 1 Maximum integration order plus 1 */ /* 3 Integration order array */ /* The reference position and velocity are those of */ /* BODY relative to CENTER at the reference epoch. */ /* (A difference line is essentially a polynomial */ /* expansion of acceleration about the reference */ /* epoch.) */ /* EPOCHS is an array of epochs corresponding to the members */ /* of the difference line array. The epochs are */ /* specified as seconds past J2000 TDB. */ /* The first difference line covers the time interval */ /* from the segment start time to EPOCHS(1). For */ /* I > 1, the Ith difference line covers the half-open */ /* time interval from, but not including, EPOCHS(I-1) */ /* through EPOCHS(I). */ /* The elements of EPOCHS must be strictly increasing. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* MAXTRM is the maximum number of terms allowed in */ /* each component of the difference table */ /* contained in the input argument RECORD. */ /* See the INCLUDE file spk21.inc for the value */ /* of MAXTRM. */ /* $ Exceptions */ /* If any of the following exceptions occur, this routine will return */ /* without creating a new segment. */ /* 1) If FRAME is not a recognized name, the error */ /* SPICE(INVALIDREFFRAME) is signaled. */ /* 2) If the last non-blank character of SEGID occurs past index 40, */ /* the error SPICE(SEGIDTOOLONG) is signaled. */ /* 3) If SEGID contains any nonprintable characters, the error */ /* SPICE(NONPRINTABLECHARS) is signaled. */ /* 4) If the number of difference lines N is not at least one, */ /* the error SPICE(INVALIDCOUNT) will be signaled. */ /* 5) If FIRST is greater than LAST then the error */ /* SPICE(BADDESCRTIMES) will be signaled. */ /* 6) If the elements of the array EPOCHS are not in strictly */ /* increasing order, the error SPICE(TIMESOUTOFORDER) will be */ /* signaled. */ /* 7) If the last epoch EPOCHS(N) is less than LAST, the error */ /* SPICE(COVERAGEGAP) will be signaled. */ /* 8) If DLSIZE is greater than the limit */ /* ( 4 * MAXTRM ) + 11 */ /* the error SPICE(DIFFLINETOOLARGE) will be signaled. If */ /* DLSIZE is less than 71, the error SPICE(DIFFLINETOOSMALL) */ /* will be signaled. */ /* 9) If any value in the step size array of any difference */ /* line is zero, the error SPICE(ZEROSTEP) will be signaled. */ /* $ Files */ /* A new type 21 SPK segment is written to the SPK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an SPK type 21 data segment to the open SPK */ /* file according to the format described in the type 21 section of */ /* the SPK Required Reading. The SPK file must have been opened with */ /* write access. */ /* $ Examples */ /* Suppose that you have difference lines and are prepared to */ /* produce a segment of type 21 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_21_SEGMENT' */ /* C */ /* C Write the segment. */ /* C */ /* CALL SPKW21 ( HANDLE, BODY, CENTER, FRAME, */ /* . FIRST, LAST, SEGID, N, */ /* . DLSIZE, DLINES, EPOCHS ) */ /* $ Restrictions */ /* 1) The validity of the difference lines is not checked by */ /* this routine. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 03-FEB-2014 (NJB) */ /* -& */ /* $ Index_Entries */ /* write spk type_21 ephemeris data segment */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* MINDSZ is the minimum MDA size; this is the size */ /* of type 1 MDAs. */ /* Local variables */ /* Local variables */ /* Standard SPICE error handling. */ /* Parameter adjustments */ dlines_dim1 = *dlsize; dlines_offset = dlines_dim1 + 1; /* Function Body */ if (return_()) { return 0; } chkin_("SPKW21", (ftnlen)6); /* Make sure the difference line size is within limits. */ maxdsz = 111; if (*dlsize > maxdsz) { setmsg_("The input difference line size is #, while the maximum supp" "orted by this routine is #. It is possible that this problem" " is due to your SPICE Toolkit being out of date.", (ftnlen) 167); errint_("#", dlsize, (ftnlen)1); errint_("#", &maxdsz, (ftnlen)1); sigerr_("SPICE(DIFFLINETOOLARGE)", (ftnlen)23); chkout_("SPKW21", (ftnlen)6); return 0; } if (*dlsize < 71) { setmsg_("The input difference line size is #, while the minimum supp" "orted by this routine is #. It is possible that this problem" " is due to your SPICE Toolkit being out of date.", (ftnlen) 167); errint_("#", dlsize, (ftnlen)1); errint_("#", &c__71, (ftnlen)1); sigerr_("SPICE(DIFFLINETOOSMALL)", (ftnlen)23); chkout_("SPKW21", (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_("SPKW21", (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_("SPKW21", (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_("SPKW21", (ftnlen)6); return 0; } } /* The difference line count must be at least one. */ if (*n < 1) { setmsg_("The difference line count was #; the count must be at least" " one.", (ftnlen)64); errint_("#", n, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("SPKW21", (ftnlen)6); return 0; } /* The segment stop time should be greater than or equal to */ /* the begin time. */ if (*first > *last) { setmsg_("The segment start time: # is greater than the segment end t" "ime: #", (ftnlen)65); errdp_("#", first, (ftnlen)1); errdp_("#", last, (ftnlen)1); sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); chkout_("SPKW21", (ftnlen)6); return 0; } /* Make sure the epochs form a strictly increasing sequence. */ prvepc = epochs[0]; i__1 = *n; for (i__ = 2; i__ <= i__1; ++i__) { if (epochs[i__ - 1] <= prvepc) { setmsg_("EPOCH # having index # is not greater than its predeces" "sor #.", (ftnlen)61); errdp_("#", &epochs[i__ - 1], (ftnlen)1); errint_("#", &i__, (ftnlen)1); errdp_("#", &epochs[i__ - 2], (ftnlen)1); sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22); chkout_("SPKW21", (ftnlen)6); return 0; } prvepc = epochs[i__ - 1]; } /* Make sure there's no gap between the last difference line */ /* epoch and the end of the time interval defined by the segment */ /* descriptor. */ if (epochs[*n - 1] < *last) { setmsg_("Segment has coverage gap: segment end time # follows last e" "poch #.", (ftnlen)66); errdp_("#", last, (ftnlen)1); errdp_("#", &epochs[*n - 1], (ftnlen)1); sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18); chkout_("SPKW21", (ftnlen)6); return 0; } /* Check the step size vectors in the difference lines. */ maxdim = (*dlsize - 11) / 4; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = maxdim + 1; for (j = 2; j <= i__2; ++j) { if (dlines[j + i__ * dlines_dim1 - dlines_offset] == 0.) { setmsg_("Step size was zero at step size vector index # with" "in difference line #.", (ftnlen)72); i__3 = j - 1; errint_("#", &i__3, (ftnlen)1); errint_("#", &i__, (ftnlen)1); sigerr_("SPICE(ZEROSTEP)", (ftnlen)15); chkout_("SPKW21", (ftnlen)6); return 0; } } } /* If we made it this far, we're ready to start writing the segment. */ /* Create the segment descriptor. */ spkpds_(body, center, frame, &c__21, first, last, descr, frame_len); /* Begin a new segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("SPKW21", (ftnlen)6); return 0; } /* The type 21 segment structure is shown below: */ /* +-----------------------+ */ /* | Difference line 1 | */ /* +-----------------------+ */ /* | Difference line 2 | */ /* +-----------------------+ */ /* ... */ /* +-----------------------+ */ /* | Difference line N | */ /* +-----------------------+ */ /* | Epoch 1 | */ /* +-----------------------+ */ /* | Epoch 2 | */ /* +-----------------------+ */ /* ... */ /* +-----------------------+ */ /* | Epoch N | */ /* +-----------------------+ */ /* | Epoch 100 | (First directory) */ /* +-----------------------+ */ /* ... */ /* +-----------------------+ */ /* | Epoch (N/100)*100 | (Last directory) */ /* +-----------------------+ */ /* | Max diff table size | */ /* +-----------------------+ */ /* | Number of diff lines | */ /* +-----------------------+ */ i__1 = *n * *dlsize; dafada_(dlines, &i__1); dafada_(epochs, n); i__1 = *n / 100; for (i__ = 1; i__ <= i__1; ++i__) { dafada_(&epochs[i__ * 100 - 1], &c__1); } d__1 = (doublereal) maxdim; dafada_(&d__1, &c__1); d__1 = (doublereal) (*n); dafada_(&d__1, &c__1); /* As long as nothing went wrong, end the segment. */ if (! failed_()) { dafena_(); } chkout_("SPKW21", (ftnlen)6); return 0; } /* spkw21_ */
/* $Procedure PCKW02 ( Write PCK segment, type 2 ) */ /* Subroutine */ int pckw02_(integer *handle, integer *body, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *btime, ftnlen frame_len, ftnlen segid_len) { /* System generated locals */ integer i__1; /* Local variables */ integer i__, k; extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *); doublereal descr[5]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); doublereal ltime; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); doublereal rsize; char etstr[40]; extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen, ftnlen); integer refcod, ninrec; doublereal radius, numrec; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); extern logical return_(void); char netstr[40]; doublereal dcd[2]; integer icd[5]; doublereal mid; /* $ Abstract */ /* Write a type 2 segment to a PCK binary file given */ /* the file handle, body, frame, time range covered by the */ /* segment, and the Chebyshev polynomial coefficeients. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* NAIF_IDS */ /* SPC */ /* PCK */ /* $ Keywords */ /* PCK */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of binary PCK file open for writing. */ /* BODY I NAIF code for ephemeris object. */ /* 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. */ /* INTLEN I Length of time covered by logical record. */ /* N I Number of logical records in segment. */ /* POLYDG I Chebyshev polynomial degree. */ /* CDATA I Array of Chebyshev coefficients. */ /* BTIME I Begin time of first logical record. */ /* $ Detailed_Input */ /* HANDLE is the DAF handle of an PCK file to which a type 2 */ /* segment is to be added. The PCK file must be open */ /* for writing. */ /* BODY is the NAIF integer code for an ephemeris object */ /* whose orientation is described by the segment to */ /* be created. */ /* FRAME is the NAIF name for a reference frame relative to */ /* which the orientation information for BODY is */ /* specified. */ /* FIRST, */ /* LAST are, respectively, the start and stop times of */ /* the time interval over which the segment defines */ /* the orientation of body. */ /* SEGID is the segment identifier. A PCK segment */ /* identifier may contain up to 40 characters. */ /* INTLEN Length of time, in seconds, covered by each set of */ /* Chebyshev polynomial coefficients (each logical */ /* record). Each set of Chebyshev coefficents must */ /* cover this fixed time interval, INTLEN. */ /* N is the number of sets of Chebyshev polynomial */ /* coefficents (number of logical records) */ /* to be stored in the segment. There is one set */ /* of Chebyshev coefficients for each time period. */ /* POLYDG Degree of each set of Chebyshev polynomials. */ /* CDATA Array containing all the sets of Chebyshev */ /* polynomial coefficients to be contained in the */ /* segment of the PCK file. The coefficients are */ /* stored in CDATA in order as follows: */ /* the (degree + 1) coefficients for the first */ /* Euler angle of the first logical record */ /* the coefficients for the second Euler angle */ /* the coefficients for the third Euler angle */ /* the coefficients for the first Euler angle for */ /* the second logical record, ... */ /* and so on. */ /* BTIME Begin time (seconds past J2000 TDB) of first set */ /* of Chebyshev polynomial coefficients (first */ /* logical record). */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the number of sets of coefficients is not positive */ /* 'SPICE(NUMCOEFFSNOTPOS)' is signalled. */ /* 2) If the interval length is not positive, 'SPICE(INTLENNOTPOS)' */ /* is signalled. */ /* 3) If the integer code for the reference frame is not recognized, */ /* 'SPICE(INVALIDREFFRAME)' is signalled. */ /* 4) If segment stop time is not greater then the begin time, */ /* 'SPICE(BADDESCRTIMES)' is signalled. */ /* 5) If the time of the first record is not greater than */ /* or equal to the descriptor begin time, 'SPICE(BADDESCRTIMES)' */ /* is signalled. */ /* 6) If the end time of the last record is not greater than */ /* or equal to the descriptor end time, 'SPICE(BADDESCRTIMES)' is */ /* signalled. */ /* $ Files */ /* A new type 2 PCK segment is written to the PCK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an PCK type 2 data segment to the designated */ /* PCK file, according to the format described in the PCK Required */ /* Reading. */ /* Each segment can contain data for only one body and reference */ /* frame. The Chebyshev polynomial degree and length of time covered */ /* by each logical record are also fixed. However, an arbitrary */ /* number of logical records of Chebyshev polynomial coefficients can */ /* be written in each segment. Minimizing the number of segments in */ /* a PCK file will help optimize how the SPICE system accesses the */ /* file. */ /* $ Examples */ /* Suppose that you have sets of Chebyshev polynomial coefficients */ /* in an array CDATA pertaining to the position of the moon (NAIF ID */ /* = 301) in the J2000 reference frame, and want to put these into a */ /* type 2 segment in an existing PCK file. The following code could */ /* be used to add one new type 2 segment. To add multiple segments, */ /* put the call to PCKW02 in a loop. */ /* C */ /* C First open the PCK file and get a handle for it. */ /* C */ /* CALL DAFOPW ( PCKNAM, HANDLE ) */ /* C */ /* C Create a segment identifier. */ /* C */ /* SEGID = 'MY_SAMPLE_PCK_TYPE_2_SEGMENT' */ /* C */ /* C Write the segment. */ /* CALL PCKW02 ( HANDLE, 301, 'J2000', */ /* . FIRST, LAST, SEGID, INTLEN, */ /* . N, POLYDG, CDATA, BTIME) */ /* C */ /* C Close the file. */ /* C */ /* CALL DAFCLS ( HANDLE ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.S. Zukor (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */ /* The calling sequence was corrected so that REF is */ /* a character string and BTIME contains only the start */ /* time of the first record. Comments updated, and new */ /* routine CHCKID is called to check segment identifier. */ /* - SPICELIB Version 1.0.0, 11-MAR-1994 (KSZ) */ /* -& */ /* $ Index_Entries */ /* write pck type_2 data segment */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */ /* The calling sequence was corrected so that REF is */ /* a character string and BTIME contains only the start */ /* time of the first record. Comments updated, and new */ /* routine CHCKID is called to check segment identifier. */ /* -& */ /* SPICELIB functions */ /* Local Parameters */ /* DTYPE is the PCK data type. */ /* NS is the size of a packed PCK segment descriptor. */ /* ND is the number of double precision components in an PCK */ /* segment descriptor. PCK uses ND = 2. */ /* NI is the number of integer components in an PCK segment */ /* descriptor. PCK uses NI = 5. */ /* SIDLEN is the maximum number of characters allowed in an */ /* PCK segment identifier. */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("PCKW02", (ftnlen)6); } /* The number of sets of coefficients must be positive. */ if (*n <= 0) { setmsg_("The number of sets of Euler anglecoefficients is not positi" "ve. N = #", (ftnlen)68); errint_("#", n, (ftnlen)1); sigerr_("SPICE(NUMCOEFFSNOTPOS)", (ftnlen)22); chkout_("PCKW02", (ftnlen)6); return 0; } /* The interval length must be positive. */ if (*intlen <= 0.) { setmsg_("The interval length is not positive.N = #", (ftnlen)41); errdp_("#", intlen, (ftnlen)1); sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19); chkout_("PCKW02", (ftnlen)6); return 0; } /* Get the NAIF integer code for the reference frame. */ irfnum_(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_("PCKW02", (ftnlen)6); return 0; } /* The segment stop time must be greater than the begin time. */ if (*first > *last) { setmsg_("The segment start time: # is greater than the segment end t" "ime: #", (ftnlen)65); etcal_(first, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); etcal_(last, netstr, (ftnlen)40); errch_("#", netstr, (ftnlen)1, (ftnlen)40); sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); chkout_("PCKW02", (ftnlen)6); return 0; } /* The begin time of the first record must be less than or equal */ /* to the begin time of the segment. */ if (*first < *btime) { setmsg_("The segment descriptor start time: # is less than the begin" "ning time of the segment data: #", (ftnlen)91); etcal_(first, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); etcal_(btime, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); chkout_("PCKW02", (ftnlen)6); return 0; } /* The end time of the final record must be greater than or */ /* equal to the end time of the segment. */ ltime = *btime + *n * *intlen; if (*last > ltime) { setmsg_("The segment descriptor end time: # is greater than the end " "time of the segment data: #", (ftnlen)86); etcal_(last, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); etcal_(<ime, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); chkout_("PCKW02", (ftnlen)6); return 0; } /* Now check the validity of the segment identifier. */ chckid_("PCK segment identifier", &c__40, segid, (ftnlen)22, segid_len); if (failed_()) { chkout_("PCKW02", (ftnlen)6); return 0; } /* Store the start and end times to be associated */ /* with this segment. */ dcd[0] = *first; dcd[1] = *last; /* Create the integer portion of the descriptor. */ icd[0] = *body; icd[1] = refcod; icd[2] = 2; /* Pack the segment descriptor. */ dafps_(&c__2, &c__5, dcd, icd, descr); /* Begin a new segment of PCK type 2 form: */ /* Record 1 */ /* Record 2 */ /* ... */ /* Record N */ /* INIT ( initial epoch of first record ) */ /* INTLEN ( length of interval covered by each record ) */ /* RSIZE ( number of data elements in each record ) */ /* N ( number of records in segment ) */ /* Each record will have the form: */ /* MID ( midpoint of time interval ) */ /* RADIUS ( radius of time interval ) */ /* X coefficients, Y coefficients, Z coefficients */ dafbna_(handle, descr, segid, segid_len); /* Calculate the number of entries in a record. */ ninrec = (*polydg + 1) * 3; /* Fill segment with N records of data. */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /* Calculate the midpoint and radius of the time of each */ /* record, and put that at the beginning of each record. */ radius = *intlen / 2; mid = *btime + radius + (i__ - 1) * *intlen; dafada_(&mid, &c__1); dafada_(&radius, &c__1); /* Put one set of coefficients into the segment. */ k = (i__ - 1) * ninrec + 1; dafada_(&cdata[k - 1], &ninrec); } /* Store the initial epoch of the first record. */ dafada_(btime, &c__1); /* Store the length of interval covered by each record. */ dafada_(intlen, &c__1); /* Store the size of each record (total number of array elements). */ rsize = (doublereal) (ninrec + 2); dafada_(&rsize, &c__1); /* Store the number of records contained in the segment. */ numrec = (doublereal) (*n); dafada_(&numrec, &c__1); /* End this segment. */ dafena_(); chkout_("PCKW02", (ftnlen)6); return 0; } /* pckw02_ */
/* $Procedure SPKW20 ( SPK, write segment, type 20 ) */ /* Subroutine */ int spkw20_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *intlen, integer *n, integer *polydg, doublereal *cdata, doublereal *dscale, doublereal *tscale, doublereal *initjd, doublereal *initfr, ftnlen frame_len, ftnlen segid_len) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Local variables */ extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_( char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *); doublereal btime, descr[5]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); doublereal ltime; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); char etstr[40]; extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen, ftnlen); integer refcod, ninrec; extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen); doublereal numrec; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); extern logical return_(void); char netstr[40]; doublereal dcd[2]; extern doublereal j2000_(void); integer icd[6]; extern doublereal spd_(void); doublereal tol; /* $ Abstract */ /* Write a type 20 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 */ /* TIME */ /* SPK */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ Abstract */ /* Declare parameters specific to SPK type 20. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPK */ /* $ Keywords */ /* SPK */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - SPICELIB Version 1.0.0, 30-DEC-2013 (NJB) */ /* -& */ /* MAXDEG is the maximum allowed degree of the input */ /* Chebyshev expansions. If the value of MAXDEG is */ /* increased, the SPICELIB routine SPKPVN must be */ /* changed accordingly. In particular, the size of */ /* the record passed to SPKRnn and SPKEnn must be */ /* increased, and comments describing the record size */ /* must be changed. */ /* The record size requirement is */ /* MAXREC = 3 * ( MAXDEG + 3 ) */ /* TOLSCL is a tolerance scale factor (also called a */ /* "relative tolerance") used for time coverage */ /* bound checking. TOLSCL is unitless. TOLSCL */ /* produces a tolerance value via the formula */ /* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */ /* where FIRST and LAST are the coverage time bounds */ /* of a type 20 segment, expressed as seconds past */ /* J2000 TDB. */ /* The resulting parameter TOL is used as a tolerance */ /* for comparing the input segment descriptor time */ /* bounds to the first and last epoch covered by the */ /* sequence of time intervals defined by the inputs */ /* to SPKW20: */ /* INITJD */ /* INITFR */ /* INTLEN */ /* N */ /* Tolerance scale for coverage gap at the endpoints */ /* of the segment coverage interval: */ /* End of include file spk20.inc. */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of SPK file open for writing. */ /* BODY I NAIF code for ephemeris object. */ /* CENTER I NAIF code for the center of motion of the 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. */ /* INTLEN I Length of time covered by logical record (days). */ /* N I Number of logical records in segment. */ /* POLYDG I Chebyshev polynomial degree. */ /* CDATA I Array of Chebyshev coefficients and positions. */ /* DSCALE I Distance scale of data. */ /* TSCALE I Time scale of data. */ /* INITJD I Integer part of begin time (TDB Julian date) of */ /* first record. */ /* INITFR I Fractional part of begin time (TDB Julian date) of */ /* first record. */ /* MAXDEG P Maximum allowed degree of Chebyshev expansions. */ /* TOLSCL P Tolerance scale for coverage bound checking. */ /* $ Detailed_Input */ /* HANDLE is the DAF handle of an SPK file to which a type 20 */ /* segment is to be added. The SPK file must be open */ /* 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 the start and stop times of the time interval */ /* over which the segment defines the state of the */ /* object identified by BODY. */ /* SEGID is a segment identifier. An SPK segment identifier */ /* may contain up to 40 characters. */ /* INTLEN is the length of time, in TDB Julian days, covered */ /* by each set of Chebyshev polynomial coefficients */ /* (each logical record). */ /* N is the number of logical records to be stored in */ /* the segment. There is one logical record for each */ /* time period. Each logical record contains three */ /* sets of Chebyshev coefficients---one for each */ /* coordinate---and three position vector components. */ /* POLYDG is the degree of each set of Chebyshev */ /* polynomials, i.e. the number of Chebyshev */ /* coefficients per coordinate minus one. POLYDG must */ /* be less than or equal to the parameter MAXDEG. */ /* CDATA is an array containing all the sets of Chebyshev */ /* polynomial coefficients and position components to */ /* be placed in the new segment of the SPK file. */ /* There are three sets of coefficients and position */ /* components for each time interval covered by the */ /* segment. */ /* The coefficients and position components are */ /* stored in CDATA in order as follows: */ /* the (POLYDG + 1) coefficients for the first */ /* coordinate of the first logical record, */ /* followed by the X component of position at the */ /* first interval midpoint. The first coefficient */ /* is that of the constant term of the expansion. */ /* the coefficients for the second coordinate, */ /* followed by the Y component of position at the */ /* first interval midpoint. */ /* the coefficients for the third coordinate, */ /* followed by the Z component of position at the */ /* first interval midpoint. */ /* the coefficients for the first coordinate for */ /* the second logical record, followed by the X */ /* component of position at the second interval */ /* midpoint. */ /* and so on. */ /* The logical data records are stored contiguously: */ /* +----------+ */ /* | Record 1 | */ /* +----------+ */ /* | Record 2 | */ /* +----------+ */ /* ... */ /* +----------+ */ /* | Record N | */ /* +----------+ */ /* The contents of an individual record are: */ /* +--------------------------------------+ */ /* | Coeff set for X velocity component | */ /* +--------------------------------------+ */ /* | X position component | */ /* +--------------------------------------+ */ /* | Coeff set for Y velocity component | */ /* +--------------------------------------+ */ /* | Y position component | */ /* +--------------------------------------+ */ /* | Coeff set for Z velocity component | */ /* +--------------------------------------+ */ /* | Z position component | */ /* +--------------------------------------+ */ /* Each coefficient set has the structure: */ /* +--------------------------------------+ */ /* | Coefficient of T_0 | */ /* +--------------------------------------+ */ /* | Coefficient of T_1 | */ /* +--------------------------------------+ */ /* ... */ /* +--------------------------------------+ */ /* | Coefficient of T_POLYDG | */ /* +--------------------------------------+ */ /* Where T_n represents the Chebyshev polynomial */ /* of the first kind of degree n. */ /* DSCALE, */ /* TSCALE are, respectively, the distance scale of the input */ /* position and velocity data in km, and the time */ /* scale of the input velocity data in TDB seconds. */ /* For example, if the input distance data have units */ /* of astronomical units (AU), DSCALE should be set */ /* to the number of km in one AU. If the input */ /* velocity data have time units of Julian days, then */ /* TSCALE should be set to the number of seconds per */ /* Julian day (86400). */ /* INITJD is the integer part of the Julian ephemeris date */ /* of initial epoch of the first record. INITJD may */ /* be less than, equal to, or greater than the */ /* initial epoch. */ /* INITFR is the fractional part of the Julian ephemeris date */ /* of initial epoch of the first record. INITFR has */ /* units of Julian days. INITFR has magnitude */ /* strictly less than 1 day. The sum */ /* INITJD + INITFR */ /* equals the Julian ephemeris date of the initial */ /* epoch of the first record. */ /* $ Detailed_Output */ /* None. This routine writes data to an SPK file. */ /* $ Parameters */ /* The parameters described in this section are declared in the */ /* Fortran INCLUDE file spk20.inc */ /* MAXDEG is the maximum allowed degree of the input */ /* Chebyshev expansions. */ /* TOLSCL is a tolerance scale factor (also called a */ /* "relative tolerance") used for time coverage */ /* bound checking. TOLSCL is unitless. TOLSCL */ /* produces a tolerance value via the formula */ /* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */ /* where FIRST and LAST are the coverage time bounds */ /* of a type 20 segment, expressed as seconds past */ /* J2000 TDB. */ /* The resulting parameter TOL is used as a tolerance */ /* for comparing the input segment descriptor time */ /* bounds to the first and last epoch covered by the */ /* sequence of time intervals defined by the inputs */ /* INITJD */ /* INITFR */ /* INTLEN */ /* N */ /* See the Exceptions section below for a description */ /* of the error check using this tolerance. */ /* $ Exceptions */ /* 1) If the number of sets of coefficients is not positive */ /* SPICE(INVALIDCOUNT) is signaled. */ /* 2) If the interval length is not positive, SPICE(INTLENNOTPOS) */ /* is signaled. */ /* 3) If the name of the reference frame is not recognized, */ /* SPICE(INVALIDREFFRAME) is signaled. */ /* 4) If segment stop time is not greater than or equal to */ /* the begin time, SPICE(BADDESCRTIMES) is signaled. */ /* 5) If the start time of the first record exceeds the descriptor */ /* begin time by more than a computed tolerance, or if the end */ /* time of the last record precedes the descriptor end time by */ /* more than a computed tolerance, the error SPICE(COVERAGEGAP) */ /* is signaled. See the Parameters section above for a */ /* description of the tolerance. */ /* 6) If the input degree POLYDG is less than 0 or greater than */ /* MAXDEG, the error SPICE(INVALIDDEGREE) is signaled. */ /* 7) If the last non-blank character of SEGID occurs past index */ /* 40, or if SEGID contains any nonprintable characters, the */ /* error will be diagnosed by a routine in the call tree of this */ /* routine. */ /* 8) If either the distance or time scale is non-positive, the */ /* error SPICE(NONPOSITIVESCALE) will be signaled. */ /* $ Files */ /* A new type 20 SPK segment is written to the SPK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an SPK type 20 data segment to the designated */ /* SPK file, according to the format described in the SPK Required */ /* Reading. */ /* Each segment can contain data for only one target, central body, */ /* and reference frame. The Chebyshev polynomial degree and length */ /* of time covered by each logical record are also fixed. However, */ /* an arbitrary number of logical records of Chebyshev polynomial */ /* coefficients can be written in each segment. Minimizing the */ /* number of segments in an SPK file will help optimize how the */ /* SPICE system accesses the file. */ /* $ Examples */ /* Suppose that you have in an array CDATA sets of Chebyshev */ /* polynomial coefficients and position vectors representing the */ /* state of the moon (NAIF ID = 301), relative to the Earth-moon */ /* barycenter (NAIF ID = 3), in the J2000 reference frame, and you */ /* want to put these into a type 20 segment in an existing SPK file. */ /* The following code could be used to add one new type 20 segment. */ /* To add multiple segments, put the call to SPKW20 in a loop. */ /* C */ /* C First open the SPK file and get a handle for it. */ /* C */ /* CALL DAFOPW ( SPKNAM, HANDLE ) */ /* C */ /* C Create a segment identifier. */ /* C */ /* SEGID = 'MY_SAMPLE_SPK_TYPE_20_SEGMENT' */ /* C */ /* C Note that the interval length INTLEN has units */ /* C of Julian days. The start time of the first record */ /* C is expressed using two inputs: integer and fractional */ /* C portions of the Julian ephemeris date of the start */ /* C time. */ /* C */ /* C Write the segment. */ /* C */ /* CALL SPKW20 ( HANDLE, 301, 3, 'J2000', */ /* . FIRST, LAST, SEGID, INTLEN, */ /* . N, POLYDG, CDATA, DSCALE, */ /* . TSCALE, INITJD, INITFR ) */ /* C */ /* C Close the file. */ /* C */ /* CALL DAFCLS ( HANDLE ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* K.S. Zukor (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 17-JAN-2017 (NJB) (KSZ) */ /* -& */ /* $ Index_Entries */ /* write spk type_20 data segment */ /* -& */ /* SPICELIB functions */ /* Local Parameters */ /* DTYPE is the SPK data type. */ /* ND is the number of double precision components in an SPK */ /* segment descriptor. SPK uses ND = 2. */ /* NI is the number of integer components in an SPK segment */ /* descriptor. SPK uses NI = 6. */ /* NS is the size of a packed SPK segment descriptor. */ /* SIDLEN is the maximum number of characters allowed in an */ /* SPK segment identifier. */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("SPKW20", (ftnlen)6); /* The number of sets of coefficients must be positive. */ if (*n <= 0) { setmsg_("The number of sets of coordinate coefficients is not positi" "ve. N = # ", (ftnlen)69); errint_("#", n, (ftnlen)1); sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19); chkout_("SPKW20", (ftnlen)6); return 0; } /* Make sure that the degree of the interpolating polynomials is */ /* in range. */ if (*polydg < 0 || *polydg > 50) { setmsg_("The interpolating polynomials have degree #; the valid degr" "ee range is [0, #].", (ftnlen)78); errint_("#", polydg, (ftnlen)1); errint_("#", &c__50, (ftnlen)1); sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20); chkout_("SPKW20", (ftnlen)6); return 0; } /* The interval length must be positive. */ if (*intlen <= 0.) { setmsg_("The interval length is not positive.N = #", (ftnlen)41); errdp_("#", intlen, (ftnlen)1); sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19); chkout_("SPKW20", (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_("SPKW20", (ftnlen)6); return 0; } /* The segment stop time must be greater than or equal to the begin */ /* time. */ if (*first > *last) { setmsg_("The segment start time: # (# TDB) is greater than the segme" "nt end time: (# TDB).", (ftnlen)80); etcal_(first, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); errdp_("#", first, (ftnlen)1); etcal_(last, netstr, (ftnlen)40); errch_("#", netstr, (ftnlen)1, (ftnlen)40); errdp_("#", last, (ftnlen)1); sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20); chkout_("SPKW20", (ftnlen)6); return 0; } /* The distance and time scales must be positive. */ if (*dscale <= 0.) { setmsg_("The distance scale is not positive.DSCALE = #", (ftnlen)45); errdp_("#", dscale, (ftnlen)1); sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23); chkout_("SPKW20", (ftnlen)6); return 0; } if (*tscale <= 0.) { setmsg_("The time scale is not positive.TSCALE = #", (ftnlen)41); errdp_("#", tscale, (ftnlen)1); sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23); chkout_("SPKW20", (ftnlen)6); return 0; } /* The begin time of the first record must be less than or equal */ /* to the begin time of the segment. Convert the two-part input */ /* epoch to seconds past J2000 for the purpose of this check. */ btime = spd_() * (*initjd - j2000_() + *initfr); ltime = btime + *n * *intlen * spd_(); /* Compute the tolerance to use for descriptor time bound checks. */ /* Computing MAX */ d__1 = abs(btime), d__2 = abs(ltime); tol = max(d__1,d__2) * 1e-13; if (*first < btime - tol) { setmsg_("The segment descriptor start time # is too much less than t" "he beginning time of the segment data # (in seconds past J20" "00: #). The difference is # seconds; the tolerance is # seco" "nds.", (ftnlen)183); etcal_(first, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); etcal_(&btime, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); errdp_("#", first, (ftnlen)1); d__1 = btime - *first; errdp_("#", &d__1, (ftnlen)1); errdp_("#", &tol, (ftnlen)1); sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18); chkout_("SPKW20", (ftnlen)6); return 0; } /* The end time of the final record must be greater than or */ /* equal to the end time of the segment. */ if (*last > ltime + tol) { setmsg_("The segment descriptor end time # is too much greater than " "the end time of the segment data # (in seconds past J2000: #" "). The difference is # seconds; the tolerance is # seconds.", (ftnlen)178); etcal_(last, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); etcal_(<ime, etstr, (ftnlen)40); errch_("#", etstr, (ftnlen)1, (ftnlen)40); errdp_("#", last, (ftnlen)1); d__1 = *last - ltime; errdp_("#", &d__1, (ftnlen)1); errdp_("#", &tol, (ftnlen)1); sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18); chkout_("SPKW20", (ftnlen)6); return 0; } /* Now check the validity of the segment identifier. */ chckid_("SPK segment identifier", &c__40, segid, (ftnlen)22, segid_len); if (failed_()) { chkout_("SPKW20", (ftnlen)6); return 0; } /* Store the start and end times to be associated */ /* with this segment. */ dcd[0] = *first; dcd[1] = *last; /* Create the integer portion of the descriptor. */ icd[0] = *body; icd[1] = *center; icd[2] = refcod; icd[3] = 20; /* Pack the segment descriptor. */ dafps_(&c__2, &c__6, dcd, icd, descr); /* Begin a new segment of SPK type 20 form: */ /* Record 1 */ /* Record 2 */ /* ... */ /* Record N */ /* DSCALE ( distance scale in km ) */ /* TSCALE ( time scale in seconds ) */ /* INITJD ( integer part of initial epoch of first record, */ /* expressed as a TDB Julian date ) */ /* INITFR ( fractional part of initial epoch, in units of */ /* TDB Julian days ) */ /* INTLEN ( length of interval covered by each record, in */ /* units of TDB Julian days ) */ /* RSIZE ( number of data elements in each record ) */ /* N ( number of records in segment ) */ /* Each record will have the form: */ /* X coefficients */ /* X position component at interval midpoint */ /* Y coefficients */ /* Y position component at interval midpoint */ /* Z coefficients */ /* Z position component at interval midpoint */ dafbna_(handle, descr, segid, segid_len); /* Calculate the number of entries in a record. */ ninrec = (*polydg + 2) * 3; /* Fill segment with N records of data. */ i__1 = *n * ninrec; dafada_(cdata, &i__1); /* Store the distance and time scales. */ dafada_(dscale, &c__1); dafada_(tscale, &c__1); /* Store the integer and fractional parts of the initial epoch of */ /* the first record. */ dafada_(initjd, &c__1); dafada_(initfr, &c__1); /* Store the length of interval covered by each record. */ dafada_(intlen, &c__1); /* Store the size of each record (total number of array elements). */ /* Note that this size is smaller by 2 than the size of a type 2 */ /* record of the same degree, since the record coverage midpoint */ /* and radius are not stored. */ d__1 = (doublereal) ninrec; dafada_(&d__1, &c__1); /* Store the number of records contained in the segment. */ numrec = (doublereal) (*n); dafada_(&numrec, &c__1); /* End this segment. */ dafena_(); chkout_("SPKW20", (ftnlen)6); return 0; } /* spkw20_ */
/* $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 SPKSUB ( S/P Kernel, subset ) */ /* Subroutine */ int spksub_(integer *handle, doublereal *descr, char *ident, doublereal *begin, doublereal *end, integer *newh, ftnlen ident_len) { logical okay; integer type__, baddr, eaddr; doublereal alpha, omega; extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *), dafus_( doublereal *, integer *, integer *, doublereal *, integer *); doublereal ndscr[5]; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), spks01_( integer *, integer *, integer *, doublereal *, doublereal *), spks02_(integer *, integer *, integer *, doublereal *, doublereal *), spks03_(integer *, integer *, integer *, doublereal *, doublereal *), spks10_(integer *, doublereal *, integer *, doublereal *, char *, ftnlen), spks05_(integer *, integer *, integer *, doublereal *, doublereal *), spks12_(integer *, integer *, integer *, doublereal *, doublereal *), spks13_( integer *, integer *, integer *, doublereal *, doublereal *), spks08_(integer *, integer *, integer *, doublereal *, doublereal *), spks09_(integer *, integer *, integer *, doublereal *, doublereal *), spks14_(integer *, doublereal *, integer *, doublereal *, char *, ftnlen), spks15_(integer *, integer *, integer *, doublereal *, doublereal *), spks17_(integer *, integer *, integer *, doublereal *, doublereal *), spks18_( integer *, integer *, integer *, doublereal *, doublereal *), spks19_(integer *, integer *, integer *, doublereal *, doublereal *), spks20_(integer *, integer *, integer *, doublereal *, doublereal *), spks21_(integer *, integer *, integer *, doublereal *, doublereal *); doublereal dc[2]; extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, ftnlen); integer ic[6]; extern /* Subroutine */ int dafena_(void), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); extern logical return_(void); /* $ Abstract */ /* Extract a subset of the data in an SPK segment into a */ /* separate segment. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* SPK */ /* DAF */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of source segment. */ /* DESCR I Descriptor of source segment. */ /* IDENT I Identifier of source segment. */ /* BEGIN I Beginning (initial epoch) of subset. */ /* END I End (final epoch) of subset. */ /* NEWH I Handle of new segment. */ /* $ Detailed_Input */ /* HANDLE, */ /* DESCR, */ /* IDENT are the file handle assigned to a SPK file, the */ /* descriptor for a segment within the file, and the */ /* identifier for that segment. Together they determine */ /* a complete set of ephemeris data, from which a */ /* subset is to be extracted. */ /* BEGIN, */ /* END are the initial and final epochs (ephemeris time) */ /* of the subset. */ /* NEWH is the file handle assigned to the file in which */ /* the new segment is to be written. The file must */ /* be open for write access. NEWH and HANDLE may refer */ /* to the same file. */ /* $ Detailed_Output */ /* See $Files section. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the condition */ /* ALPHA < BEGIN < END < OMEGA */ /* - - - */ /* is not satisfied (where ALPHA and OMEGA are the initial */ /* and final epochs of the segment respectively), the error */ /* 'SPICE(SPKNOTASUBSET)' is signaled. */ /* 2) If the segment type is not supported by the current */ /* version of SPKSUB, the error 'SPICE(SPKTYPENOTSUPP)' */ /* is signaled. */ /* $ Files */ /* A new segment, which contains a subset of the data in the */ /* segment specified by DESCR and HANDLE, is written to the SPK */ /* file attached to NEWH. */ /* $ Particulars */ /* Sometimes, the segments in official source files---planetary */ /* Developmental Ephemeris (DE) files, archival spacecraft */ /* ephemeris files, and so on---contain more data than is needed */ /* by a particular user. SPKSUB allows a user to extract from a */ /* segment the smallest amount of ephemeris data sufficient to */ /* cover a specific interval. */ /* The new segment is written with the same identifier as the */ /* original segment, and with the same descriptor, with the */ /* following components changed: */ /* 1) ALPHA and OMEGA (DCD(1) and DCD(2)) are assigned the values */ /* specified by BEGIN and END. */ /* 2) The beginning and ending segment addresses (ICD(5) and ICD(6)) */ /* are changed to reflect the location of the new segment. */ /* $ Examples */ /* In the following code fragment, the descriptor for each segment */ /* in a source SPK file is examined. For each segment that covers a */ /* specified time interval, the smallest possible subset of data */ /* from that segment, sufficient to cover the interval, is extracted */ /* into a custom SPK file. */ /* Assume that the source and custom files have been opened, for */ /* read and write access, with handles SRC and CUST respectively. */ /* CALL DAFBFS ( SRC ) */ /* CALL DAFFNA ( FOUND ) */ /* DO WHILE ( FOUND ) */ /* CALL DAFGS ( DESCR ) */ /* CALL DAFUS ( DESCR, 2, 6, DC, IC ) */ /* IF ( DC(1) .LE. BEGIN .AND. END .LE. DC(2) ) THEN */ /* CALL DAFGN ( IDENT ) */ /* CALL SPKSUB ( SRC, DESCR, IDENT, BEGIN, END, CUST ) */ /* END IF */ /* CALL DAFFNA ( FOUND ) */ /* END DO */ /* $ Restrictions */ /* 1) There is no way for SPKSUB to verify that the descriptor and */ /* identifier are the original ones for the segment. Changing */ /* the descriptor can cause the data in the new segment to be */ /* evaluated incorrectly; changing the identifier can destroy */ /* the path from the data back to its original source. */ /* $ Literature_References */ /* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */ /* User's Guide" */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* W.L. Taber (JPL) */ /* N.J. Bachman (JPL) */ /* J.M. Lynch (JPL) */ /* R.E. Thurman (JPL) */ /* I.M. Underwood (JPL) */ /* $ Version */ /* - SPICELIB Version 9.0.0, 23-DEC-2013 (NJB) */ /* The routine was updated to handle types 19, 20 and 21. Some */ /* minor changes were made to comments. */ /* - SPICELIB Version 8.0.0, 12-AUG-2002 (NJB) */ /* The routine was updated to handle type 18. */ /* - SPICELIB Version 7.0.0, 06-NOV-1999 (NJB) */ /* The routine was updated to handle types 12 and 13. */ /* - SPICELIB Version 6.0.0, 30-JUN-1997 (WLT) */ /* The routine was updated to handle types 10 and 17. */ /* - SPICELIB Version 5.0.0, 10-MAR-1995 (KRG) */ /* The routine was updated to handle type 14. */ /* - SPICELIB Version 4.0.0, 07-NOV-1994 (WLT) */ /* The routine was updated to handle type 15. */ /* - SPICELIB Version 3.0.0, 05-AUG-1993 (NJB) */ /* The routine was updated to handle types 08 and 09. */ /* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */ /* 1) The routine was updated to handle type 05. */ /* 2) DESCR was being used as both an input and output */ /* variable when it was only supposed to be used for */ /* input. A new local variable, NDSCR, was added where DESCR */ /* was being altered. */ /* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ /* Literature references added to the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (RET) */ /* -& */ /* $ Index_Entries */ /* subset of spk file */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 9.0.0, 23-DEC-2013 (NJB) */ /* The routine was updated to handle types 19, 20 and 21. Some */ /* minor changes were made to comments. */ /* - SPICELIB Version 8.0.0, 12-AUG-2002 (NJB) */ /* The routine was updated to handle type 18. */ /* - SPICELIB Version 6.0.0, 30-JUN-1997 (WLT) */ /* The routine was updated to handle types 10 and 17. */ /* - SPICELIB Version 5.0.0, 10-MAR-1995 (KRG) */ /* The routine was updated to handle type 14. */ /* - SPICELIB Version 4.0.0, 07-NOV-1994 (WLT) */ /* The routine was updated to handle type 15. */ /* - SPICELIB Version 3.0.0, 05-AUG-1993 (NJB) */ /* The routine was updated to handle types 08 and 09. */ /* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */ /* 1) The routine was updated to handle type 05. */ /* 2) DESCR was being used as both an input and output */ /* variable when it was only supposed to be used for */ /* input. A new local variable, NDSCR, was added where DESCR */ /* was being altered. */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("SPKSUB", (ftnlen)6); } /* Unpack the descriptor. */ dafus_(descr, &c__2, &c__6, dc, ic); alpha = dc[0]; omega = dc[1]; type__ = ic[3]; baddr = ic[4]; eaddr = ic[5]; /* Make sure the epochs check out. */ okay = alpha <= *begin && *begin <= *end && *end <= omega; if (! okay) { setmsg_("Specified interval [#, #] is not a subset of segment interv" "al [#, #].", (ftnlen)69); errdp_("#", begin, (ftnlen)1); errdp_("#", end, (ftnlen)1); errdp_("#", &alpha, (ftnlen)1); errdp_("#", &omega, (ftnlen)1); sigerr_("SPICE(SPKNOTASUBSET)", (ftnlen)20); chkout_("SPKSUB", (ftnlen)6); return 0; } /* Begin the new segment, with a descriptor containing the subset */ /* epochs. */ dc[0] = *begin; dc[1] = *end; dafps_(&c__2, &c__6, dc, ic, ndscr); /* Let the type-specific (SPKSnn) routines decide what to move. */ if (type__ == 1) { dafbna_(newh, ndscr, ident, ident_len); spks01_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 2) { dafbna_(newh, ndscr, ident, ident_len); spks02_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 3) { dafbna_(newh, ndscr, ident, ident_len); spks03_(handle, &baddr, &eaddr, begin, end); dafena_(); /* Type 04 has not been yet been added to SPICELIB. */ /* ELSE IF ( TYPE .EQ. 04 ) THEN */ /* CALL DAFBNA ( NEWH, NDSCR, IDENT ) */ /* CALL SPKS04 ( HANDLE, BADDR, EADDR, BEGIN, END ) */ /* CALL DAFENA */ } else if (type__ == 5) { dafbna_(newh, ndscr, ident, ident_len); spks05_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 8) { dafbna_(newh, ndscr, ident, ident_len); spks08_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 9) { dafbna_(newh, ndscr, ident, ident_len); spks09_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 10) { spks10_(handle, descr, newh, ndscr, ident, ident_len); } else if (type__ == 12) { dafbna_(newh, ndscr, ident, ident_len); spks12_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 13) { dafbna_(newh, ndscr, ident, ident_len); spks13_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 14) { spks14_(handle, descr, newh, ndscr, ident, ident_len); } else if (type__ == 15) { dafbna_(newh, ndscr, ident, ident_len); spks15_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 17) { dafbna_(newh, ndscr, ident, ident_len); spks17_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 18) { dafbna_(newh, ndscr, ident, ident_len); spks18_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 19) { dafbna_(newh, ndscr, ident, ident_len); spks19_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 20) { dafbna_(newh, ndscr, ident, ident_len); spks20_(handle, &baddr, &eaddr, begin, end); dafena_(); } else if (type__ == 21) { dafbna_(newh, ndscr, ident, ident_len); spks21_(handle, &baddr, &eaddr, begin, end); dafena_(); } else { setmsg_("SPK data type # is not supported.", (ftnlen)33); errint_("#", &type__, (ftnlen)1); sigerr_("SPICE(SPKTYPENOTSUPP)", (ftnlen)21); chkout_("SPKSUB", (ftnlen)6); return 0; } chkout_("SPKSUB", (ftnlen)6); return 0; } /* spksub_ */
/* $Procedure SPKW15 ( SPK, write a type 15 segment ) */ /* Subroutine */ int spkw15_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p, doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm, doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen segid_len) { /* System generated locals */ integer i__1; /* Local variables */ extern /* Subroutine */ int vhat_(doublereal *, doublereal *); doublereal mypa[3]; extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, doublereal *); extern /* Subroutine */ int vequ_(doublereal *, doublereal *); doublereal mytp[3]; integer i__; doublereal angle; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal descr[5]; integer value; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); extern logical vzero_(doublereal *); extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); doublereal record[16]; extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), spkpds_(integer *, integer *, char *, integer *, doublereal *, doublereal *, doublereal *, ftnlen); extern logical return_(void); extern doublereal dpr_(void); doublereal dot; /* $ Abstract */ /* Write an SPK segment of type 15 given a type 15 data 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 */ /* SPK */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of an SPK file open for writing. */ /* BODY I Body code for ephemeris object. */ /* CENTER I Body code for the center of motion of the body. */ /* FRAME I The reference frame of the states. */ /* FIRST I First valid time for which states can be computed. */ /* LAST I Last valid time for which states can be computed. */ /* SEGID I Segment identifier. */ /* EPOCH I Epoch of the periapse. */ /* TP I Trajectory pole vector. */ /* PA I Periapsis vector. */ /* P I Semi-latus rectum. */ /* ECC I Eccentricity. */ /* J2FLG I J2 processing flag. */ /* PV I Central body pole vector. */ /* GM I Central body GM. */ /* J2 I Central body J2. */ /* RADIUS I Equatorial radius of central body. */ /* $ Detailed_Input */ /* HANDLE is the file handle of an SPK file that has been */ /* opened for writing. */ /* BODY is the NAIF ID for the body whose states are */ /* to be recorded in an SPK file. */ /* CENTER is the NAIF ID for the center of motion associated */ /* with BODY. */ /* FRAME is the reference frame that states are referenced to, */ /* for example 'J2000'. */ /* FIRST are the bounds on the ephemeris times, expressed as */ /* LAST seconds past J2000. */ /* SEGID is the segment identifier. An SPK segment identifier */ /* may contain up to 40 characters. */ /* EPOCH is the epoch of the orbit elements at periapse */ /* in ephemeris seconds past J2000. */ /* TP is a vector parallel to the angular momentum vector */ /* of the orbit at epoch expressed relative to FRAME. A */ /* unit vector parallel to TP will be stored in the */ /* output segment. */ /* PA is a vector parallel to the position vector of the */ /* trajectory at periapsis of EPOCH expressed relative */ /* to FRAME. A unit vector parallel to PA will be */ /* stored in the output segment. */ /* P is the semi-latus rectum--- p in the equation: */ /* r = p/(1 + ECC*COS(Nu)) */ /* ECC is the eccentricity. */ /* J2FLG is the J2 processing flag describing what J2 */ /* corrections are to be applied when the orbit is */ /* propagated. */ /* All J2 corrections are applied if the value of J2FLG */ /* is not 1, 2 or 3. */ /* If the value of the flag is 3 no corrections are */ /* done. */ /* If the value of the flag is 1 no corrections are */ /* computed for the precession of the line of apsides. */ /* However, regression of the line of nodes is */ /* performed. */ /* If the value of the flag is 2 no corrections are */ /* done for the regression of the line of nodes. */ /* However, precession of the line of apsides is */ /* performed. */ /* Note that J2 effects are computed only if the orbit */ /* is elliptic and does not intersect the central body. */ /* PV is a vector parallel to the north pole vector of the */ /* central body expressed relative to FRAME. A unit */ /* vector parallel to PV will be stored in the output */ /* segment. */ /* GM is the central body GM. */ /* J2 is the central body J2 (dimensionless). */ /* RADIUS is the equatorial radius of the central body. */ /* Units are radians, km, seconds. */ /* $ Detailed_Output */ /* None. A type 15 segment is written to the file attached */ /* to HANDLE. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the eccentricity is less than zero, the error */ /* 'SPICE(BADECCENTRICITY)' will be signaled. */ /* 2) If the semi-latus rectum is 0, the error */ /* 'SPICE(BADLATUSRECTUM)' is signaled. */ /* 3) If the pole vector, trajectory pole vector or periapsis vector */ /* have zero length, the error 'SPICE(BADVECTOR)' is signaled. */ /* 4) If the trajectory pole vector and the periapsis vector are */ /* not orthogonal, the error 'SPICE(BADINITSTATE)' is signaled. */ /* The test for orthogonality is very crude. The routine simply */ /* checks that the dot product of the unit vectors parallel */ /* to the trajectory pole and periapse vectors is less than */ /* 0.00001. This check is intended to catch blunders, not to */ /* enforce orthogonality to double precision capacity. */ /* 5) If the mass of the central body is non-positive, the error */ /* 'SPICE(NONPOSITIVEMASS)' is signaled. */ /* 6) If the radius of the central body is negative, the error */ /* 'SPICE(BADRADIUS)' is signaled. */ /* 7) If the segment identifier has more than 40 non-blank characters */ /* the error 'SPICE(SEGIDTOOLONG)' is signaled. */ /* 8) If the segment identifier contains non-printing characters */ /* the error 'SPICE(NONPRINTABLECHARS)' is signaled. */ /* 9) If there are inconsistencies in the BODY, CENTER, FRAME or */ /* FIRST and LAST times, the problem will be diagnosed by */ /* a routine in the call tree of this routine. */ /* $ Files */ /* A new type 15 SPK segment is written to the SPK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an SPK type 15 data segment to the open SPK */ /* file according to the format described in the type 15 section of */ /* the SPK Required Reading. The SPK file must have been opened with */ /* write access. */ /* This routine is provided to provide direct support for the MASL */ /* precessing orbit formulation. */ /* $ Examples */ /* Suppose that at time EPOCH you have the J2000 periapsis */ /* state of some object relative to some central body and would */ /* like to create a type 15 SPK segment to model the motion of */ /* the object using simple regression and precession of the */ /* line of nodes and apsides. The following code fragment */ /* illustrates how you can prepare such a segment. We shall */ /* assume that you have in hand the J2000 direction of the */ /* central body's pole vector, its GM, J2 and equatorial */ /* radius. In addition we assume that you have opened an SPK */ /* file for write access and that it is attached to HANDLE. */ /* (If your state is at an epoch other than periapse the */ /* fragment below will NOT produce a "correct" type 15 segment */ /* for modeling the motion of your object.) */ /* C */ /* C First we get the osculating elements. */ /* C */ /* CALL OSCELT ( STATE, EPOCH, GM, ELTS ) */ /* C */ /* C From these collect the eccentricity and semi-latus rectum. */ /* C */ /* ECC = ELTS ( 2 ) */ /* P = ELTS ( 1 ) * ( 1.0D0 + ECC ) */ /* C */ /* C Next get the trajectory pole vector and the */ /* C periapsis vector. */ /* C */ /* CALL UCRSS ( STATE(1), STATE(4), TP ) */ /* CALL VHAT ( STATE(1), PA ) */ /* C */ /* C Enable both J2 corrections. */ /* C */ /* J2FLG = 0.0D0 */ /* C */ /* C Now add the segment. */ /* C */ /* CALL SPKW15 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ /* . SEGID, EPOCH, TP, PA, P, ECC, */ /* . J2FLG, PV, GM, J2, RADIUS ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 29-MAY-2012 (NJB) */ /* Input vectors that nominally have unit length */ /* are mapped to local copies that actually do */ /* have unit length. The applicable inputs are TP, PA, */ /* and PV. The Detailed Input header section was updated */ /* to reflect the change. */ /* Some typos in error messages were corrected. */ /* - SPICELIB Version 1.0.0, 28-NOV-1994 (WLT) */ /* -& */ /* $ Index_Entries */ /* Write a type 15 spk segment */ /* -& */ /* SPICELIB Functions */ /* Local Variables */ /* Segment descriptor size */ /* Segment identifier size */ /* SPK data type */ /* Range of printing characters */ /* Number of items in a segment */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("SPKW15", (ftnlen)6); /* Fetch the various entities from the inputs and put them into */ /* the data record, first the epoch. */ record[0] = *epoch; /* Convert TP and PA to unit vectors. */ vhat_(pa, mypa); vhat_(tp, mytp); /* The trajectory pole vector. */ vequ_(mytp, &record[1]); /* The periapsis vector. */ vequ_(mypa, &record[4]); /* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */ /* and eccentricity. */ record[7] = *p; record[8] = *ecc; /* J2 processing flag. */ record[9] = *j2flg; /* Central body pole vector. */ vhat_(pv, &record[10]); /* The central mass, J2 and radius of the central body. */ record[13] = *gm; record[14] = *j2; record[15] = *radius; /* Check all the inputs here for obvious failures. It's much */ /* better to check them now and quit than it is to get a bogus */ /* segment into an SPK file and diagnose it later. */ if (*p <= 0.) { setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator" " was non-positive. This value must be positive. The value s" "upplied was #.", (ftnlen)133); errdp_("#", p, (ftnlen)1); sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21); chkout_("SPKW15", (ftnlen)6); return 0; } else if (*ecc < 0.) { setmsg_("The eccentricity supplied for a type 15 segment is negative" ". It must be non-negative. The value supplied to the type 1" "5 evaluator was #. ", (ftnlen)138); errdp_("#", ecc, (ftnlen)1); sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22); chkout_("SPKW15", (ftnlen)6); return 0; } else if (*gm <= 0.) { setmsg_("The mass supplied for the central body of a type 15 segment" " was non-positive. Masses must be positive. The value suppl" "ied was #. ", (ftnlen)130); errdp_("#", gm, (ftnlen)1); sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22); chkout_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(tp)) { setmsg_("The trajectory pole vector supplied to SPKW15 had length ze" "ro. The most likely cause of this problem is an uninitialize" "d vector.", (ftnlen)128); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(pa)) { setmsg_("The periapse vector supplied to SPKW15 had length zero. The" " most likely cause of this problem is an uninitialized vecto" "r.", (ftnlen)121); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(pv)) { setmsg_("The central pole vector supplied to SPKW15 had length zero." " The most likely cause of this problem is an uninitialized v" "ector. ", (ftnlen)126); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (*radius < 0.) { setmsg_("The central body radius was negative. It must be zero or po" "sitive. The value supplied was #. ", (ftnlen)94); errdp_("#", radius, (ftnlen)1); sigerr_("SPICE(BADRADIUS)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } /* One final check. Make sure the pole and periapse vectors are */ /* orthogonal. (We will use a very crude check but this should */ /* rule out any obvious errors.) */ dot = vdot_(mypa, mytp); if (abs(dot) > 1e-5) { angle = vsep_(pa, tp) * dpr_(); setmsg_("The periapsis and trajectory pole vectors are not orthogona" "l. The angle between them is # degrees. ", (ftnlen)99); errdp_("#", &angle, (ftnlen)1); sigerr_("SPICE(BADINITSTATE)", (ftnlen)19); chkout_("SPKW15", (ftnlen)6); return 0; } /* Make sure the segment identifier is not too long. */ if (lastnb_(segid, segid_len) > 40) { setmsg_("Segment identifier contains more than 40 characters.", ( ftnlen)52); sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); chkout_("SPKW15", (ftnlen)6); return 0; } /* Make sure it has only printing characters. */ i__1 = lastnb_(segid, segid_len); for (i__ = 1; i__ <= i__1; ++i__) { value = *(unsigned char *)&segid[i__ - 1]; if (value < 32 || value > 126) { setmsg_("The segment identifier contains the nonprintable charac" "ter having ascii code #.", (ftnlen)79); errint_("#", &value, (ftnlen)1); sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); chkout_("SPKW15", (ftnlen)6); return 0; } } /* All of the obvious checks have been performed on the input */ /* record. Create the segment descriptor. (FIRST and LAST are */ /* checked by SPKPDS as well as consistency between BODY and CENTER). */ spkpds_(body, center, frame, &c__15, first, last, descr, frame_len); if (failed_()) { chkout_("SPKW15", (ftnlen)6); return 0; } /* Begin a new segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("SPKW15", (ftnlen)6); return 0; } dafada_(record, &c__16); if (! failed_()) { dafena_(); } chkout_("SPKW15", (ftnlen)6); return 0; } /* spkw15_ */