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