1 /* zzekac03.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 static logical c_false = FALSE_;
12 static integer c__0 = 0;
13
14 /* $Procedure ZZEKAC03 ( EK, add class 3 column to segment ) */
zzekac03_(integer * handle,integer * segdsc,integer * coldsc,char * cvals,logical * nlflgs,integer * rcptrs,integer * wkindx,ftnlen cvals_len)15 /* Subroutine */ int zzekac03_(integer *handle, integer *segdsc, integer *
16 coldsc, char *cvals, logical *nlflgs, integer *rcptrs, integer *
17 wkindx, ftnlen cvals_len)
18 {
19 /* System generated locals */
20 integer i__1, i__2;
21
22 /* Builtin functions */
23 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
24 integer s_rnge(char *, integer, char *, integer);
25
26 /* Local variables */
27 char page[1024];
28 integer tree, from, room;
29 extern /* Subroutine */ int zzektr1s_(integer *, integer *, integer *,
30 integer *), zzekcnam_(integer *, integer *, char *, ftnlen),
31 zzekordc_(char *, logical *, logical *, integer *, integer *,
32 ftnlen), zzekpgwc_(integer *, integer *, char *, ftnlen),
33 zzekspsh_(integer *, integer *), zzektrit_(integer *, integer *);
34 integer i__, n, p, mbase, ndata, pbase;
35 extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
36 ftnlen, ftnlen);
37 integer class__, nnull;
38 extern integer rtrim_(char *, ftnlen);
39 integer p2, nrows;
40 extern logical return_(void);
41 char column[32];
42 integer adrbuf[1014], bufptr, colidx, colwid, dscbas, idxtyp, nchars,
43 nlinks, nulptr, nwrite, remain, strlen, to;
44 logical fixlen, indexd, nullok;
45 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
46 integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
47 ftnlen), prtenc_(integer *, char *, ftnlen), prtdec_(char *,
48 integer *, ftnlen), dasudi_(integer *, integer *, integer *,
49 integer *);
50 integer pos;
51 extern /* Subroutine */ int zzekaps_(integer *, integer *, integer *,
52 logical *, integer *, integer *);
53
54 /* $ Abstract */
55
56 /* Add an entire class 3 column to an EK segment. */
57
58 /* $ Disclaimer */
59
60 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
61 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
62 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
63 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
64 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
65 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
66 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
67 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
68 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
69 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
70
71 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
72 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
73 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
74 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
75 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
76 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
77
78 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
79 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
80 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
81 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
82
83 /* $ Required_Reading */
84
85 /* EK */
86
87 /* $ Keywords */
88
89 /* EK */
90
91 /* $ Declarations */
92 /* $ Disclaimer */
93
94 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
95 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
96 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
97 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
98 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
99 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
100 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
101 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
102 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
103 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
104
105 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
106 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
107 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
108 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
109 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
110 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
111
112 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
113 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
114 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
115 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
116
117
118 /* Include Section: EK Boolean Enumerated Type */
119
120
121 /* ekbool.inc Version 1 21-DEC-1994 (NJB) */
122
123
124 /* Within the EK system, boolean values sometimes must be */
125 /* represented by integer or character codes. The codes and their */
126 /* meanings are listed below. */
127
128 /* Integer code indicating `true': */
129
130
131 /* Integer code indicating `false': */
132
133
134 /* Character code indicating `true': */
135
136
137 /* Character code indicating `false': */
138
139
140 /* End Include Section: EK Boolean Enumerated Type */
141
142 /* $ Disclaimer */
143
144 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
145 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
146 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
147 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
148 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
149 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
150 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
151 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
152 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
153 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
154
155 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
156 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
157 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
158 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
159 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
160 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
161
162 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
163 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
164 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
165 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
166
167
168 /* Include Section: EK Column Name Size */
169
170 /* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */
171
172
173 /* Size of column name, in characters. */
174
175
176 /* End Include Section: EK Column Name Size */
177
178 /* $ Disclaimer */
179
180 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
181 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
182 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
183 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
184 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
185 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
186 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
187 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
188 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
189 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
190
191 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
192 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
193 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
194 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
195 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
196 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
197
198 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
199 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
200 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
201 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
202
203
204 /* Include Section: EK Column Descriptor Parameters */
205
206 /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
207
208
209 /* Note: The column descriptor size parameter CDSCSZ is */
210 /* declared separately in the include section CDSIZE$INC.FOR. */
211
212 /* Offset of column descriptors, relative to start of segment */
213 /* integer address range. This number, when added to the last */
214 /* integer address preceding the segment, yields the DAS integer */
215 /* base address of the first column descriptor. Currently, this */
216 /* offset is exactly the size of a segment descriptor. The */
217 /* parameter SDSCSZ, which defines the size of a segment descriptor, */
218 /* is declared in the include file eksegdsc.inc. */
219
220
221 /* Size of column descriptor */
222
223
224 /* Indices of various pieces of column descriptors: */
225
226
227 /* CLSIDX is the index of the column's class code. (We use the */
228 /* word `class' to distinguish this item from the column's data */
229 /* type.) */
230
231
232 /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
233 /* or TIME). The type is actually implied by the class, but it */
234 /* will frequently be convenient to look up the type directly. */
235
236
237
238 /* LENIDX is the index of the column's string length value, if the */
239 /* column has character type. A value of IFALSE in this element of */
240 /* the descriptor indicates that the strings have variable length. */
241
242
243 /* SIZIDX is the index of the column's element size value. This */
244 /* descriptor element is meaningful for columns with fixed-size */
245 /* entries. For variable-sized columns, this value is IFALSE. */
246
247
248 /* NAMIDX is the index of the base address of the column's name. */
249
250
251 /* IXTIDX is the data type of the column's index. IXTIDX */
252 /* contains a type value only if the column is indexed. For columns */
253 /* that are not indexed, the location IXTIDX contains the boolean */
254 /* value IFALSE. */
255
256
257 /* IXPIDX is a pointer to the column's index. IXTPDX contains a */
258 /* meaningful value only if the column is indexed. The */
259 /* interpretation of the pointer depends on the data type of the */
260 /* index. */
261
262
263 /* NFLIDX is the index of a flag indicating whether nulls are */
264 /* permitted in the column. The value at location NFLIDX is */
265 /* ITRUE if nulls are permitted and IFALSE otherwise. */
266
267
268 /* ORDIDX is the index of the column's ordinal position in the */
269 /* list of columns belonging to the column's parent segment. */
270
271
272 /* METIDX is the index of the column's integer metadata pointer. */
273 /* This pointer is a DAS integer address. */
274
275
276 /* The last position in the column descriptor is reserved. No */
277 /* parameter is defined to point to this location. */
278
279
280 /* End Include Section: EK Column Descriptor Parameters */
281
282 /* $ Disclaimer */
283
284 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
285 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
286 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
287 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
288 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
289 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
290 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
291 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
292 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
293 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
294
295 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
296 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
297 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
298 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
299 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
300 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
301
302 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
303 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
304 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
305 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
306
307
308 /* Include Section: EK Data Page Parameters */
309
310 /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */
311
312 /* These parameters apply to EK files using architecture 4. */
313 /* These files use a paged DAS file as their underlying file */
314 /* structure. */
315
316 /* In paged DAS EK files, data pages are structured: they contain */
317 /* metadata as well as data. The metadata is located in the last */
318 /* few addresses of each page, so as to interfere as little as */
319 /* possible with calculation of data addresses. */
320
321 /* Each data page belongs to exactly one segment. Some bookkeeping */
322 /* information, such as record pointers, is also stored in data */
323 /* pages. */
324
325 /* Each page contains a forward pointer that allows rapid lookup */
326 /* of data items that span multiple pages. Each page also keeps */
327 /* track of the current number of links from its parent segment */
328 /* to the page. Link counts enable pages to `know' when they */
329 /* are no longer in use by a segment; unused pages are deallocated */
330 /* and returned to the free list. */
331
332 /* The parameters in this include file depend on the parameters */
333 /* declared in the include file ekpage.inc. If those parameters */
334 /* change, this file must be updated. The specified parameter */
335 /* declarations we need from that file are: */
336
337 /* INTEGER PGSIZC */
338 /* PARAMETER ( PGSIZC = 1024 ) */
339
340 /* INTEGER PGSIZD */
341 /* PARAMETER ( PGSIZD = 128 ) */
342
343 /* INTEGER PGSIZI */
344 /* PARAMETER ( PGSIZI = 256 ) */
345
346
347
348 /* Character pages use an encoding mechanism to represent integer */
349 /* metadata. Each integer is encoded in five consecutive */
350 /* characters. */
351
352
353 /* Character data page parameters: */
354
355
356 /* Size of encoded integer: */
357
358
359 /* Usable page size: */
360
361
362 /* Location of character forward pointer: */
363
364
365 /* Location of character link count: */
366
367
368 /* Double precision data page parameters: */
369
370 /* Usable page size: */
371
372
373 /* Location of d.p. forward pointer: */
374
375
376 /* Location of d.p. link count: */
377
378
379 /* Integer data page parameters: */
380
381 /* Usable page size: */
382
383
384 /* Location of integer forward pointer: */
385
386
387 /* Location of integer link count: */
388
389
390 /* End Include Section: EK Data Page Parameters */
391
392 /* $ Disclaimer */
393
394 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
395 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
396 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
397 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
398 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
399 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
400 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
401 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
402 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
403 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
404
405 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
406 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
407 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
408 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
409 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
410 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
411
412 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
413 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
414 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
415 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
416
417
418 /* Include Section: EK Das Paging Parameters */
419
420 /* ekpage.inc Version 4 25-AUG-1995 (NJB) */
421
422
423
424 /* The EK DAS paging system makes use of the integer portion */
425 /* of an EK file's DAS address space to store the few numbers */
426 /* required to describe the system's state. The allocation */
427 /* of DAS integer addresses is shown below. */
428
429
430 /* DAS integer array */
431
432 /* +--------------------------------------------+ */
433 /* | EK architecture code | Address = 1 */
434 /* +--------------------------------------------+ */
435 /* | Character page size (in DAS words) | */
436 /* +--------------------------------------------+ */
437 /* | Character page base address | */
438 /* +--------------------------------------------+ */
439 /* | Number of character pages in file | */
440 /* +--------------------------------------------+ */
441 /* | Number of character pages on free list | */
442 /* +--------------------------------------------+ */
443 /* | Character free list head pointer | Address = 6 */
444 /* +--------------------------------------------+ */
445 /* | | Addresses = */
446 /* | Metadata for d.p. pages | 7--11 */
447 /* | | */
448 /* +--------------------------------------------+ */
449 /* | | Addresses = */
450 /* | Metadata for integer pages | 12--16 */
451 /* | | */
452 /* +--------------------------------------------+ */
453 /* . */
454 /* . */
455 /* . */
456 /* +--------------------------------------------+ */
457 /* | | End Address = */
458 /* | Unused space | integer page */
459 /* | | end */
460 /* +--------------------------------------------+ */
461 /* | | Start Address = */
462 /* | First integer page | integer page */
463 /* | | base */
464 /* +--------------------------------------------+ */
465 /* . */
466 /* . */
467 /* . */
468 /* +--------------------------------------------+ */
469 /* | | */
470 /* | Last integer page | */
471 /* | | */
472 /* +--------------------------------------------+ */
473
474 /* The following parameters indicate positions of elements in the */
475 /* paging system metadata array: */
476
477
478
479 /* Number of metadata items per data type: */
480
481
482 /* Character metadata indices: */
483
484
485 /* Double precision metadata indices: */
486
487
488 /* Integer metadata indices: */
489
490
491 /* Size of metadata area: */
492
493
494 /* Page sizes, in units of DAS words of the appropriate type: */
495
496
497 /* Default page base addresses: */
498
499
500 /* End Include Section: EK Das Paging Parameters */
501
502 /* $ Disclaimer */
503
504 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
505 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
506 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
507 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
508 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
509 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
510 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
511 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
512 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
513 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
514
515 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
516 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
517 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
518 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
519 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
520 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
521
522 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
523 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
524 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
525 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
526
527
528 /* Include Section: EK Record Pointer Parameters */
529
530 /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */
531
532
533 /* This file declares parameters used in EK record pointers. */
534 /* Each segment references data in a given record via two levels */
535 /* of indirection: a record number points to a record pointer, */
536 /* which is a structured array of metadata and data pointers. */
537
538 /* Record pointers always occupy contiguous ranges of integer */
539 /* addresses. */
540
541 /* The parameter declarations in this file depend on the assumption */
542 /* that integer pages contain 256 DAS integer words and that the */
543 /* maximum number of columns in a segment is 100. Record pointers */
544 /* are stored in integer data pages, so they must fit within the */
545 /* usable data area afforded by these pages. The size of the usable */
546 /* data area is given by the parameter IPSIZE which is declared in */
547 /* ekdatpag.inc. The assumed value of IPSIZE is 254. */
548
549
550 /* The first element of each record pointer is a status indicator. */
551 /* The meanings of status indicators depend on whether the parent EK */
552 /* is shadowed or not. For shadowed EKs, allowed status values and */
553 /* their meanings are: */
554
555 /* OLD The record has not been modified since */
556 /* the EK containing the record was opened. */
557
558 /* UPDATE The record is an update of a previously existing */
559 /* record. The original record is now on the */
560 /* modified record list. */
561
562 /* NEW The record has been added since the EK containing the */
563 /* record was opened. The record is not an update */
564 /* of a previously existing record. */
565
566 /* DELOLD This status applies only to a backup record. */
567 /* DELOLD status indicates that the record corresponds */
568 /* to a deleted OLD record in the source segment. */
569
570 /* DELNEW This status applies only to a backup record. */
571 /* DELNEW status indicates that the record corresponds */
572 /* to a deleted NEW record in the source segment. */
573
574 /* DELUPD This status applies only to a backup record. */
575 /* DELUPD status indicates that the record corresponds */
576 /* to a deleted UPDATEd record in the source segment. */
577
578 /* In EKs that are not shadowed, all records have status OLD. */
579
580
581
582 /* The following parameters refer to indices within the record */
583 /* pointer structure: */
584
585 /* Index of status indicator: */
586
587
588 /* Each record pointer contains a pointer to its companion: for a */
589 /* record belonging to a shadowed EK, this is the backup counterpart, */
590 /* or if the parent EK is itself a backup EK, a pointer to the */
591 /* record's source record. The pointer is UNINIT (see below) if the */
592 /* record is unmodified. */
593
594 /* Record companion pointers contain record numbers, not record */
595 /* base addresses. */
596
597 /* Index of record's companion pointer: */
598
599
600 /* Each data item is referenced by an integer. The meaning of */
601 /* this integer depends on the representation of data in the */
602 /* column to which the data item belongs. Actual lookup of a */
603 /* data item must be done by subroutines appropriate to the class of */
604 /* the column to which the item belongs. Note that data items don't */
605 /* necessarily occupy contiguous ranges of DAS addresses. */
606
607 /* Base address of data pointers: */
608
609
610 /* Maximum record pointer size: */
611
612
613 /* Data pointers are given the value UNINIT to start with; this */
614 /* indicates that the data item is uninitialized. UNINIT is */
615 /* distinct from the value NULL. NOBACK indicates an uninitialized */
616 /* backup column entry. */
617
618
619 /* End Include Section: EK Record Pointer Parameters */
620
621 /* $ Disclaimer */
622
623 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
624 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
625 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
626 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
627 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
628 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
629 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
630 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
631 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
632 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
633
634 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
635 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
636 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
637 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
638 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
639 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
640
641 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
642 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
643 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
644 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
645
646
647 /* Include Section: EK Segment Descriptor Parameters */
648
649 /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
650
651
652 /* All `base addresses' referred to below are the addresses */
653 /* *preceding* the item the base applies to. This convention */
654 /* enables simplied address calculations in many cases. */
655
656 /* Size of segment descriptor. Note: the include file ekcoldsc.inc */
657 /* must be updated if this parameter is changed. The parameter */
658 /* CDOFF in that file should be kept equal to SDSCSZ. */
659
660
661 /* Index of the segment type code: */
662
663
664 /* Index of the segment's number. This number is the segment's */
665 /* index in the list of segments contained in the EK to which */
666 /* the segment belongs. */
667
668
669 /* Index of the DAS integer base address of the segment's integer */
670 /* meta-data: */
671
672
673 /* Index of the DAS character base address of the table name: */
674
675
676 /* Index of the segment's column count: */
677
678
679 /* Index of the segment's record count: */
680
681
682 /* Index of the root page number of the record tree: */
683
684
685 /* Index of the root page number of the character data page tree: */
686
687
688 /* Index of the root page number of the double precision data page */
689 /* tree: */
690
691
692 /* Index of the root page number of the integer data page tree: */
693
694
695 /* Index of the `modified' flag: */
696
697
698 /* Index of the `initialized' flag: */
699
700
701 /* Index of the shadowing flag: */
702
703
704 /* Index of the companion file handle: */
705
706
707 /* Index of the companion segment number: */
708
709
710 /* The next three items are, respectively, the page numbers of the */
711 /* last character, d.p., and integer data pages allocated by the */
712 /* segment: */
713
714
715 /* The next three items are, respectively, the page-relative */
716 /* indices of the last DAS word in use in the segment's */
717 /* last character, d.p., and integer data pages: */
718
719
720 /* Index of the DAS character base address of the column name list: */
721
722
723 /* The last descriptor element is reserved for future use. No */
724 /* parameter is defined to point to this location. */
725
726
727 /* End Include Section: EK Segment Descriptor Parameters */
728
729 /* $ Disclaimer */
730
731 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
732 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
733 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
734 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
735 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
736 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
737 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
738 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
739 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
740 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
741
742 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
743 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
744 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
745 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
746 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
747 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
748
749 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
750 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
751 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
752 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
753
754
755 /* Include Section: EK Data Types */
756
757 /* ektype.inc Version 1 27-DEC-1994 (NJB) */
758
759
760 /* Within the EK system, data types of EK column contents are */
761 /* represented by integer codes. The codes and their meanings */
762 /* are listed below. */
763
764 /* Integer codes are also used within the DAS system to indicate */
765 /* data types; the EK system makes no assumptions about compatibility */
766 /* between the codes used here and those used in the DAS system. */
767
768
769 /* Character type: */
770
771
772 /* Double precision type: */
773
774
775 /* Integer type: */
776
777
778 /* `Time' type: */
779
780 /* Within the EK system, time values are represented as ephemeris */
781 /* seconds past J2000 (TDB), and double precision numbers are used */
782 /* to store these values. However, since time values require special */
783 /* treatment both on input and output, and since the `TIME' column */
784 /* has a special role in the EK specification and code, time values */
785 /* are identified as a type distinct from double precision numbers. */
786
787
788 /* End Include Section: EK Data Types */
789
790 /* $ Brief_I/O */
791
792 /* Variable I/O Description */
793 /* -------- --- -------------------------------------------------- */
794 /* HANDLE I Handle attached to new EK file. */
795 /* SEGDSC I Segment descriptor. */
796 /* COLDSC I Column descriptor. */
797 /* CVALS I Character values to add to column. */
798 /* NLFLGS I Array of null flags for column entries. */
799 /* RCPTRS I Array of record pointers for segment. */
800 /* WKINDX I-O Work space for column index. */
801
802 /* $ Detailed_Input */
803
804 /* HANDLE the handle of an EK file that is open for writing. */
805 /* A `begin segment for fast load' operation must */
806 /* have already been performed for the designated */
807 /* segment. */
808
809 /* SEGDSC is a descriptor for the segment to which data is */
810 /* to be added. The segment descriptor is not */
811 /* updated by this routine, but some fields in the */
812 /* descriptor will become invalid after this routine */
813 /* returns. */
814
815 /* COLDSC is a descriptor for the column to be added. The */
816 /* column attributes must be filled in, but any */
817 /* pointers may be uninitialized. */
818
819 /* CVALS is an array containing the entire set of column */
820 /* entries for the specified column. The entries */
821 /* are listed in row-order: the column entry for the */
822 /* first row of the segment is first, followed by the */
823 /* column entry for the second row, and so on. The */
824 /* number of column entries must match the declared */
825 /* number of rows in the segment. Elements must be */
826 /* allocated for each column entry, including null */
827 /* entries. */
828
829 /* NLFLGS is an array of logical flags indicating whether */
830 /* the corresponding entries are null. If the Ith */
831 /* element of NLFLGS is .FALSE., the Ith column entry */
832 /* defined by CVALS is added to the specified segment */
833 /* in the specified kernel file. */
834
835 /* If the Ith element of NLFGLS is .TRUE., the */
836 /* contents of the Ith column entry are undefined. */
837
838 /* NLFLGS is used only for columns that allow null */
839 /* values; it's ignored for other columns. */
840
841 /* RCPTRS is an array of record pointers for the input */
842 /* segment. These pointers are base addresses of the */
843 /* `record pointer structures' for the segment. */
844 /* These pointers are used instead of record numbers */
845 /* in column indexes: the indexes map ordinal */
846 /* positions to record pointers. */
847
848 /* WKINDX is a work space array used for building a column */
849 /* index. If the column is indexed, the dimension of */
850 /* WKINDX must be at NROWS, where NROWS is the number */
851 /* of rows in the column. If the column is not */
852 /* indexed, this work space is not used, so the */
853 /* dimension may be any positive value. */
854
855 /* $ Detailed_Output */
856
857 /* None. See $Particulars for a description of the effect of this */
858 /* routine. */
859
860 /* $ Parameters */
861
862 /* None. */
863
864 /* $ Exceptions */
865
866 /* 1) If HANDLE is invalid, the error will be diagnosed by routines */
867 /* called by this routine. */
868
869 /* 2) If an I/O error occurs while reading or writing the indicated */
870 /* file, the error will be diagnosed by routines called by this */
871 /* routine. */
872
873 /* $ Files */
874
875 /* See the EK Required Reading for a discussion of the EK file */
876 /* format. */
877
878 /* $ Particulars */
879
880 /* This routine operates by side effects: it modifies the named */
881 /* EK file by adding data to the specified column. This routine */
882 /* writes the entire contents of the specified column in one shot. */
883 /* This routine creates columns much more efficiently than can be */
884 /* done by sequential calls to EKACEC, but has the drawback that */
885 /* the caller must use more memory for the routine's inputs. This */
886 /* routine cannot be used to add data to a partially completed */
887 /* column. */
888
889 /* $ Examples */
890
891 /* See EKACLC. */
892
893 /* $ Restrictions */
894
895 /* 1) This routine assumes the EK scratch area has been set up */
896 /* properly for a fast load operation. This routine writes */
897 /* to the EK scratch area as well. */
898
899 /* $ Literature_References */
900
901 /* None. */
902
903 /* $ Author_and_Institution */
904
905 /* N.J. Bachman (JPL) */
906
907 /* $ Version */
908
909 /* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */
910
911 /* -& */
912
913 /* SPICELIB functions */
914
915
916 /* Local parameters */
917
918
919 /* Local variables */
920
921
922 /* Standard SPICE error handling. */
923
924 if (return_()) {
925 return 0;
926 } else {
927 chkin_("ZZEKAC03", (ftnlen)8);
928 }
929
930 /* Grab the column's attributes. Initialize the maximum non-blank */
931 /* width of the column. */
932
933 class__ = coldsc[0];
934 idxtyp = coldsc[5];
935 nulptr = coldsc[7];
936 colidx = coldsc[8];
937 colwid = coldsc[2];
938 nullok = nulptr != -1;
939 indexd = idxtyp != -1;
940 fixlen = colwid != -1;
941
942 /* This column had better be class 3. */
943
944 if (class__ != 3) {
945 zzekcnam_(handle, coldsc, column, (ftnlen)32);
946 setmsg_("Column class code # found in descriptor for column #. Clas"
947 "s should be 3.", (ftnlen)73);
948 errint_("#", &class__, (ftnlen)1);
949 errch_("#", column, (ftnlen)1, (ftnlen)32);
950 sigerr_("SPICE(NOCLASS)", (ftnlen)14);
951 chkout_("ZZEKAC03", (ftnlen)8);
952 return 0;
953 }
954
955 /* If the column is indexed, the index type should be 1; we don't */
956 /* know how to create any other type of index. */
957
958 if (indexd && idxtyp != 1) {
959 zzekcnam_(handle, coldsc, column, (ftnlen)32);
960 setmsg_("Index type code # found in descriptor for column #. Code s"
961 "hould be 1.", (ftnlen)70);
962 errint_("#", &idxtyp, (ftnlen)1);
963 errch_("#", column, (ftnlen)1, (ftnlen)32);
964 sigerr_("SPICE(UNRECOGNIZEDTYPE)", (ftnlen)23);
965 chkout_("ZZEKAC03", (ftnlen)8);
966 return 0;
967 }
968
969 /* Push the column's ordinal index on the stack. This allows us */
970 /* to identify the column the addresses belong to. */
971
972 zzekspsh_(&c__1, &colidx);
973
974 /* Find the number of rows in the segment. */
975
976 nrows = segdsc[5];
977
978 /* Count the number of strings to write. */
979
980 if (nullok) {
981
982 /* Count the non-null column entries; these are the */
983 /* ones that will take up space. */
984
985 nnull = 0;
986 ndata = 0;
987 i__1 = nrows;
988 for (i__ = 1; i__ <= i__1; ++i__) {
989 if (nlflgs[i__ - 1]) {
990 ++nnull;
991 }
992 }
993 ndata = nrows - nnull;
994 } else {
995 ndata = nrows;
996 }
997 if (ndata > 0) {
998
999 /* There's some data to write, so allocate a page. Also */
1000 /* prepare a data buffer to be written out as a page. */
1001
1002 zzekaps_(handle, segdsc, &c__1, &c_false, &p, &pbase);
1003 s_copy(page, " ", (ftnlen)1024, (ftnlen)1);
1004
1005 /* The link count starts out at zero. */
1006
1007 prtenc_(&c__0, page + 1019, (ftnlen)5);
1008 }
1009
1010 /* Write the input data out to the target file a page at a time. */
1011 /* Null values don't get written. */
1012
1013 /* While we're at it, we'll push onto the EK stack the addresses */
1014 /* of the column entries. We use the constant NULL rather than an */
1015 /* address to represent null entries. */
1016
1017 /* We'll use FROM to indicate the element of CVALS we're */
1018 /* considering, TO to indicate the first character of PAGE to write */
1019 /* to, and BUFPTR to indicate the element of ADRBUF to write */
1020 /* addresses to. The variable N indicates the number of characters */
1021 /* written to the current page. NCHARS indicates the number of */
1022 /* characters left to write from the current input element. NWRITE */
1023 /* will be used to count the column entries written so far. */
1024
1025 remain = nrows;
1026 from = 0;
1027 to = 1;
1028 bufptr = 1;
1029 nwrite = 0;
1030 n = 0;
1031 while(remain > 0) {
1032
1033 /* Examine a column entry. Write it out if it's non-null. */
1034
1035 ++from;
1036 if (nullok && nlflgs[from - 1]) {
1037 adrbuf[(i__1 = bufptr - 1) < 1014 && 0 <= i__1 ? i__1 : s_rnge(
1038 "adrbuf", i__1, "zzekac03_", (ftnlen)382)] = -2;
1039 } else {
1040
1041 /* Write out the current column entry. The entry */
1042 /* might span multiple pages. However, we're guaranteed */
1043 /* enough room to write out to the current page the encoded */
1044 /* character count and at least one character of data. */
1045
1046 /* Update the non-blank width for the column each time we */
1047 /* determine the length of an input string. */
1048
1049 if (fixlen) {
1050 /* Computing MIN */
1051 i__1 = rtrim_(cvals + (from - 1) * cvals_len, cvals_len);
1052 strlen = min(i__1,colwid);
1053 } else {
1054 strlen = rtrim_(cvals + (from - 1) * cvals_len, cvals_len);
1055 }
1056 adrbuf[(i__1 = bufptr - 1) < 1014 && 0 <= i__1 ? i__1 : s_rnge(
1057 "adrbuf", i__1, "zzekac03_", (ftnlen)400)] = to + pbase;
1058 pos = 1;
1059
1060 /* Start out with the string length. */
1061
1062 prtenc_(&strlen, page + (to - 1), (ftnlen)5);
1063 n += 5;
1064 to = n + 1;
1065 nchars = strlen;
1066 while(nchars > 0) {
1067 room = 1014 - n;
1068 if (nchars <= room) {
1069
1070 /* The remaining portion of the string will fit on the */
1071 /* current page. */
1072
1073 s_copy(page + (to - 1), cvals + ((from - 1) * cvals_len +
1074 (pos - 1)), to + nchars - 1 - (to - 1), pos +
1075 nchars - 1 - (pos - 1));
1076 n += nchars;
1077 to = n + 1;
1078 nchars = 0;
1079
1080 /* Add a link to the current page. */
1081
1082 prtdec_(page + 1019, &nlinks, (ftnlen)5);
1083 i__1 = nlinks + 1;
1084 prtenc_(&i__1, page + 1019, (ftnlen)5);
1085 } else {
1086
1087 /* The string will have to be continued on another page. */
1088 /* Write out the first ROOM characters to the current */
1089 /* page first. */
1090
1091 s_copy(page + (to - 1), cvals + ((from - 1) * cvals_len +
1092 (pos - 1)), 1014 - (to - 1), pos + room - 1 - (
1093 pos - 1));
1094 pos += room;
1095 nchars -= room;
1096
1097 /* Add a link to the current page. */
1098
1099 prtdec_(page + 1019, &nlinks, (ftnlen)5);
1100 i__1 = nlinks + 1;
1101 prtenc_(&i__1, page + 1019, (ftnlen)5);
1102
1103 /* Allocate another page. Fill in the forward pointer */
1104 /* in the previous page. */
1105
1106 zzekaps_(handle, segdsc, &c__1, &c_false, &p2, &pbase);
1107 prtenc_(&p2, page + 1014, (ftnlen)5);
1108
1109 /* Write out the full data page. Get ready to write */
1110 /* to the new page. */
1111
1112 zzekpgwc_(handle, &p, page, (ftnlen)1024);
1113 p = p2;
1114 s_copy(page, " ", (ftnlen)1024, (ftnlen)1);
1115 prtenc_(&c__0, page + 1019, (ftnlen)5);
1116 n = 0;
1117 to = 1;
1118 }
1119 }
1120
1121 /* We've written out a column entry. */
1122
1123 ++nwrite;
1124 }
1125
1126 /* We're done with the current column entry, null or not. */
1127
1128 if (nwrite < ndata) {
1129
1130 /* There is at least one more column entry to write. */
1131 /* If there's not enough room on the current page to begin */
1132 /* writing another column entry, write out the page and */
1133 /* allocate another. */
1134
1135 room = 1014 - n;
1136 if (room < 6) {
1137 zzekpgwc_(handle, &p, page, (ftnlen)1024);
1138 zzekaps_(handle, segdsc, &c__1, &c_false, &p, &pbase);
1139 s_copy(page, " ", (ftnlen)1024, (ftnlen)1);
1140 prtenc_(&c__0, page + 1019, (ftnlen)5);
1141 n = 0;
1142 to = 1;
1143 }
1144 } else if (n > 0) {
1145
1146 /* We've written the last of the non-null data to the current */
1147 /* page. Write out this page. */
1148
1149 zzekpgwc_(handle, &p, page, (ftnlen)1024);
1150 n = 0;
1151 }
1152 --remain;
1153 if (bufptr == 1014 || remain == 0) {
1154
1155 /* The address buffer is full or we're out of input values */
1156 /* to look at, so push the buffer contents on the stack. */
1157
1158 zzekspsh_(&bufptr, adrbuf);
1159 bufptr = 1;
1160 } else {
1161 ++bufptr;
1162 }
1163 }
1164
1165 /* If the column is supposed to have an index, now is the time to */
1166 /* build that index. We'll find the order vector for the input */
1167 /* values, overwrite the elements of the order vector with the */
1168 /* corresponding elements of the input array of record pointers, then */
1169 /* load this sorted copy of the record pointer array into a tree in */
1170 /* one shot. */
1171
1172 if (indexd) {
1173 zzekordc_(cvals, &nullok, nlflgs, &nrows, wkindx, cvals_len);
1174 i__1 = nrows;
1175 for (i__ = 1; i__ <= i__1; ++i__) {
1176 wkindx[i__ - 1] = rcptrs[wkindx[i__ - 1] - 1];
1177 }
1178 zzektrit_(handle, &tree);
1179 zzektr1s_(handle, &tree, &nrows, wkindx);
1180
1181 /* Update the segment's metadata to point to the index. The */
1182 /* pointer indicates the root page of the tree. */
1183
1184 mbase = segdsc[2];
1185 dscbas = mbase + 24 + (colidx - 1) * 11;
1186 i__1 = dscbas + 7;
1187 i__2 = dscbas + 7;
1188 dasudi_(handle, &i__1, &i__2, &tree);
1189 }
1190 chkout_("ZZEKAC03", (ftnlen)8);
1191 return 0;
1192 } /* zzekac03_ */
1193
1194