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