PageRenderTime 28ms CodeModel.GetById 0ms RepoModel.GetById 0ms app.codeStats 0ms

/src/ckr05.c

https://github.com/mattbornski/spice
C | 1251 lines | 365 code | 336 blank | 550 comment | 92 complexity | a1d448ab228a33e7b30e7d7d3c1bf144 MD5 | raw file
  1. /* ckr05.f -- translated by f2c (version 19980913).
  2. You must link the resulting object file with the libraries:
  3. -lf2c -lm (in that order)
  4. */
  5. #include "f2c.h"
  6. /* Table of constant values */
  7. static integer c__2 = 2;
  8. static integer c__6 = 6;
  9. /* $Procedure CKR05 ( Read CK record from segment, type 05 ) */
  10. /* Subroutine */ int ckr05_(integer *handle, doublereal *descr, doublereal *
  11. sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
  12. *found)
  13. {
  14. /* Initialized data */
  15. static integer lbeg = -1;
  16. static integer lend = -1;
  17. static integer lhand = 0;
  18. static doublereal prevn = -1.;
  19. static doublereal prevnn = -1.;
  20. static doublereal prevs = -1.;
  21. /* System generated locals */
  22. integer i__1, i__2;
  23. doublereal d__1, d__2;
  24. /* Builtin functions */
  25. integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
  26. /* Local variables */
  27. integer high;
  28. doublereal rate;
  29. integer last, type__, i__, j, n;
  30. doublereal t;
  31. integer begin;
  32. extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
  33. integer *, integer *, doublereal *, integer *);
  34. integer nidir;
  35. extern doublereal dpmax_(void);
  36. extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
  37. integer npdir, nsrch;
  38. extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
  39. integer lsize, first, nints, rsize;
  40. doublereal start;
  41. extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
  42. doublereal *);
  43. doublereal dc[2];
  44. integer ic[6];
  45. extern logical failed_(void);
  46. integer bufbas, dirbas;
  47. doublereal hepoch;
  48. extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
  49. doublereal lepoch;
  50. integer npread, nsread, remain, pbegix, sbegix, timbas;
  51. doublereal pbuffr[101];
  52. extern integer lstled_(doublereal *, integer *, doublereal *);
  53. doublereal sbuffr[103];
  54. integer pendix, sendix, packsz;
  55. extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
  56. ftnlen);
  57. integer maxwnd;
  58. doublereal contrl[5];
  59. extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
  60. integer *, ftnlen);
  61. extern integer lstltd_(doublereal *, integer *, doublereal *);
  62. doublereal nstart;
  63. extern logical return_(void);
  64. integer pgroup, sgroup, wndsiz, wstart, subtyp;
  65. doublereal nnstrt;
  66. extern logical odd_(integer *);
  67. integer end, low;
  68. /* $ Abstract */
  69. /* Read a single CK data record from a segment of type 05 */
  70. /* (MEX/Rosetta Attitude file interpolation). */
  71. /* $ Disclaimer */
  72. /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
  73. /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
  74. /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
  75. /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
  76. /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
  77. /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
  78. /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
  79. /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
  80. /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
  81. /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
  82. /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
  83. /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
  84. /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
  85. /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
  86. /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
  87. /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
  88. /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
  89. /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
  90. /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
  91. /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
  92. /* $ Required_Reading */
  93. /* CK */
  94. /* $ Keywords */
  95. /* POINTING */
  96. /* $ Declarations */
  97. /* $ Abstract */
  98. /* Declare parameters specific to CK type 05. */
  99. /* $ Disclaimer */
  100. /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
  101. /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
  102. /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
  103. /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
  104. /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
  105. /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
  106. /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
  107. /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
  108. /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
  109. /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
  110. /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
  111. /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
  112. /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
  113. /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
  114. /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
  115. /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
  116. /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
  117. /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
  118. /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
  119. /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
  120. /* $ Required_Reading */
  121. /* CK */
  122. /* $ Keywords */
  123. /* CK */
  124. /* $ Restrictions */
  125. /* None. */
  126. /* $ Author_and_Institution */
  127. /* N.J. Bachman (JPL) */
  128. /* $ Literature_References */
  129. /* None. */
  130. /* $ Version */
  131. /* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */
  132. /* -& */
  133. /* CK type 5 subtype codes: */
  134. /* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */
  135. /* and quaternion derivatives only, no angular velocity */
  136. /* vector provided. Quaternion elements are listed */
  137. /* first, followed by derivatives. Angular velocity is */
  138. /* derived from the quaternions and quaternion */
  139. /* derivatives. */
  140. /* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */
  141. /* only. Angular velocity is derived by differentiating */
  142. /* the interpolating polynomials. */
  143. /* Subtype 2: Hermite interpolation, 14-element packets. */
  144. /* Quaternion and angular angular velocity vector, as */
  145. /* well as derivatives of each, are provided. The */
  146. /* quaternion comes first, then quaternion derivatives, */
  147. /* then angular velocity and its derivatives. */
  148. /* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */
  149. /* and angular velocity vector provided. The quaternion */
  150. /* comes first. */
  151. /* Packet sizes associated with the various subtypes: */
  152. /* End of file ck05.inc. */
  153. /* $ Abstract */
  154. /* Declarations of the CK data type specific and general CK low */
  155. /* level routine parameters. */
  156. /* $ Disclaimer */
  157. /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
  158. /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
  159. /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
  160. /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
  161. /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
  162. /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
  163. /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
  164. /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
  165. /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
  166. /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
  167. /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
  168. /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
  169. /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
  170. /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
  171. /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
  172. /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
  173. /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
  174. /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
  175. /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
  176. /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
  177. /* $ Required_Reading */
  178. /* CK.REQ */
  179. /* $ Keywords */
  180. /* CK */
  181. /* $ Restrictions */
  182. /* 1) If new CK types are added, the size of the record passed */
  183. /* between CKRxx and CKExx must be registered as separate */
  184. /* parameter. If this size will be greater than current value */
  185. /* of the CKMRSZ parameter (which specifies the maximum record */
  186. /* size for the record buffer used inside CKPFS) then it should */
  187. /* be assigned to CKMRSZ as a new value. */
  188. /* $ Author_and_Institution */
  189. /* N.J. Bachman (JPL) */
  190. /* B.V. Semenov (JPL) */
  191. /* $ Literature_References */
  192. /* CK Required Reading. */
  193. /* $ Version */
  194. /* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
  195. /* Updated to support CK type 5. */
  196. /* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
  197. /* -& */
  198. /* Number of quaternion components and number of quaternion and */
  199. /* angular rate components together. */
  200. /* CK Type 1 parameters: */
  201. /* CK1DTP CK data type 1 ID; */
  202. /* CK1RSZ maximum size of a record passed between CKR01 */
  203. /* and CKE01. */
  204. /* CK Type 2 parameters: */
  205. /* CK2DTP CK data type 2 ID; */
  206. /* CK2RSZ maximum size of a record passed between CKR02 */
  207. /* and CKE02. */
  208. /* CK Type 3 parameters: */
  209. /* CK3DTP CK data type 3 ID; */
  210. /* CK3RSZ maximum size of a record passed between CKR03 */
  211. /* and CKE03. */
  212. /* CK Type 4 parameters: */
  213. /* CK4DTP CK data type 4 ID; */
  214. /* CK4PCD parameter defining integer to DP packing schema that */
  215. /* is applied when seven number integer array containing */
  216. /* polynomial degrees for quaternion and angular rate */
  217. /* components packed into a single DP number stored in */
  218. /* actual CK records in a file; the value of must not be */
  219. /* changed or compatibility with existing type 4 CK files */
  220. /* will be lost. */
  221. /* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
  222. /* records; the value of this parameter must never exceed */
  223. /* value of the CK4PCD; */
  224. /* CK4SFT number of additional DPs, which are not polynomial */
  225. /* coefficients, located at the beginning of a type 4 */
  226. /* CK record that passed between routines CKR04 and CKE04; */
  227. /* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
  228. /* and CKE04; CK4RSZ is computed as follows: */
  229. /* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
  230. /* CK Type 5 parameters: */
  231. /* CK5DTP CK data type 5 ID; */
  232. /* CK5MXD maximum polynomial degree allowed in type 5 */
  233. /* records. */
  234. /* CK5MET number of additional DPs, which are not polynomial */
  235. /* coefficients, located at the beginning of a type 5 */
  236. /* CK record that passed between routines CKR05 and CKE05; */
  237. /* CK5MXP maximum packet size for any subtype. Subtype 2 */
  238. /* has the greatest packet size, since these packets */
  239. /* contain a quaternion, its derivative, an angular */
  240. /* velocity vector, and its derivative. See ck05.inc */
  241. /* for a description of the subtypes. */
  242. /* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
  243. /* and CKE05; CK5RSZ is computed as follows: */
  244. /* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
  245. /* Maximum record size that can be handled by CKPFS. This value */
  246. /* must be set to the maximum of all CKxRSZ parameters (currently */
  247. /* CK4RSZ.) */
  248. /* $ Brief_I/O */
  249. /* Variable I/O Description */
  250. /* -------- --- -------------------------------------------------- */
  251. /* HANDLE I File handle. */
  252. /* DESCR I Segment descriptor. */
  253. /* SCLKDP I Pointing request time. */
  254. /* TOL I Lookup tolerance. */
  255. /* NEEDAV I Angular velocity flag. */
  256. /* RECORD O Data record. */
  257. /* FOUND O Flag indicating whether record was found. */
  258. /* $ Detailed_Input */
  259. /* HANDLE, */
  260. /* DESCR are the file handle and segment descriptor for */
  261. /* a CK segment of type 05. */
  262. /* SCLKDP is an encoded spacecraft clock time indicating */
  263. /* the epoch for which pointing is desired. */
  264. /* TOL is a time tolerance, measured in the same units as */
  265. /* encoded spacecraft clock. */
  266. /* When SCLKDP falls within the bounds of one of the */
  267. /* interpolation intervals then the tolerance has no */
  268. /* effect because pointing will be returned at the */
  269. /* request time. */
  270. /* However, if the request time is not in one of the */
  271. /* intervals, then the tolerance is used to determine */
  272. /* if pointing at one of the interval endpoints should */
  273. /* be returned. */
  274. /* NEEDAV is true if angular velocity is requested. */
  275. /* $ Detailed_Output */
  276. /* RECORD is a set of data from the specified segment which, */
  277. /* when evaluated at epoch SCLKDP, will give the */
  278. /* attitude and angular velocity of some body, relative */
  279. /* to the reference frame indicated by DESCR. */
  280. /* The structure of the record is as follows: */
  281. /* +----------------------+ */
  282. /* | evaluation epoch | */
  283. /* +----------------------+ */
  284. /* | subtype code | */
  285. /* +----------------------+ */
  286. /* | number of packets (n)| */
  287. /* +----------------------+ */
  288. /* | nominal SCLK rate | */
  289. /* +----------------------+ */
  290. /* | packet 1 | */
  291. /* +----------------------+ */
  292. /* | packet 2 | */
  293. /* +----------------------+ */
  294. /* . */
  295. /* . */
  296. /* . */
  297. /* +----------------------+ */
  298. /* | packet n | */
  299. /* +----------------------+ */
  300. /* | epochs 1--n | */
  301. /* +----------------------+ */
  302. /* The packet size is a function of the subtype code. */
  303. /* All packets in a record have the same size. */
  304. /* $ Parameters */
  305. /* None. */
  306. /* $ Exceptions */
  307. /* This routine follows the pattern established in the lower-numbered */
  308. /* CK data type readers of not explicitly performing error */
  309. /* diagnoses. Exceptions are listed below nonetheless. */
  310. /* 1) If the input HANDLE does not designate a loaded CK file, the */
  311. /* error will be diagnosed by routines called by this routine. */
  312. /* 2) If the segment specified by DESCR is not of data type 05, */
  313. /* the error 'SPICE(WRONGCKTYPE)' is signaled. */
  314. /* 3) If the input SCLK value is not within the range specified */
  315. /* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */
  316. /* is signaled. */
  317. /* 4) If the window size is non-positive or greater than the */
  318. /* maximum allowed value, the error SPICE(INVALIDVALUE) is */
  319. /* signaled. */
  320. /* 5) If the window size is not compatible with the segment */
  321. /* subtype, the error SPICE(INVALIDVALUE) is signaled. */
  322. /* 6) If the segment subtype is not recognized, the error */
  323. /* SPICE(NOTSUPPORTED) is signaled. */
  324. /* 7) If the tolerance is negative, the error SPICE(VALUEOUTOFRANGE) */
  325. /* is signaled. */
  326. /* $ Files */
  327. /* See argument HANDLE. */
  328. /* $ Particulars */
  329. /* See the CK Required Reading file for a description of the */
  330. /* structure of a data type 05 segment. */
  331. /* $ Examples */
  332. /* The data returned by the CKRnn routine is in its rawest form, */
  333. /* taken directly from the segment. As such, it will be meaningless */
  334. /* to a user unless he/she understands the structure of the data type */
  335. /* completely. Given that understanding, however, the CKRxx */
  336. /* routines might be used to "dump" and check segment data for a */
  337. /* particular epoch. */
  338. /* C */
  339. /* C Get a segment applicable to a specified body and epoch. */
  340. /* C */
  341. /* C CALL CKBSS ( INST, SCLKDP, TOL, NEEDAV ) */
  342. /* CALL CKSNS ( HANDLE, DESCR, SEGID, SFND ) */
  343. /* IF ( .NOT. SFND ) THEN */
  344. /* [Handle case of pointing not being found] */
  345. /* END IF */
  346. /* C */
  347. /* C Look at parts of the descriptor. */
  348. /* C */
  349. /* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
  350. /* CENTER = ICD( 2 ) */
  351. /* REF = ICD( 3 ) */
  352. /* TYPE = ICD( 4 ) */
  353. /* IF ( TYPE .EQ. 05 ) THEN */
  354. /* CALL CKR05 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
  355. /* . RECORD, FOUND ) */
  356. /* IF ( .NOT. FOUND ) THEN */
  357. /* [Handle case of pointing not being found] */
  358. /* END IF */
  359. /* [Look at the RECORD data] */
  360. /* . */
  361. /* . */
  362. /* . */
  363. /* END IF */
  364. /* $ Restrictions */
  365. /* 1) Correctness of inputs must be ensured by the caller of */
  366. /* this routine. */
  367. /* $ Literature_References */
  368. /* None. */
  369. /* $ Author_and_Institution */
  370. /* N.J. Bachman (JPL) */
  371. /* $ Version */
  372. /* - SPICELIB Version 1.1.0, 06-SEP-2002 (NJB) */
  373. /* -& */
  374. /* $ Index_Entries */
  375. /* read record from type_5 ck segment */
  376. /* -& */
  377. /* $ Revisions */
  378. /* -& */
  379. /* SPICELIB functions */
  380. /* Local parameters */
  381. /* Maximum polynomial degree: */
  382. /* Local variables */
  383. /* Saved variables */
  384. /* Initial values */
  385. /* Standard SPICE error handling. */
  386. if (return_()) {
  387. return 0;
  388. }
  389. chkin_("CKR05", (ftnlen)5);
  390. /* No pointing found so far. */
  391. *found = FALSE_;
  392. /* Unpack the segment descriptor, and get the start and end addresses */
  393. /* of the segment. */
  394. dafus_(descr, &c__2, &c__6, dc, ic);
  395. type__ = ic[2];
  396. begin = ic[4];
  397. end = ic[5];
  398. /* Make sure that this really is a type 05 data segment. */
  399. if (type__ != 5) {
  400. setmsg_("You are attempting to locate type * data in a type 5 data s"
  401. "egment.", (ftnlen)66);
  402. errint_("*", &type__, (ftnlen)1);
  403. sigerr_("SPICE(WRONGCKTYPE)", (ftnlen)18);
  404. chkout_("CKR05", (ftnlen)5);
  405. return 0;
  406. }
  407. /* Check the tolerance value. */
  408. if (*tol < 0.) {
  409. setmsg_("Tolerance must be non-negative but was actually *.", (ftnlen)
  410. 50);
  411. errdp_("*", tol, (ftnlen)1);
  412. sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
  413. chkout_("CKR05", (ftnlen)5);
  414. return 0;
  415. }
  416. /* Check the request time and tolerance against the bounds in */
  417. /* the segment descriptor. */
  418. if (*sclkdp + *tol < dc[0] || *sclkdp - *tol > dc[1]) {
  419. /* The request time is too far outside the segment's coverage */
  420. /* interval for any pointing to satisfy the request. */
  421. chkout_("CKR05", (ftnlen)5);
  422. return 0;
  423. }
  424. /* Set the request time to use for searching. */
  425. t = brcktd_(sclkdp, dc, &dc[1]);
  426. /* From this point onward, we assume the segment was constructed */
  427. /* correctly. In particular, we assume: */
  428. /* 1) The segment descriptor's time bounds are in order and are */
  429. /* distinct. */
  430. /* 2) The epochs in the segment are in strictly increasing */
  431. /* order. */
  432. /* 3) The interpolation interval start times in the segment are */
  433. /* in strictly increasing order. */
  434. /* 4) The degree of the interpolating polynomial specified by */
  435. /* the segment is at least 1 and is no larger than MAXDEG. */
  436. i__1 = end - 4;
  437. dafgda_(handle, &i__1, &end, contrl);
  438. /* Check the FAILED flag just in case HANDLE is not attached to */
  439. /* any DAF file and the error action is not set to ABORT. We */
  440. /* do this only after the first call to DAFGDA, as in CKR03. */
  441. if (failed_()) {
  442. chkout_("CKR05", (ftnlen)5);
  443. return 0;
  444. }
  445. rate = contrl[0];
  446. subtyp = i_dnnt(&contrl[1]);
  447. wndsiz = i_dnnt(&contrl[2]);
  448. nints = i_dnnt(&contrl[3]);
  449. n = i_dnnt(&contrl[4]);
  450. /* Set the packet size, which is a function of the subtype. */
  451. if (subtyp == 0) {
  452. packsz = 8;
  453. } else if (subtyp == 1) {
  454. packsz = 4;
  455. } else if (subtyp == 2) {
  456. packsz = 14;
  457. } else if (subtyp == 3) {
  458. packsz = 7;
  459. } else {
  460. setmsg_("Unexpected CK type 5 subtype # found in type 5 segment.", (
  461. ftnlen)55);
  462. errint_("#", &subtyp, (ftnlen)1);
  463. sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
  464. chkout_("CKR05", (ftnlen)5);
  465. return 0;
  466. }
  467. /* Check the window size. */
  468. if (wndsiz <= 0) {
  469. setmsg_("Window size in type 05 segment was #; must be positive.", (
  470. ftnlen)55);
  471. errint_("#", &wndsiz, (ftnlen)1);
  472. sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
  473. chkout_("CKR05", (ftnlen)5);
  474. return 0;
  475. }
  476. if (subtyp == 0 || subtyp == 2) {
  477. /* These are the Hermite subtypes. */
  478. maxwnd = 8;
  479. if (wndsiz > maxwnd) {
  480. setmsg_("Window size in type 05 segment was #; max allowed value"
  481. " is # for subtypes 0 and 2 (Hermite, 8 or 14-element pac"
  482. "kets).", (ftnlen)117);
  483. errint_("#", &wndsiz, (ftnlen)1);
  484. errint_("#", &maxwnd, (ftnlen)1);
  485. sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
  486. chkout_("CKR05", (ftnlen)5);
  487. return 0;
  488. }
  489. if (odd_(&wndsiz)) {
  490. setmsg_("Window size in type 05 segment was #; must be even for "
  491. "subtypes 0 and 2 (Hermite, 8 or 14-element packets).", (
  492. ftnlen)107);
  493. errint_("#", &wndsiz, (ftnlen)1);
  494. sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
  495. chkout_("CKR05", (ftnlen)5);
  496. return 0;
  497. }
  498. } else if (subtyp == 1 || subtyp == 3) {
  499. /* These are the Lagrange subtypes. */
  500. maxwnd = 16;
  501. if (wndsiz > maxwnd) {
  502. setmsg_("Window size in type 05 segment was #; max allowed value"
  503. " is # for subtypes 1 and 3 (Lagrange, 4 or 7-element pac"
  504. "kets).", (ftnlen)117);
  505. errint_("#", &wndsiz, (ftnlen)1);
  506. errint_("#", &maxwnd, (ftnlen)1);
  507. sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
  508. chkout_("CKR05", (ftnlen)5);
  509. return 0;
  510. }
  511. if (odd_(&wndsiz)) {
  512. setmsg_("Window size in type 05 segment was #; must be even for "
  513. "subtypes 1 and 3 (Lagrange, 4 or 7-element packets).", (
  514. ftnlen)107);
  515. errint_("#", &wndsiz, (ftnlen)1);
  516. sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
  517. chkout_("CKR05", (ftnlen)5);
  518. return 0;
  519. }
  520. } else {
  521. setmsg_("This point should not be reached. Getting here may indicate"
  522. " that the code needs to updated to handle the new subtype #",
  523. (ftnlen)118);
  524. errint_("#", &subtyp, (ftnlen)1);
  525. sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
  526. chkout_("CKR05", (ftnlen)5);
  527. return 0;
  528. }
  529. /* We now need to select the pointing values to interpolate */
  530. /* in order to satisfy the pointing request. The first step */
  531. /* is to use the pointing directories (if any) to locate a set of */
  532. /* epochs bracketing the request time. Note that the request */
  533. /* time might not be bracketed: it could precede the first */
  534. /* epoch or follow the last epoch. */
  535. /* We'll use the variable PGROUP to refer to the set of epochs */
  536. /* to search. The first group consists of the epochs prior to */
  537. /* and including the first pointing directory entry. The last */
  538. /* group consists of the epochs following the last pointing */
  539. /* directory entry. Other groups consist of epochs following */
  540. /* one pointing directory entry up to and including the next */
  541. /* pointing directory entry. */
  542. npdir = (n - 1) / 100;
  543. dirbas = begin + n * packsz + n - 1;
  544. if (npdir == 0) {
  545. /* There's no mystery about which group of epochs to search. */
  546. pgroup = 1;
  547. } else {
  548. /* There's at least one directory. Find the first directory */
  549. /* whose time is greater than or equal to the request time, if */
  550. /* there is such a directory. We'll search linearly through the */
  551. /* directory entries, reading up to DIRSIZ of them at a time. */
  552. /* Having found the correct set of directory entries, we'll */
  553. /* perform a binary search within that set for the desired entry. */
  554. bufbas = dirbas;
  555. npread = min(npdir,100);
  556. i__1 = bufbas + 1;
  557. i__2 = bufbas + npread;
  558. dafgda_(handle, &i__1, &i__2, pbuffr);
  559. remain = npdir - npread;
  560. while(pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
  561. "pbuffr", i__1, "ckr05_", (ftnlen)633)] < t && remain > 0) {
  562. bufbas += npread;
  563. npread = min(remain,100);
  564. /* Note: NPREAD is always > 0 here. */
  565. i__1 = bufbas + 1;
  566. i__2 = bufbas + npread;
  567. dafgda_(handle, &i__1, &i__2, pbuffr);
  568. remain -= npread;
  569. }
  570. /* At this point, BUFBAS - DIRBAS is the number of directory */
  571. /* entries preceding the one contained in PBUFFR(1). */
  572. /* PGROUP is one more than the number of directories we've */
  573. /* passed by. */
  574. pgroup = bufbas - dirbas + lstltd_(&t, &npread, pbuffr) + 1;
  575. }
  576. /* PGROUP now indicates the set of epochs in which to search for the */
  577. /* request epoch. The following cases can occur: */
  578. /* PGROUP = 1 */
  579. /* ========== */
  580. /* NPDIR = 0 */
  581. /* -------- */
  582. /* The request time may precede the first time tag */
  583. /* of the segment, exceed the last time tag, or lie */
  584. /* in the closed interval bounded by these time tags. */
  585. /* NPDIR >= 1 */
  586. /* --------- */
  587. /* The request time may precede the first time tag */
  588. /* of the group but does not exceed the last epoch */
  589. /* of the group. */
  590. /* 1 < PGROUP <= NPDIR */
  591. /* =================== */
  592. /* The request time follows the last time of the */
  593. /* previous group and is less than or equal to */
  594. /* the pointing directory entry at index PGROUP. */
  595. /* 1 < PGROUP = NPDIR + 1 */
  596. /* ====================== */
  597. /* The request time follows the last time of the */
  598. /* last pointing directory entry. The request time */
  599. /* may exceed the last time tag. */
  600. /* Now we'll look up the time tags in the group of epochs */
  601. /* we've identified. */
  602. /* We'll use the variable names PBEGIX and PENDIX to refer to */
  603. /* the indices, relative to the set of time tags, of the first */
  604. /* and last time tags in the set we're going to look up. */
  605. if (pgroup == 1) {
  606. pbegix = 1;
  607. pendix = min(n,100);
  608. } else {
  609. /* If the group index is greater than 1, we'll include the last */
  610. /* time tag of the previous group in the set of time tags we look */
  611. /* up. That way, the request time is strictly bracketed on the */
  612. /* low side by the time tag set we look up. */
  613. pbegix = (pgroup - 1) * 100;
  614. /* Computing MIN */
  615. i__1 = pbegix + 100;
  616. pendix = min(i__1,n);
  617. }
  618. timbas = dirbas - n;
  619. i__1 = timbas + pbegix;
  620. i__2 = timbas + pendix;
  621. dafgda_(handle, &i__1, &i__2, pbuffr);
  622. npread = pendix - pbegix + 1;
  623. /* At this point, we'll deal with the cases where T lies outside */
  624. /* of the range of epochs we've buffered. */
  625. if (t < pbuffr[0]) {
  626. /* This can happen only if PGROUP = 1 and T precedes all epochs. */
  627. /* If the input request time is too far from PBUFFR(1) on */
  628. /* the low side, we're done. */
  629. if (*sclkdp + *tol < pbuffr[0]) {
  630. chkout_("CKR05", (ftnlen)5);
  631. return 0;
  632. }
  633. /* Bracket T to move it within the range of buffered epochs. */
  634. t = pbuffr[0];
  635. } else if (t > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 :
  636. s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)748)]) {
  637. /* This can happen only if T follows all epochs. */
  638. if (*sclkdp - *tol > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ?
  639. i__1 : s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)752)]) {
  640. chkout_("CKR05", (ftnlen)5);
  641. return 0;
  642. }
  643. /* Bracket T to move it within the range of buffered epochs. */
  644. t = pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
  645. "pbuffr", i__1, "ckr05_", (ftnlen)762)];
  646. }
  647. /* At this point, */
  648. /* | T - SCLKDP | <= TOL */
  649. /* Also, one of the following is true: */
  650. /* T is the first time of the segment */
  651. /* T is the last time of the segment */
  652. /* T equals SCLKDP */
  653. /* Find two adjacent time tags bounding the request epoch. The */
  654. /* request time cannot be greater than all of time tags in the */
  655. /* group, and it cannot precede the first element of the group. */
  656. i__ = lstltd_(&t, &npread, pbuffr);
  657. /* The variables LOW and HIGH are the indices of a pair of time */
  658. /* tags that bracket the request time. Remember that NPREAD could */
  659. /* be equal to 1, in which case we would have LOW = HIGH. */
  660. if (i__ == 0) {
  661. /* This can happen only if PGROUP = 1 and T = PBUFFR(1). */
  662. low = 1;
  663. lepoch = pbuffr[0];
  664. if (n == 1) {
  665. high = 1;
  666. } else {
  667. high = 2;
  668. }
  669. hepoch = pbuffr[(i__1 = high - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
  670. "pbuffr", i__1, "ckr05_", (ftnlen)805)];
  671. } else {
  672. low = pbegix + i__ - 1;
  673. lepoch = pbuffr[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
  674. "pbuffr", i__1, "ckr05_", (ftnlen)810)];
  675. high = low + 1;
  676. hepoch = pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbu"
  677. "ffr", i__1, "ckr05_", (ftnlen)813)];
  678. }
  679. /* We now need to find the interpolation interval containing */
  680. /* T, if any. We may be able to use the interpolation */
  681. /* interval found on the previous call to this routine. If */
  682. /* this is the first call or if the previous interval is not */
  683. /* applicable, we'll search for the interval. */
  684. /* First check if the request time falls in the same interval as */
  685. /* it did last time. We need to make sure that we are dealing */
  686. /* with the same segment as well as the same time range. */
  687. /* PREVS is the start time of the interval that satisfied */
  688. /* the previous request for pointing. */
  689. /* PREVN is the start time of the interval that followed */
  690. /* the interval specified above. */
  691. /* PREVNN is the start time of the interval that followed */
  692. /* the interval starting at PREVN. */
  693. /* LHAND is the handle of the file that PREVS and PREVN */
  694. /* were found in. */
  695. /* LBEG, are the beginning and ending addresses of the */
  696. /* LEND segment in the file LHAND that PREVS and PREVN */
  697. /* were found in. */
  698. if (*handle == lhand && begin == lbeg && end == lend && t >= prevs && t <
  699. prevn) {
  700. start = prevs;
  701. nstart = prevn;
  702. nnstrt = prevnn;
  703. } else {
  704. /* Search for the interpolation interval. */
  705. nidir = (nints - 1) / 100;
  706. dirbas = end - 5 - nidir;
  707. if (nidir == 0) {
  708. /* There's no mystery about which group of epochs to search. */
  709. sgroup = 1;
  710. } else {
  711. /* There's at least one directory. Find the first directory */
  712. /* whose time is greater than or equal to the request time, if */
  713. /* there is such a directory. We'll search linearly through */
  714. /* the directory entries, reading up to DIRSIZ of them at a */
  715. /* time. Having found the correct set of directory entries, */
  716. /* we'll perform a binary search within that set for the */
  717. /* desired entry. */
  718. bufbas = dirbas;
  719. nsread = min(nidir,100);
  720. remain = nidir - nsread;
  721. i__1 = bufbas + 1;
  722. i__2 = bufbas + nsread;
  723. dafgda_(handle, &i__1, &i__2, sbuffr);
  724. while(sbuffr[(i__1 = nsread - 1) < 103 && 0 <= i__1 ? i__1 :
  725. s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)885)] < t &&
  726. remain > 0) {
  727. bufbas += nsread;
  728. nsread = min(remain,100);
  729. remain -= nsread;
  730. /* Note: NSREAD is always > 0 here. */
  731. i__1 = bufbas + 1;
  732. i__2 = bufbas + nsread;
  733. dafgda_(handle, &i__1, &i__2, sbuffr);
  734. }
  735. /* At this point, BUFBAS - DIRBAS is the number of directory */
  736. /* entries preceding the one contained in SBUFFR(1). */
  737. /* SGROUP is one more than the number of directories we've */
  738. /* passed by. */
  739. sgroup = bufbas - dirbas + lstltd_(&t, &nsread, sbuffr) + 1;
  740. }
  741. /* SGROUP now indicates the set of interval start times in which */
  742. /* to search for the request epoch. */
  743. /* Now we'll look up the time tags in the group of epochs we've */
  744. /* identified. */
  745. /* We'll use the variable names SBEGIX and SENDIX to refer to the */
  746. /* indices, relative to the set of start times, of the first and */
  747. /* last start times in the set we're going to look up. */
  748. if (sgroup == 1) {
  749. sbegix = 1;
  750. sendix = min(nints,102);
  751. } else {
  752. /* Look up the start times for the group of interest. Also */
  753. /* buffer last start time from the previous group. Also, it */
  754. /* turns out to be useful to pick up two extra start */
  755. /* times---the first two start times of the next group---if */
  756. /* they exist. */
  757. sbegix = (sgroup - 1) * 100;
  758. /* Computing MIN */
  759. i__1 = sbegix + 102;
  760. sendix = min(i__1,nints);
  761. }
  762. timbas = dirbas - nints;
  763. i__1 = timbas + sbegix;
  764. i__2 = timbas + sendix;
  765. dafgda_(handle, &i__1, &i__2, sbuffr);
  766. nsread = sendix - sbegix + 1;
  767. /* Find the last interval start time less than or equal to the */
  768. /* request time. We know T is greater than or equal to the */
  769. /* first start time, so I will be > 0. */
  770. nsrch = min(101,nsread);
  771. i__ = lstled_(&t, &nsrch, sbuffr);
  772. start = sbuffr[(i__1 = i__ - 1) < 103 && 0 <= i__1 ? i__1 : s_rnge(
  773. "sbuffr", i__1, "ckr05_", (ftnlen)956)];
  774. /* Let NSTART ("next start") be the start time that follows */
  775. /* START, if START is not the last start time. If NSTART */
  776. /* has a successor, let NNSTRT be that start time. */
  777. if (i__ < nsread) {
  778. nstart = sbuffr[(i__1 = i__) < 103 && 0 <= i__1 ? i__1 : s_rnge(
  779. "sbuffr", i__1, "ckr05_", (ftnlen)965)];
  780. if (i__ + 1 < nsread) {
  781. nnstrt = sbuffr[(i__1 = i__ + 1) < 103 && 0 <= i__1 ? i__1 :
  782. s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)969)];
  783. } else {
  784. nnstrt = dpmax_();
  785. }
  786. } else {
  787. nstart = dpmax_();
  788. nnstrt = dpmax_();
  789. }
  790. }
  791. /* If T does not lie within the interpolation interval starting */
  792. /* at time START, we'll determine whether T is closer to this */
  793. /* interval or the next. If the distance between T and the */
  794. /* closer interval is less than or equal to TOL, we'll map T */
  795. /* to the closer endpoint of the closer interval. Otherwise, */
  796. /* we return without finding pointing. */
  797. if (hepoch == nstart) {
  798. /* The first time tag greater than or equal to T is the start */
  799. /* time of the next interpolation interval. */
  800. /* The request time lies between interpolation intervals. */
  801. /* LEPOCH is the last time tag of the first interval; HEPOCH */
  802. /* is the first time tag of the next interval. */
  803. if ((d__1 = t - lepoch, abs(d__1)) <= (d__2 = hepoch - t, abs(d__2)))
  804. {
  805. /* T is closer to the first interval... */
  806. if ((d__1 = t - lepoch, abs(d__1)) > *tol) {
  807. /* ...But T is too far from the interval. */
  808. chkout_("CKR05", (ftnlen)5);
  809. return 0;
  810. }
  811. /* Map T to the right endpoint of the preceding interval. */
  812. t = lepoch;
  813. high = low;
  814. hepoch = lepoch;
  815. } else {
  816. /* T is closer to the second interval... */
  817. if ((d__1 = hepoch - t, abs(d__1)) > *tol) {
  818. /* ...But T is too far from the interval. */
  819. chkout_("CKR05", (ftnlen)5);
  820. return 0;
  821. }
  822. /* Map T to the left endpoint of the next interval. */
  823. t = hepoch;
  824. low = high;
  825. lepoch = hepoch;
  826. /* Since we're going to be picking time tags from the next */
  827. /* interval, we'll need to adjust START and NSTART. */
  828. start = nstart;
  829. nstart = nnstrt;
  830. }
  831. }
  832. /* We now have */
  833. /* LEPOCH < T < HEPOCH */
  834. /* - - */
  835. /* where LEPOCH and HEPOCH are the time tags at indices */
  836. /* LOW and HIGH, respectively. */
  837. /* Now select the set of packets used for interpolation. Note */
  838. /* that the window size is known to be even. */
  839. /* Unlike CK types 8, 9, 12, and 13, for type 05 we adjust */
  840. /* the window size to keep the request time within the central */
  841. /* interval of the window. */
  842. /* The nominal bracketing epochs we've found are the (WNDSIZ/2)nd */
  843. /* and (WNDSIZ/2 + 1)st of the interpolating set. If the request */
  844. /* time is too close to one end of the interpolation interval, we */
  845. /* reduce the window size, after which one endpoint of the window */
  846. /* will coincide with an endpoint of the interpolation interval. */
  847. /* We start out by looking up the set of time tags we'd use */
  848. /* if there were no gaps in the coverage. We then trim our */
  849. /* time tag set to ensure all tags are in the interpolation */
  850. /* interval. It's possible that the interpolation window will */
  851. /* collapse to a single point as a result of this last step. */
  852. /* Let LSIZE be the size of the "left half" of the window: the */
  853. /* size of the set of window epochs to the left of the request time. */
  854. /* We want this size to be WNDSIZ/2, but if not enough states are */
  855. /* available, the set ranges from index 1 to index LOW. */
  856. /* Computing MIN */
  857. i__1 = wndsiz / 2;
  858. lsize = min(i__1,low);
  859. /* RSIZE is defined analogously for the right half of the window. */
  860. /* Computing MIN */
  861. i__1 = wndsiz / 2, i__2 = n - high + 1;
  862. rsize = min(i__1,i__2);
  863. /* The window size is simply the sum of LSIZE and RSIZE. */
  864. wndsiz = lsize + rsize;
  865. /* FIRST and LAST are the endpoints of the range of indices of */
  866. /* time tags (and packets) we'll collect in the output record. */
  867. first = low - lsize + 1;
  868. last = first + wndsiz - 1;
  869. /* Buffer the epochs. */
  870. wstart = begin + n * packsz + first - 1;
  871. i__1 = wstart + wndsiz - 1;
  872. dafgda_(handle, &wstart, &i__1, pbuffr);
  873. /* Discard any epochs less than START or greater than or equal */
  874. /* to NSTART. The set of epochs we want ranges from indices */
  875. /* I+1 to J. This range is non-empty unless START and NSTART */
  876. /* are both DPMAX(). */
  877. i__ = lstltd_(&start, &wndsiz, pbuffr);
  878. j = lstltd_(&nstart, &wndsiz, pbuffr);
  879. if (i__ == j) {
  880. /* Fuggedaboudit. */
  881. chkout_("CKR05", (ftnlen)5);
  882. return 0;
  883. }
  884. /* Update FIRST, LAST, and WNDSIZ. */
  885. wndsiz = j - i__;
  886. first += i__;
  887. last = first + wndsiz - 1;
  888. /* Put the subtype into the output record. The size of the group */
  889. /* of packets is derived from the subtype, so we need not include */
  890. /* the size. */
  891. record[0] = t;
  892. record[1] = (doublereal) subtyp;
  893. record[2] = (doublereal) wndsiz;
  894. record[3] = rate;
  895. /* Read the packets. */
  896. i__1 = begin + (first - 1) * packsz;
  897. i__2 = begin + last * packsz - 1;
  898. dafgda_(handle, &i__1, &i__2, &record[4]);
  899. /* Finally, add the epochs to the output record. */
  900. i__2 = j - i__;
  901. moved_(&pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbuffr",
  902. i__1, "ckr05_", (ftnlen)1158)], &i__2, &record[wndsiz * packsz +
  903. 4]);
  904. /* Save the information about the interval and segment. */
  905. lhand = *handle;
  906. lbeg = begin;
  907. lend = end;
  908. prevs = start;
  909. prevn = nstart;
  910. prevnn = nnstrt;
  911. /* Indicate pointing was found. */
  912. *found = TRUE_;
  913. chkout_("CKR05", (ftnlen)5);
  914. return 0;
  915. } /* ckr05_ */