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