/* $Procedure SPKS02 ( S/P Kernel, subset, type 2 ) */
/* Subroutine */ int spks02_(integer *handle, integer *baddr, integer *eaddr,
doublereal *begin, doublereal *end)
{
/* System generated locals */
integer i__1;
/* Local variables */
doublereal data[50];
integer addr__, nrec;
doublereal init;
integer last, move;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer first;
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_(
integer *, integer *, integer *, doublereal *);
integer remain;
doublereal intlen;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer recsiz;
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in a SPK segment of type 2 */
/* into a new 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 */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of source segment. */
/* BADDR I Beginning address of source segment. */
/* EADDR I Ending address of source segment. */
/* BEGIN I Beginning (initial epoch) of subset. */
/* END I End (final epoch) of subset. */
/* $ Detailed_Input */
/* HANDLE, */
/* BADDR, */
/* EADDR are the file handle assigned to a SPK file, and the */
/* beginning and ending addresses of a segment within */
/* the file. 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 to be extracted. */
/* $ Detailed_Output */
/* None. This routine writes data to the SPK file currently */
/* open for write access. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) Any errors that occur while reading data from the source SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* 2) Any errors that occur while writing data to the output SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* The exact structure of a segment of data type 2 is detailed in */
/* the SPK Required Reading file. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* R.E. Thurman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 30-DEC-2013 (NJB) */
/* Enhanced header documentation. */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */
/* SPK02 was removed from the Required_Reading section of the */
/* header. The information in the SPK02 Required Reading file */
/* is now part of the SPK Required Reading file. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */
/* -& */
/* $ Index_Entries */
/* subset type_2 spk segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKS02", (ftnlen)6);
}
/* The segment is made up of a number of logical records, each */
/* having the same size, and covering the same length of time. */
/* We can determine which records to extract by comparing the input */
/* epochs with the initial time of the segment and the length of the */
/* interval covered by each record. These final two constants are */
/* located at the end of the segment, along with the size of each */
/* logical record and the total number of records. */
i__1 = *eaddr - 3;
dafgda_(handle, &i__1, eaddr, data);
init = data[0];
intlen = data[1];
recsiz = (integer) data[2];
nrec = (integer) data[3];
first = (integer) ((*begin - init) / intlen) + 1;
first = min(first,nrec);
last = (integer) ((*end - init) / intlen) + 1;
last = min(last,nrec);
/* The number of records to be moved. */
nrec = last - first + 1;
/* We're going to move the data in chunks of 50 d.p. words. Compute */
/* the number of words left to move, the address of the beginning */
/* of the records to move, and the number to move this time. */
remain = nrec * recsiz;
addr__ = *baddr + (first - 1) * recsiz;
move = min(50,remain);
while(remain > 0) {
i__1 = addr__ + move - 1;
dafgda_(handle, &addr__, &i__1, data);
dafada_(data, &move);
remain -= move;
addr__ += move;
move = min(50,remain);
}
/* That's all the records we have to move. But there are still four */
/* final numbers left to write: */
/* 1) The initial time for the polynomials (INIT). */
/* 2) The time interval length for each polynomial (INTLEN). */
/* 3) The record size (RECSIZ). */
/* 4) The number of records (NREC). */
/* INIT and NREC will probably be different for the new segment (in */
/* fact, NREC has already been changed), the other two will not. */
init += (first - 1) * intlen;
data[0] = init;
data[1] = intlen;
data[2] = (doublereal) recsiz;
data[3] = (doublereal) nrec;
dafada_(data, &c__4);
chkout_("SPKS02", (ftnlen)6);
return 0;
} /* spks02_ */
/* $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 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 SPKS21 ( S/P Kernel, subset, type 21 ) */
/* Subroutine */ int spks21_(integer *handle, integer *baddr, integer *eaddr,
doublereal *begin, doublereal *end)
{
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer i_dnnt(doublereal *);
/* Local variables */
doublereal data[111];
integer offe, nrec, ndir, last, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer first;
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_(
integer *, integer *, integer *, doublereal *);
integer maxdim, offset, dlsize;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in a SPK segment of type 21 */
/* into a new segment. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAF */
/* SPK */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* $ 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 source segment. */
/* BADDR I Beginning address of source segment. */
/* EADDR I Ending address of source segment. */
/* BEGIN I Beginning (initial epoch) of subset. */
/* END I End (final epoch) of subset. */
/* $ Detailed_Input */
/* HANDLE, */
/* BADDR, */
/* EADDR are the file handle assigned to a SPK file, and the */
/* beginning and ending addresses of a segment within */
/* the file. 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 to be extracted. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) Any errors that occur while reading data from the source SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* 2) Any errors that occur while writing data to the output SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* The exact structure of a segment of data type 21 is detailed in */
/* the SPK Required Reading file. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* I.M. Underwood (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 16-JAN-2014 (NJB) (FTK) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* subset type_21 spk segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKS01", (ftnlen)6);
/* Get the number of records in the segment. From that, we can */
/* compute */
/* NDIR The number of directory epochs. */
/* OFFE The offset of the first epoch. */
/* the number of directory epochs. */
i__1 = *eaddr - 1;
dafgda_(handle, &i__1, eaddr, data);
maxdim = i_dnnt(data);
nrec = i_dnnt(&data[1]);
ndir = nrec / 100;
offe = *eaddr - ndir - nrec - 2;
/* Well, the new segment has already been begun. We just have to */
/* decide what to move, and move it (using DAFADA). */
/* Let's agree right now that speed is not of the greatest */
/* importance here. We can probably do this with two passes */
/* through the record epochs, and one pass through the records. */
/* 1) Determine the first and last records to be included */
/* in the subset. */
/* 2) Move the records. */
/* 3) Write the epochs. */
/* We can leap through the epochs one last time to get the */
/* directory epochs. */
/* First pass: which records are to be moved? */
first = 0;
last = 0;
i__1 = nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = offe + i__;
i__3 = offe + i__;
dafgda_(handle, &i__2, &i__3, data);
if (first == 0 && data[0] >= *begin) {
first = i__;
}
if (first != 0 && last == 0 && data[0] >= *end) {
last = i__;
}
}
/* Second pass. Move the records. */
dlsize = (maxdim << 2) + 11;
offset = *baddr - 1 + (first - 1) * dlsize;
i__1 = last;
for (i__ = first; i__ <= i__1; ++i__) {
i__2 = offset + 1;
i__3 = offset + dlsize;
dafgda_(handle, &i__2, &i__3, data);
dafada_(data, &dlsize);
offset += dlsize;
}
/* Third pass. Move the epochs. */
i__1 = last;
for (i__ = first; i__ <= i__1; ++i__) {
i__2 = offe + i__;
i__3 = offe + i__;
dafgda_(handle, &i__2, &i__3, data);
dafada_(data, &c__1);
}
/* Get every DIRSIZ'th epoch for the directory. */
i__1 = last;
for (i__ = first + 99; i__ <= i__1; i__ += 100) {
i__2 = offe + i__;
i__3 = offe + i__;
dafgda_(handle, &i__2, &i__3, data);
dafada_(data, &c__1);
}
/* Add the maximum difference line dimension and the */
/* number of records, and we're done. */
d__1 = (doublereal) maxdim;
dafada_(&d__1, &c__1);
data[0] = (doublereal) (last - first + 1);
dafada_(data, &c__1);
chkout_("SPKS01", (ftnlen)6);
return 0;
} /* spks21_ */
/* $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 SPKS17 ( S/P Kernel, subset, type 17 ) */
/* Subroutine */ int spks17_(integer *handle, integer *baddr, integer *eaddr,
doublereal *begin, doublereal *end)
{
doublereal data[12];
extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *,
integer *), dafgda_(integer *, integer *, integer *, doublereal *)
, chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in an SPK segment of type 17 */
/* into a new 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 file containing source segment. */
/* BADDR I Beginning address in file of source segment. */
/* EADDR I Ending address in file of source segment. */
/* BEGIN I Beginning (initial epoch) of subset. */
/* END I End (final epoch) of subset. */
/* $ Detailed_Input */
/* HANDLE, */
/* BADDR, */
/* EADDR are the file handle assigned to an SPK file, and the */
/* beginning and ending addresses of a segment within */
/* that file. 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. */
/* $ Detailed_Output */
/* See $Files section. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) This routine relies on the caller to ensure that the */
/* interval [BEGIN, END] is contained in the coverage */
/* interval of the segment. */
/* 2) If BEGIN > END, no data is written to the target file. */
/* $ Files */
/* Data is extracted from the file connected to the input */
/* handle, and written to the current DAF open for writing. */
/* The segment descriptor and summary must already have been written */
/* prior to calling this routine. The segment must be ended */
/* external to this routine. */
/* $ Particulars */
/* This routine is intended solely for use as a utility by the */
/* routine SPKSUB. It transfers a subset of a type 17 SPK data */
/* segment to a properly initialized segment of a second SPK file. */
/* The exact structure of a segment of data type 17 is described */
/* in the section on type 17 in the SPK Required Reading. */
/* $ Examples */
/* This routine is intended only for use as a utility by SPKSUB. */
/* To use this routine successfully, you must: */
/* Open the SPK file from which to extract data. */
/* Locate the segment from which data should be extracted. */
/* Open the SPK file to which this data should be written. */
/* Begin a new segment (array). */
/* Write the summary information for the array. */
/* Call this routine to extract the appropriate data from the */
/* SPK open for read. */
/* End the array to which this routine writes data. */
/* Much of this procedure is carried out by the routine SPKSUB. The */
/* examples of that routine illustrate more fully the process */
/* described above. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.0, 3-JAN-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* subset type_17 spk segment */
/* -& */
/* $ Revisions */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKS17", (ftnlen)6);
}
/* See whether there's any work to do; return immediately if not. */
if (*begin > *end) {
chkout_("SPKS17", (ftnlen)6);
return 0;
}
/* This couldn't be much easier. First copy the entire */
/* type 17 segment out of the file. */
dafgda_(handle, baddr, eaddr, data);
/* Now write the data into the output file. */
dafada_(data, &c__12);
chkout_("SPKS17", (ftnlen)6);
return 0;
} /* spks17_ */
/* $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 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 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_ */
