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