1 /* zzekrd05.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
12 /* $Procedure ZZEKRD05 ( EK, read class 5 column entry elements ) */
zzekrd05_(integer * handle,integer * segdsc,integer * coldsc,integer * recptr,integer * beg,integer * end,doublereal * dvals,logical * isnull,logical * found)13 /* Subroutine */ int zzekrd05_(integer *handle, integer *segdsc, integer *
14 coldsc, integer *recptr, integer *beg, integer *end, doublereal *
15 dvals, logical *isnull, logical *found)
16 {
17 /* System generated locals */
18 integer i__1, i__2;
19
20 /* Builtin functions */
21 integer i_dnnt(doublereal *);
22
23 /* Local variables */
24 integer base, nelt;
25 extern integer zzekrp2n_(integer *, integer *, integer *);
26 extern /* Subroutine */ int zzekgfwd_(integer *, integer *, integer *,
27 integer *), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_(
28 integer *, integer *, integer *, integer *);
29 integer p, nread;
30 extern /* Subroutine */ int chkin_(char *, ftnlen);
31 integer recno, ncols, ptemp, start;
32 extern logical failed_(void);
33 extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *,
34 doublereal *), dasrdi_(integer *, integer *, integer *, integer *)
35 ;
36 integer remain;
37 doublereal dpnelt;
38 integer colidx, datptr, maxidx, minidx, ptrloc;
39 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
40 integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
41 ftnlen), errhan_(char *, integer *, ftnlen);
42
43 /* $ Abstract */
44
45 /* Read a specified element range from a column entry in a specified */
46 /* record in a class 5 column. Class 5 columns have d.p. arrays */
47 /* as column entries. */
48
49 /* $ Disclaimer */
50
51 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
52 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
53 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
54 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
55 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
56 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
57 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
58 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
59 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
60 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
61
62 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
63 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
64 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
65 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
66 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
67 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
68
69 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
70 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
71 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
72 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
73
74 /* $ Required_Reading */
75
76 /* EK */
77
78 /* $ Keywords */
79
80 /* EK */
81 /* PRIVATE */
82
83 /* $ Declarations */
84 /* $ Disclaimer */
85
86 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
87 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
88 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
89 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
90 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
91 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
92 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
93 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
94 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
95 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
96
97 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
98 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
99 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
100 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
101 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
102 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
103
104 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
105 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
106 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
107 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
108
109
110 /* Include Section: EK Column Descriptor Parameters */
111
112 /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
113
114
115 /* Note: The column descriptor size parameter CDSCSZ is */
116 /* declared separately in the include section CDSIZE$INC.FOR. */
117
118 /* Offset of column descriptors, relative to start of segment */
119 /* integer address range. This number, when added to the last */
120 /* integer address preceding the segment, yields the DAS integer */
121 /* base address of the first column descriptor. Currently, this */
122 /* offset is exactly the size of a segment descriptor. The */
123 /* parameter SDSCSZ, which defines the size of a segment descriptor, */
124 /* is declared in the include file eksegdsc.inc. */
125
126
127 /* Size of column descriptor */
128
129
130 /* Indices of various pieces of column descriptors: */
131
132
133 /* CLSIDX is the index of the column's class code. (We use the */
134 /* word `class' to distinguish this item from the column's data */
135 /* type.) */
136
137
138 /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
139 /* or TIME). The type is actually implied by the class, but it */
140 /* will frequently be convenient to look up the type directly. */
141
142
143
144 /* LENIDX is the index of the column's string length value, if the */
145 /* column has character type. A value of IFALSE in this element of */
146 /* the descriptor indicates that the strings have variable length. */
147
148
149 /* SIZIDX is the index of the column's element size value. This */
150 /* descriptor element is meaningful for columns with fixed-size */
151 /* entries. For variable-sized columns, this value is IFALSE. */
152
153
154 /* NAMIDX is the index of the base address of the column's name. */
155
156
157 /* IXTIDX is the data type of the column's index. IXTIDX */
158 /* contains a type value only if the column is indexed. For columns */
159 /* that are not indexed, the location IXTIDX contains the boolean */
160 /* value IFALSE. */
161
162
163 /* IXPIDX is a pointer to the column's index. IXTPDX contains a */
164 /* meaningful value only if the column is indexed. The */
165 /* interpretation of the pointer depends on the data type of the */
166 /* index. */
167
168
169 /* NFLIDX is the index of a flag indicating whether nulls are */
170 /* permitted in the column. The value at location NFLIDX is */
171 /* ITRUE if nulls are permitted and IFALSE otherwise. */
172
173
174 /* ORDIDX is the index of the column's ordinal position in the */
175 /* list of columns belonging to the column's parent segment. */
176
177
178 /* METIDX is the index of the column's integer metadata pointer. */
179 /* This pointer is a DAS integer address. */
180
181
182 /* The last position in the column descriptor is reserved. No */
183 /* parameter is defined to point to this location. */
184
185
186 /* End Include Section: EK Column Descriptor Parameters */
187
188 /* $ Disclaimer */
189
190 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
191 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
192 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
193 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
194 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
195 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
196 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
197 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
198 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
199 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
200
201 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
202 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
203 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
204 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
205 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
206 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
207
208 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
209 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
210 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
211 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
212
213
214 /* Include Section: EK Data Page Parameters */
215
216 /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */
217
218 /* These parameters apply to EK files using architecture 4. */
219 /* These files use a paged DAS file as their underlying file */
220 /* structure. */
221
222 /* In paged DAS EK files, data pages are structured: they contain */
223 /* metadata as well as data. The metadata is located in the last */
224 /* few addresses of each page, so as to interfere as little as */
225 /* possible with calculation of data addresses. */
226
227 /* Each data page belongs to exactly one segment. Some bookkeeping */
228 /* information, such as record pointers, is also stored in data */
229 /* pages. */
230
231 /* Each page contains a forward pointer that allows rapid lookup */
232 /* of data items that span multiple pages. Each page also keeps */
233 /* track of the current number of links from its parent segment */
234 /* to the page. Link counts enable pages to `know' when they */
235 /* are no longer in use by a segment; unused pages are deallocated */
236 /* and returned to the free list. */
237
238 /* The parameters in this include file depend on the parameters */
239 /* declared in the include file ekpage.inc. If those parameters */
240 /* change, this file must be updated. The specified parameter */
241 /* declarations we need from that file are: */
242
243 /* INTEGER PGSIZC */
244 /* PARAMETER ( PGSIZC = 1024 ) */
245
246 /* INTEGER PGSIZD */
247 /* PARAMETER ( PGSIZD = 128 ) */
248
249 /* INTEGER PGSIZI */
250 /* PARAMETER ( PGSIZI = 256 ) */
251
252
253
254 /* Character pages use an encoding mechanism to represent integer */
255 /* metadata. Each integer is encoded in five consecutive */
256 /* characters. */
257
258
259 /* Character data page parameters: */
260
261
262 /* Size of encoded integer: */
263
264
265 /* Usable page size: */
266
267
268 /* Location of character forward pointer: */
269
270
271 /* Location of character link count: */
272
273
274 /* Double precision data page parameters: */
275
276 /* Usable page size: */
277
278
279 /* Location of d.p. forward pointer: */
280
281
282 /* Location of d.p. link count: */
283
284
285 /* Integer data page parameters: */
286
287 /* Usable page size: */
288
289
290 /* Location of integer forward pointer: */
291
292
293 /* Location of integer link count: */
294
295
296 /* End Include Section: EK Data Page Parameters */
297
298 /* $ Disclaimer */
299
300 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
301 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
302 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
303 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
304 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
305 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
306 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
307 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
308 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
309 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
310
311 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
312 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
313 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
314 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
315 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
316 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
317
318 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
319 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
320 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
321 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
322
323
324 /* Include Section: EK Record Pointer Parameters */
325
326 /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */
327
328
329 /* This file declares parameters used in EK record pointers. */
330 /* Each segment references data in a given record via two levels */
331 /* of indirection: a record number points to a record pointer, */
332 /* which is a structured array of metadata and data pointers. */
333
334 /* Record pointers always occupy contiguous ranges of integer */
335 /* addresses. */
336
337 /* The parameter declarations in this file depend on the assumption */
338 /* that integer pages contain 256 DAS integer words and that the */
339 /* maximum number of columns in a segment is 100. Record pointers */
340 /* are stored in integer data pages, so they must fit within the */
341 /* usable data area afforded by these pages. The size of the usable */
342 /* data area is given by the parameter IPSIZE which is declared in */
343 /* ekdatpag.inc. The assumed value of IPSIZE is 254. */
344
345
346 /* The first element of each record pointer is a status indicator. */
347 /* The meanings of status indicators depend on whether the parent EK */
348 /* is shadowed or not. For shadowed EKs, allowed status values and */
349 /* their meanings are: */
350
351 /* OLD The record has not been modified since */
352 /* the EK containing the record was opened. */
353
354 /* UPDATE The record is an update of a previously existing */
355 /* record. The original record is now on the */
356 /* modified record list. */
357
358 /* NEW The record has been added since the EK containing the */
359 /* record was opened. The record is not an update */
360 /* of a previously existing record. */
361
362 /* DELOLD This status applies only to a backup record. */
363 /* DELOLD status indicates that the record corresponds */
364 /* to a deleted OLD record in the source segment. */
365
366 /* DELNEW This status applies only to a backup record. */
367 /* DELNEW status indicates that the record corresponds */
368 /* to a deleted NEW record in the source segment. */
369
370 /* DELUPD This status applies only to a backup record. */
371 /* DELUPD status indicates that the record corresponds */
372 /* to a deleted UPDATEd record in the source segment. */
373
374 /* In EKs that are not shadowed, all records have status OLD. */
375
376
377
378 /* The following parameters refer to indices within the record */
379 /* pointer structure: */
380
381 /* Index of status indicator: */
382
383
384 /* Each record pointer contains a pointer to its companion: for a */
385 /* record belonging to a shadowed EK, this is the backup counterpart, */
386 /* or if the parent EK is itself a backup EK, a pointer to the */
387 /* record's source record. The pointer is UNINIT (see below) if the */
388 /* record is unmodified. */
389
390 /* Record companion pointers contain record numbers, not record */
391 /* base addresses. */
392
393 /* Index of record's companion pointer: */
394
395
396 /* Each data item is referenced by an integer. The meaning of */
397 /* this integer depends on the representation of data in the */
398 /* column to which the data item belongs. Actual lookup of a */
399 /* data item must be done by subroutines appropriate to the class of */
400 /* the column to which the item belongs. Note that data items don't */
401 /* necessarily occupy contiguous ranges of DAS addresses. */
402
403 /* Base address of data pointers: */
404
405
406 /* Maximum record pointer size: */
407
408
409 /* Data pointers are given the value UNINIT to start with; this */
410 /* indicates that the data item is uninitialized. UNINIT is */
411 /* distinct from the value NULL. NOBACK indicates an uninitialized */
412 /* backup column entry. */
413
414
415 /* End Include Section: EK Record Pointer Parameters */
416
417 /* $ Disclaimer */
418
419 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
420 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
421 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
422 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
423 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
424 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
425 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
426 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
427 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
428 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
429
430 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
431 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
432 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
433 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
434 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
435 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
436
437 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
438 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
439 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
440 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
441
442
443 /* Include Section: EK Segment Descriptor Parameters */
444
445 /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
446
447
448 /* All `base addresses' referred to below are the addresses */
449 /* *preceding* the item the base applies to. This convention */
450 /* enables simplied address calculations in many cases. */
451
452 /* Size of segment descriptor. Note: the include file ekcoldsc.inc */
453 /* must be updated if this parameter is changed. The parameter */
454 /* CDOFF in that file should be kept equal to SDSCSZ. */
455
456
457 /* Index of the segment type code: */
458
459
460 /* Index of the segment's number. This number is the segment's */
461 /* index in the list of segments contained in the EK to which */
462 /* the segment belongs. */
463
464
465 /* Index of the DAS integer base address of the segment's integer */
466 /* meta-data: */
467
468
469 /* Index of the DAS character base address of the table name: */
470
471
472 /* Index of the segment's column count: */
473
474
475 /* Index of the segment's record count: */
476
477
478 /* Index of the root page number of the record tree: */
479
480
481 /* Index of the root page number of the character data page tree: */
482
483
484 /* Index of the root page number of the double precision data page */
485 /* tree: */
486
487
488 /* Index of the root page number of the integer data page tree: */
489
490
491 /* Index of the `modified' flag: */
492
493
494 /* Index of the `initialized' flag: */
495
496
497 /* Index of the shadowing flag: */
498
499
500 /* Index of the companion file handle: */
501
502
503 /* Index of the companion segment number: */
504
505
506 /* The next three items are, respectively, the page numbers of the */
507 /* last character, d.p., and integer data pages allocated by the */
508 /* segment: */
509
510
511 /* The next three items are, respectively, the page-relative */
512 /* indices of the last DAS word in use in the segment's */
513 /* last character, d.p., and integer data pages: */
514
515
516 /* Index of the DAS character base address of the column name list: */
517
518
519 /* The last descriptor element is reserved for future use. No */
520 /* parameter is defined to point to this location. */
521
522
523 /* End Include Section: EK Segment Descriptor Parameters */
524
525 /* $ Disclaimer */
526
527 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
528 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
529 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
530 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
531 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
532 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
533 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
534 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
535 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
536 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
537
538 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
539 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
540 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
541 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
542 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
543 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
544
545 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
546 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
547 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
548 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
549
550
551 /* Include Section: EK Data Types */
552
553 /* ektype.inc Version 1 27-DEC-1994 (NJB) */
554
555
556 /* Within the EK system, data types of EK column contents are */
557 /* represented by integer codes. The codes and their meanings */
558 /* are listed below. */
559
560 /* Integer codes are also used within the DAS system to indicate */
561 /* data types; the EK system makes no assumptions about compatibility */
562 /* between the codes used here and those used in the DAS system. */
563
564
565 /* Character type: */
566
567
568 /* Double precision type: */
569
570
571 /* Integer type: */
572
573
574 /* `Time' type: */
575
576 /* Within the EK system, time values are represented as ephemeris */
577 /* seconds past J2000 (TDB), and double precision numbers are used */
578 /* to store these values. However, since time values require special */
579 /* treatment both on input and output, and since the `TIME' column */
580 /* has a special role in the EK specification and code, time values */
581 /* are identified as a type distinct from double precision numbers. */
582
583
584 /* End Include Section: EK Data Types */
585
586 /* $ Brief_I/O */
587
588 /* Variable I/O Description */
589 /* -------- --- -------------------------------------------------- */
590 /* HANDLE I Handle attached to EK file. */
591 /* SEGDSC I Segment descriptor. */
592 /* COLDSC I Column descriptor. */
593 /* RECPTR I Record pointer. */
594 /* BEG I Start element index. */
595 /* END I End element index. */
596 /* DVALS O Double precision values in column entry. */
597 /* ISNULL O Flag indicating whether column entry is null. */
598 /* FOUND O Flag indicating whether elements were found. */
599
600 /* $ Detailed_Input */
601
602 /* HANDLE is an EK file handle. */
603
604 /* SEGDSC is the descriptor of the segment from which data is */
605 /* to be read. */
606
607 /* COLDSC is the descriptor of the column from which data is */
608 /* to be read. */
609
610 /* RECPTR is a pointer to the record containing the column */
611 /* entry to be written. */
612
613 /* BEG, */
614 /* END are, respectively, the start and end indices of */
615 /* the contiguous range of elements to be read from */
616 /* the specified column entry. */
617
618 /* $ Detailed_Output */
619
620 /* DVALS are the values read from the specified column */
621 /* entry. The mapping of elements of the column entry */
622 /* to elements of DVALS is as shown below: */
623
624 /* Column entry element DVALS element */
625 /* -------------------- ------------- */
626 /* BEG 1 */
627 /* BEG+1 2 */
628 /* . . */
629 /* . . */
630 /* . . */
631 /* END END-BEG+1 */
632
633 /* DVALS is valid only if the output argument */
634 /* FOUND is returned .TRUE. */
635
636 /* ISNULL is a logical flag indicating whether the entry is */
637 /* null. ISNULL is set on output whether or not */
638 /* the range of elements designated by BEG and END */
639 /* exists. */
640
641 /* FOUND is a logical flag indicating whether the range */
642 /* of elements designated by BEG and END exists. */
643 /* If the number of elements in the specified column */
644 /* entry is not at least END, FOUND will be returned */
645 /* .FALSE. */
646
647 /* $ Parameters */
648
649 /* None. */
650
651 /* $ Exceptions */
652
653 /* 1) If HANDLE is invalid, the error will be diagnosed by routines */
654 /* called by this routine. */
655
656 /* 2) If the specified column entry has not been initialized, the */
657 /* error SPICE(UNINITIALIZEDVALUE) is signaled. */
658
659 /* 3) If the ordinal position of the column specified by COLDSC */
660 /* is out of range, the error SPICE(INVALIDINDEX) is signaled. */
661
662 /* 4) If an I/O error occurs while reading the indicated file, */
663 /* the error will be diagnosed by routines called by this */
664 /* routine. */
665
666 /* $ Files */
667
668 /* See the EK Required Reading for a discussion of the EK file */
669 /* format. */
670
671 /* $ Particulars */
672
673 /* This routine is a utility for reading data from class 5 columns. */
674
675 /* $ Examples */
676
677 /* See EKRCED. */
678
679 /* $ Restrictions */
680
681 /* None. */
682
683 /* $ Literature_References */
684
685 /* None. */
686
687 /* $ Author_and_Institution */
688
689 /* N.J. Bachman (JPL) */
690
691 /* $ Version */
692
693 /* - SPICELIB Version 1.2.0, 07-FEB-2015 (NJB) */
694
695 /* Now uses ERRHAN to insert DAS file name into */
696 /* long error messages. */
697
698 /* Bug fix: changed max column index in long error */
699 /* message from NREC to NCOLS. */
700
701 /* - SPICELIB Version 1.1.0, 12-SEP-2005 (NJB) */
702
703 /* Updated to remove non-standard use of duplicate arguments */
704 /* in ZZEKGFWD calls. */
705
706 /* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */
707
708 /* -& */
709 /* $ Revisions */
710
711 /* - SPICELIB Version 1.1.0, 12-SEP-2005 (NJB) */
712
713 /* Updated to remove non-standard use of duplicate arguments */
714 /* in ZZEKGFWD calls. */
715
716 /* -& */
717
718 /* SPICELIB functions */
719
720
721 /* Non-SPICELIB functions */
722
723
724 /* Local variables */
725
726
727 /* Use discovery check-in. */
728
729
730 /* Make sure the column exists. */
731
732 ncols = segdsc[4];
733 colidx = coldsc[8];
734 if (colidx < 1 || colidx > ncols) {
735 chkin_("ZZEKRD05", (ftnlen)8);
736 setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37);
737 errint_("#", &colidx, (ftnlen)1);
738 errint_("#", &ncols, (ftnlen)1);
739 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
740 chkout_("ZZEKRD05", (ftnlen)8);
741 return 0;
742 }
743
744 /* Compute the data pointer location, and read the pointer. */
745
746 ptrloc = *recptr + 2 + colidx;
747 dasrdi_(handle, &ptrloc, &ptrloc, &datptr);
748 if (datptr > 0) {
749
750 /* The entry is non-null. */
751
752 *isnull = FALSE_;
753
754 /* Get the element count. Check for range specifications that */
755 /* can't be met. */
756
757 dasrdd_(handle, &datptr, &datptr, &dpnelt);
758 nelt = i_dnnt(&dpnelt);
759 if (*beg < 1 || *beg > nelt) {
760 *found = FALSE_;
761 return 0;
762 } else if (*end < 1 || *end > nelt) {
763 *found = FALSE_;
764 return 0;
765 } else if (*end < *beg) {
766 *found = FALSE_;
767 return 0;
768 }
769
770 /* The request is valid, so read the data. The first step is to */
771 /* locate the element at index BEG. */
772
773 zzekpgpg_(&c__2, &datptr, &p, &base);
774 minidx = 1;
775 maxidx = base + 126 - datptr;
776 datptr += *beg;
777 while(maxidx < *beg) {
778
779 /* Locate the page on which the element is continued. */
780
781 zzekgfwd_(handle, &c__2, &p, &ptemp);
782 p = ptemp;
783 zzekpgbs_(&c__2, &p, &base);
784
785 /* Determine the highest-indexed element of the column entry */
786 /* located on the current page. */
787
788 minidx = maxidx + 1;
789 /* Computing MIN */
790 i__1 = maxidx + 126;
791 maxidx = min(i__1,nelt);
792
793 /* The following assignment will set DATPTR to the correct */
794 /* value on the last pass through this loop. */
795
796 datptr = base + 1 + (*beg - minidx);
797 }
798
799 /* At this point, P is the page on which the element having index */
800 /* BEG is located. BASE is the base address of this page. */
801 /* MAXIDX is the highest index of any element on the current page. */
802
803 remain = *end - *beg + 1;
804 start = 1;
805
806 /* Decide how many elements to read from the current page, and */
807 /* read them. */
808
809 /* Computing MIN */
810 i__1 = remain, i__2 = base + 126 - datptr + 1;
811 nread = min(i__1,i__2);
812 i__1 = datptr + nread - 1;
813 dasrdd_(handle, &datptr, &i__1, &dvals[start - 1]);
814 remain -= nread;
815 while(remain > 0 && ! failed_()) {
816
817 /* Locate the page on which the element is continued. */
818
819 zzekgfwd_(handle, &c__2, &p, &ptemp);
820 p = ptemp;
821 zzekpgbs_(&c__2, &p, &base);
822 datptr = base + 1;
823 start += nread;
824 nread = min(remain,126);
825 i__1 = datptr + nread - 1;
826 dasrdd_(handle, &datptr, &i__1, &dvals[start - 1]);
827 remain -= nread;
828 }
829 *found = ! failed_();
830 } else if (datptr == -2) {
831
832 /* The value is null. */
833
834 *isnull = TRUE_;
835 *found = TRUE_;
836 } else if (datptr == -1) {
837
838 /* The data value is absent. This is an error. */
839
840 recno = zzekrp2n_(handle, &segdsc[1], recptr);
841 chkin_("ZZEKRD05", (ftnlen)8);
842 setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C"
843 "OLIDX = #; RECNO = #; EK = #", (ftnlen)87);
844 errint_("#", &segdsc[1], (ftnlen)1);
845 errint_("#", &colidx, (ftnlen)1);
846 errint_("#", &recno, (ftnlen)1);
847 errhan_("#", handle, (ftnlen)1);
848 sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25);
849 chkout_("ZZEKRD05", (ftnlen)8);
850 return 0;
851 } else {
852
853 /* The data pointer is corrupted. */
854
855 recno = zzekrp2n_(handle, &segdsc[1], recptr);
856 chkin_("ZZEKRD05", (ftnlen)8);
857 setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = "
858 "#; EK = #", (ftnlen)68);
859 errint_("#", &segdsc[1], (ftnlen)1);
860 errint_("#", &colidx, (ftnlen)1);
861 errint_("#", &recno, (ftnlen)1);
862 errhan_("#", handle, (ftnlen)1);
863 sigerr_("SPICE(BUG)", (ftnlen)10);
864 chkout_("ZZEKRD05", (ftnlen)8);
865 return 0;
866 }
867 return 0;
868 } /* zzekrd05_ */
869
870