1 /* ckgr04.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
6 #include "f2c.h"
7
8 /* Table of constant values */
9
10 static integer c__2 = 2;
11 static integer c__6 = 6;
12 static integer c__7 = 7;
13 static doublereal c_b15 = 128.;
14
15 /* $Procedure CKGR04 ( C-kernel, get record, type 04 ) */
ckgr04_(integer * handle,doublereal * descr,integer * recno,doublereal * record)16 /* Subroutine */ int ckgr04_(integer *handle, doublereal *descr, integer *
17 recno, doublereal *record)
18 {
19 /* System generated locals */
20 integer i__1;
21
22 /* Builtin functions */
23 integer s_rnge(char *, integer, char *, integer);
24
25 /* Local variables */
26 integer nrec, ends[1], k;
27 extern /* Subroutine */ int chkin_(char *, ftnlen), cknr04_(integer *,
28 doublereal *, integer *), dafus_(doublereal *, integer *, integer
29 *, doublereal *, integer *);
30 integer numall;
31 extern /* Subroutine */ int sigerr_(char *, ftnlen);
32 integer numcft[7];
33 extern /* Subroutine */ int chkout_(char *, ftnlen), sgfpkt_(integer *,
34 doublereal *, integer *, integer *, doublereal *, integer *),
35 setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen);
36 extern logical return_(void);
37 doublereal dcd[2];
38 integer icd[6];
39 extern /* Subroutine */ int zzck4d2i_(doublereal *, integer *, doublereal
40 *, integer *);
41
42 /* $ Abstract */
43
44 /* Given the handle and descriptor of a type 4 segment in */
45 /* a CK file, return a specified pointing record from that */
46 /* segment. */
47
48 /* $ Disclaimer */
49
50 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
51 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
52 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
53 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
54 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
55 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
56 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
57 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
58 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
59 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
60
61 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
62 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
63 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
64 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
65 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
66 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
67
68 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
69 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
70 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
71 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
72
73 /* $ Required_Reading */
74
75 /* CK */
76 /* DAF */
77
78 /* $ Keywords */
79
80 /* POINTING */
81
82 /* $ Declarations */
83 /* $ Abstract */
84
85 /* Declarations of the CK data type specific and general CK low */
86 /* level routine parameters. */
87
88 /* $ Disclaimer */
89
90 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
91 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
92 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
93 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
94 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
95 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
96 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
97 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
98 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
99 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
100
101 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
102 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
103 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
104 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
105 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
106 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
107
108 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
109 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
110 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
111 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
112
113 /* $ Required_Reading */
114
115 /* CK.REQ */
116
117 /* $ Keywords */
118
119 /* CK */
120
121 /* $ Restrictions */
122
123 /* 1) If new CK types are added, the size of the record passed */
124 /* between CKRxx and CKExx must be registered as separate */
125 /* parameter. If this size will be greater than current value */
126 /* of the CKMRSZ parameter (which specifies the maximum record */
127 /* size for the record buffer used inside CKPFS) then it should */
128 /* be assigned to CKMRSZ as a new value. */
129
130 /* $ Author_and_Institution */
131
132 /* N.J. Bachman (JPL) */
133 /* B.V. Semenov (JPL) */
134
135 /* $ Literature_References */
136
137 /* CK Required Reading. */
138
139 /* $ Version */
140
141 /* - SPICELIB Version 3.0.0, 27-JAN-2014 (NJB) */
142
143 /* Updated to support CK type 6. Maximum degree for */
144 /* type 5 was updated to be consistent with the */
145 /* maximum degree for type 6. */
146
147 /* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
148
149 /* Updated to support CK type 5. */
150
151 /* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
152
153 /* -& */
154
155 /* Number of quaternion components and number of quaternion and */
156 /* angular rate components together. */
157
158
159 /* CK Type 1 parameters: */
160
161 /* CK1DTP CK data type 1 ID; */
162
163 /* CK1RSZ maximum size of a record passed between CKR01 */
164 /* and CKE01. */
165
166
167 /* CK Type 2 parameters: */
168
169 /* CK2DTP CK data type 2 ID; */
170
171 /* CK2RSZ maximum size of a record passed between CKR02 */
172 /* and CKE02. */
173
174
175 /* CK Type 3 parameters: */
176
177 /* CK3DTP CK data type 3 ID; */
178
179 /* CK3RSZ maximum size of a record passed between CKR03 */
180 /* and CKE03. */
181
182
183 /* CK Type 4 parameters: */
184
185 /* CK4DTP CK data type 4 ID; */
186
187 /* CK4PCD parameter defining integer to DP packing schema that */
188 /* is applied when seven number integer array containing */
189 /* polynomial degrees for quaternion and angular rate */
190 /* components packed into a single DP number stored in */
191 /* actual CK records in a file; the value of must not be */
192 /* changed or compatibility with existing type 4 CK files */
193 /* will be lost. */
194
195 /* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
196 /* records; the value of this parameter must never exceed */
197 /* value of the CK4PCD; */
198
199 /* CK4SFT number of additional DPs, which are not polynomial */
200 /* coefficients, located at the beginning of a type 4 */
201 /* CK record that passed between routines CKR04 and CKE04; */
202
203 /* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
204 /* and CKE04; CK4RSZ is computed as follows: */
205
206 /* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
207
208
209 /* CK Type 5 parameters: */
210
211
212 /* CK5DTP CK data type 5 ID; */
213
214 /* CK5MXD maximum polynomial degree allowed in type 5 */
215 /* records. */
216
217 /* CK5MET number of additional DPs, which are not polynomial */
218 /* coefficients, located at the beginning of a type 5 */
219 /* CK record that passed between routines CKR05 and CKE05; */
220
221 /* CK5MXP maximum packet size for any subtype. Subtype 2 */
222 /* has the greatest packet size, since these packets */
223 /* contain a quaternion, its derivative, an angular */
224 /* velocity vector, and its derivative. See ck05.inc */
225 /* for a description of the subtypes. */
226
227 /* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
228 /* and CKE05; CK5RSZ is computed as follows: */
229
230 /* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
231
232
233 /* CK Type 6 parameters: */
234
235
236 /* CK6DTP CK data type 6 ID; */
237
238 /* CK6MXD maximum polynomial degree allowed in type 6 */
239 /* records. */
240
241 /* CK6MET number of additional DPs, which are not polynomial */
242 /* coefficients, located at the beginning of a type 6 */
243 /* CK record that passed between routines CKR06 and CKE06; */
244
245 /* CK6MXP maximum packet size for any subtype. Subtype 2 */
246 /* has the greatest packet size, since these packets */
247 /* contain a quaternion, its derivative, an angular */
248 /* velocity vector, and its derivative. See ck06.inc */
249 /* for a description of the subtypes. */
250
251 /* CK6RSZ maximum size of type 6 CK record passed between CKR06 */
252 /* and CKE06; CK6RSZ is computed as follows: */
253
254 /* CK6RSZ = CK6MET + ( CK6MXD + 1 ) * ( CK6PS3 + 1 ) */
255
256 /* where CK6PS3 is equal to the parameter CK06PS3 defined */
257 /* in ck06.inc. Note that the subtype having the largest */
258 /* packet size (subtype 2) does not give rise to the */
259 /* largest record size, because that type is Hermite and */
260 /* requires half the window size used by subtype 3 for a */
261 /* given polynomial degree. */
262
263
264 /* The parameter CK6PS3 must be in sync with C06PS3 defined in */
265 /* ck06.inc. */
266
267
268
269 /* Maximum record size that can be handled by CKPFS. This value */
270 /* must be set to the maximum of all CKxRSZ parameters (currently */
271 /* CK5RSZ.) */
272
273 /* $ Brief_I/O */
274
275 /* Variable I/O Description */
276 /* -------- --- -------------------------------------------------- */
277 /* HANDLE I The handle of the file containing the segment. */
278 /* DESCR I The segment descriptor. */
279 /* RECNO I The number of the pointing record to be returned. */
280 /* RECORD O The pointing record. */
281
282 /* $ Detailed_Input */
283
284 /* HANDLE is the handle of the binary CK file containing the */
285 /* desired segment. The file should have been opened */
286 /* for read or write access, either by CKLPF, DAFOPR, */
287 /* or DAFOPW. */
288
289 /* DESCR is the packed descriptor of the data type 4 segment. */
290
291 /* RECNO is the number of the pointing record to be returned */
292 /* from the data type 4 segment. */
293
294 /* $ Detailed_Output */
295
296 /* RECORD is the pointing record indexed by RECNO in the */
297 /* segment. The contents of the record are as follows: */
298
299 /* --------------------------------------------------- */
300 /* | The midpoint of the approximation interval | */
301 /* --------------------------------------------------- */
302 /* | The radius of the approximation interval | */
303 /* --------------------------------------------------- */
304 /* | Number of coefficients for q0 | */
305 /* --------------------------------------------------- */
306 /* | Number of coefficients for q1 | */
307 /* --------------------------------------------------- */
308 /* | Number of coefficients for q2 | */
309 /* --------------------------------------------------- */
310 /* | Number of coefficients for q3 | */
311 /* --------------------------------------------------- */
312 /* | Number of coefficients for AV1 | */
313 /* --------------------------------------------------- */
314 /* | Number of coefficients for AV2 | */
315 /* --------------------------------------------------- */
316 /* | Number of coefficients for AV3 | */
317 /* --------------------------------------------------- */
318 /* | q0 Cheby coefficients | */
319 /* --------------------------------------------------- */
320 /* | q1 Cheby coefficients | */
321 /* --------------------------------------------------- */
322 /* | q2 Cheby coefficients | */
323 /* --------------------------------------------------- */
324 /* | q3 Cheby coefficients | */
325 /* --------------------------------------------------- */
326 /* | AV1 Cheby coefficients (optional) | */
327 /* --------------------------------------------------- */
328 /* | AV2 Cheby coefficients (optional) | */
329 /* --------------------------------------------------- */
330 /* | AV3 Cheby coefficients (optional) | */
331 /* --------------------------------------------------- */
332
333 /* $ Parameters */
334
335 /* See 'ckparam.inc'. */
336
337 /* $ Exceptions */
338
339 /* 1) If the segment is not of data type 4, the error */
340 /* SPICE(CKWRONGDATATYPE) is signalled. */
341
342 /* 2) If RECNO is less than one or greater than the number of */
343 /* records in the specified segment, the error */
344 /* SPICE(CKNONEXISTREC) is signalled. */
345
346 /* 3) If the specified handle does not belong to any DAF file that */
347 /* is currently known to be open, an error is diagnosed by a */
348 /* routine that this routine calls. */
349
350 /* 4) If DESCR is not a valid descriptor of a segment in the CK */
351 /* file specified by HANDLE, the results of this routine are */
352 /* unpredictable. */
353
354 /* $ Files */
355
356 /* The file specified by HANDLE should be open for read or */
357 /* write access. */
358
359 /* $ Particulars */
360
361 /* For a detailed description of the structure of a type 4 segment, */
362 /* see the CK required reading. */
363
364 /* This is a utility routine that may be used to read the individual */
365 /* pointing records that make up a type 4 segment. It is normally */
366 /* used in conjunction with CKNR04, which gives the number of */
367 /* pointing records stored in a segment. */
368
369 /* $ Examples */
370
371 /* Suppose that DATA.BC is a CK file that contains segments of */
372 /* data type 4. Then the following code fragment extracts the */
373 /* data packets contained in the segment. */
374
375 /* C */
376 /* C CK parameters include file. */
377 /* C */
378 /* INCLUDE 'ckparam.inc' */
379 /* C */
380 /* C Declarations. */
381 /* C */
382 /* DOUBLE PRECISION DCD ( 2 ) */
383 /* DOUBLE PRECISION DESCR ( 5 ) */
384 /* DOUBLE PRECISION PKTDAT ( CK4RSZ ) */
385
386 /* INTEGER AVFLAG */
387 /* INTEGER HANDLE */
388 /* INTEGER I */
389 /* INTEGER ICD ( 6 ) */
390 /* INTEGER K */
391 /* INTEGER LASTAD */
392 /* INTEGER NCOEF ( QAVSIZ ) */
393 /* INTEGER NREC */
394
395 /* LOGICAL FOUND */
396 /* C */
397 /* C First load the file. (The file may also be opened by using */
398 /* C CKLPF.) */
399 /* C */
400 /* CALL DAFOPR ( 'DATA.BC', HANDLE ) */
401 /* C */
402 /* C Begin forward search. Find the first array. */
403 /* C */
404 /* CALL DAFBFS ( HANDLE ) */
405 /* CALL DAFFNA ( FOUND ) */
406 /* C */
407 /* C Get segment descriptor. */
408 /* C */
409 /* CALL DAFGS ( DESCR ) */
410 /* C */
411 /* C Unpack the segment descriptor into its double precision */
412 /* C and integer components. */
413 /* C */
414 /* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
415
416 /* IF ( ICD( 3 ) .EQ. 4 ) THEN */
417 /* C */
418 /* C How many records does this segment contain? */
419 /* C */
420 /* CALL CKNR04 ( HANDLE, DESCR, NREC ) */
421
422 /* DO I = 1, NREC */
423 /* C */
424 /* C Get the data records stored in the segment. */
425 /* C */
426 /* CALL CKGR04 ( HANDLE, DESCR, I, PKTDAT ) */
427 /* C */
428 /* C Print data packet contents. Print coverage interval */
429 /* C midpoint & radii first. */
430 /* C */
431 /* WRITE (2,*) PKTDAT (1) */
432 /* WRITE (2,*) PKTDAT (2) */
433 /* C */
434 /* C Decode numbers of coefficients. */
435 /* C */
436 /* CALL ZZCK4D2I ( PKTDAT(3), QAVSIZ, CK4PCD, NCOEF ) */
437 /* C */
438 /* C Print number of coefficients for Q0, Q1, Q2 and Q3. */
439 /* C */
440 /* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 1 ), NCOEF( 2 ) */
441 /* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 3 ), NCOEF( 4 ) */
442 /* C */
443 /* C Print number coefficients for AV1, AV2 and AV3. */
444 /* C */
445 /* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 5 ), NCOEF( 6 ) */
446 /* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 7 ) */
447 /* C */
448 /* C Print Cheby coefficients. */
449 /* C */
450 /* LASTAD = 0 */
451
452 /* DO K = 1, QAVSIZ */
453 /* LASTAD = LASTAD + NCOEF( K ) */
454 /* END DO */
455
456 /* DO K = 4, LASTAD + 4 */
457 /* WRITE (2,*) PKTDAT (K) */
458 /* END DO */
459
460 /* END DO */
461
462 /* END IF */
463
464 /* $ Restrictions */
465
466 /* 1) The binary CK file containing the segment whose descriptor */
467 /* was passed to this routine must be opened for read or write */
468 /* access by either CKLPF, DAFOPR, or DAFOPW. */
469
470 /* $ Literature_References */
471
472 /* None. */
473
474 /* $ Author_and_Institution */
475
476 /* Y.K. Zaiko (JPL) */
477 /* B.V. Semenov (JPL) */
478
479 /* $ Version */
480
481 /* - SPICELIB Version 1.0.1, 18-APR-2014 (BVS) */
482
483 /* Minor header edits. */
484
485 /* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */
486
487 /* -& */
488 /* $ Index_Entries */
489
490 /* get CK type_4 record */
491
492 /* -& */
493
494 /* SPICELIB functions */
495
496
497 /* Local parameters */
498
499
500 /* Length (in DPs) of non-coefficient front part of RECORD when */
501 /* it contains decoded numbers of coefficients. It is one less */
502 /* than the length of the same part in a record exchanged between */
503 /* CKR04 and CKE04 because it doesn't contain time at which */
504 /* pointing has to be evaluated. */
505
506
507 /* Local variables */
508
509
510 /* Standard SPICE error handling. */
511
512 if (return_()) {
513 return 0;
514 } else {
515 chkin_("CKGR04", (ftnlen)6);
516 }
517
518 /* Unpack descriptor and check segment data type. Signal an error */
519 /* if it's not 4. */
520
521 dafus_(descr, &c__2, &c__6, dcd, icd);
522 if (icd[2] != 4) {
523 setmsg_("Data type of the segment should be 4: Passed descriptor sh"
524 "ows type = #.", (ftnlen)72);
525 errint_("#", &icd[2], (ftnlen)1);
526 sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22);
527 chkout_("CKGR04", (ftnlen)6);
528 return 0;
529 }
530
531 /* If a request was made for a data record which doesn't */
532 /* exist, then signal an error and leave. */
533
534 cknr04_(handle, descr, &nrec);
535 if (*recno < 1 || *recno > nrec) {
536 setmsg_("Requested record number (#) does not exist. There are # rec"
537 "ords in the segment.", (ftnlen)79);
538 errint_("#", recno, (ftnlen)1);
539 errint_("#", &nrec, (ftnlen)1);
540 sigerr_("SPICE(CKNONEXISTREC)", (ftnlen)20);
541 chkout_("CKGR04", (ftnlen)6);
542 return 0;
543 }
544
545 /* Get the data record indexed by RECNO. */
546
547 sgfpkt_(handle, descr, recno, recno, record, ends);
548
549 /* Decode 7 numbers of coefficients from double precision value. */
550
551 zzck4d2i_(&record[2], &c__7, &c_b15, numcft);
552
553 /* Compute total number of coefficients in the fetched packet. */
554
555 numall = 0;
556 for (k = 1; k <= 7; ++k) {
557 numall += numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge(
558 "numcft", i__1, "ckgr04_", (ftnlen)369)];
559 }
560
561 /* Move polynomial coefficients to the right to free space for */
562 /* decoded numbers of coefficients and insert these numbers */
563 /* starting from the third position. */
564
565 for (k = numall; k >= 1; --k) {
566 record[k + 8] = record[k + 2];
567 }
568 for (k = 1; k <= 7; ++k) {
569 record[k + 1] = (doublereal) numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ?
570 i__1 : s_rnge("numcft", i__1, "ckgr04_", (ftnlen)382)];
571 }
572
573 /* All done. */
574
575 chkout_("CKGR04", (ftnlen)6);
576 return 0;
577 } /* ckgr04_ */
578
579