1 /* zzekjsrt.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 integer c__4 = 4;
12
13 /* $Procedure ZZEKJSRT ( EK, join row set union sort ) */
zzekjsrt_(integer * njrs,integer * ubases,integer * norder,integer * otabs,integer * ocols,integer * oelts,integer * senses,integer * sthan,integer * stsdsc,integer * stdtpt,integer * dtpool,integer * dtdscs,integer * ordbas)14 /* Subroutine */ int zzekjsrt_(integer *njrs, integer *ubases, integer *
15 norder, integer *otabs, integer *ocols, integer *oelts, integer *
16 senses, integer *sthan, integer *stsdsc, integer *stdtpt, integer *
17 dtpool, integer *dtdscs, integer *ordbas)
18 {
19 /* System generated locals */
20 integer i__1, i__2, i__3;
21 char ch__1[32], ch__2[32];
22
23 /* Builtin functions */
24 integer s_rnge(char *, integer, char *, integer);
25 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
26 integer s_cmp(char *, char *, ftnlen, ftnlen);
27
28 /* Local variables */
29 static char cdat[32*250000];
30 static doublereal ddat[250000];
31 static integer idat[250000];
32 integer ntab;
33 logical nfjg, null;
34 extern /* Subroutine */ int zzekvcal_(integer *, integer *, integer *);
35 extern logical zzekvcmp_(integer *, integer *, integer *, integer *,
36 integer *, integer *, integer *, integer *, integer *, integer *,
37 integer *, integer *, integer *, integer *, integer *);
38 extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *),
39 zzekspsh_(integer *, integer *), zzekvset_(integer *, integer *),
40 zzekstop_(integer *);
41 integer i__, j, addrj;
42 extern /* Subroutine */ int chkin_(char *, ftnlen);
43 integer cvlen, rvecj[11], svecj[10];
44 logical found;
45 integer nrloc;
46 logical brute;
47 integer dtype;
48 logical trunc;
49 extern /* Subroutine */ int swapi_(integer *, integer *);
50 integer nrows, jg;
51 static char nf[1*250000];
52 integer addrjg, handle, nr, rj;
53 extern integer lnknxt_(integer *, integer *);
54 extern logical return_(void);
55 integer cprime, colptr, eltidx, gap;
56 static integer ordvec[250000];
57 integer prvbas, row, rjg, rowvec[11], rvecjg[11], rvsize, rwvbas, seg,
58 segvec[10], sgvbas, svecjg[10], svsize, tabloc, tprime;
59 logical jle, nfj;
60 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
61 integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
62 ftnlen), errhan_(char *, integer *, ftnlen), zzekrsc_(integer *,
63 integer *, integer *, integer *, integer *, integer *, char *,
64 logical *, logical *, ftnlen), zzeksrd_(integer *, integer *,
65 integer *), zzekrsd_(integer *, integer *, integer *, integer *,
66 integer *, doublereal *, logical *, logical *), zzekrsi_(integer *
67 , integer *, integer *, integer *, integer *, integer *, logical *
68 , logical *);
69
70 /* $ Abstract */
71
72 /* Sort the row vectors of a join row set union, given an order */
73 /* relation defined by a set of qualified order-by columns. */
74
75 /* $ Disclaimer */
76
77 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
78 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
79 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
80 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
81 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
82 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
83 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
84 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
85 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
86 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
87
88 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
89 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
90 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
91 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
92 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
93 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
94
95 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
96 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
97 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
98 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
99
100 /* $ Required_Reading */
101
102 /* EK */
103
104 /* $ Keywords */
105
106 /* EK */
107 /* PRIVATE */
108
109 /* $ Declarations */
110 /* $ Disclaimer */
111
112 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
113 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
114 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
115 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
116 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
117 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
118 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
119 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
120 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
121 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
122
123 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
124 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
125 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
126 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
127 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
128 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
129
130 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
131 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
132 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
133 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
134
135
136 /* Include Section: EK Boolean Enumerated Type */
137
138
139 /* ekbool.inc Version 1 21-DEC-1994 (NJB) */
140
141
142 /* Within the EK system, boolean values sometimes must be */
143 /* represented by integer or character codes. The codes and their */
144 /* meanings are listed below. */
145
146 /* Integer code indicating `true': */
147
148
149 /* Integer code indicating `false': */
150
151
152 /* Character code indicating `true': */
153
154
155 /* Character code indicating `false': */
156
157
158 /* End Include Section: EK Boolean Enumerated Type */
159
160 /* $ Disclaimer */
161
162 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
163 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
164 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
165 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
166 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
167 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
168 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
169 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
170 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
171 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
172
173 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
174 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
175 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
176 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
177 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
178 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
179
180 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
181 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
182 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
183 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
184
185
186 /* Include Section: EK Column Descriptor Parameters */
187
188 /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
189
190
191 /* Note: The column descriptor size parameter CDSCSZ is */
192 /* declared separately in the include section CDSIZE$INC.FOR. */
193
194 /* Offset of column descriptors, relative to start of segment */
195 /* integer address range. This number, when added to the last */
196 /* integer address preceding the segment, yields the DAS integer */
197 /* base address of the first column descriptor. Currently, this */
198 /* offset is exactly the size of a segment descriptor. The */
199 /* parameter SDSCSZ, which defines the size of a segment descriptor, */
200 /* is declared in the include file eksegdsc.inc. */
201
202
203 /* Size of column descriptor */
204
205
206 /* Indices of various pieces of column descriptors: */
207
208
209 /* CLSIDX is the index of the column's class code. (We use the */
210 /* word `class' to distinguish this item from the column's data */
211 /* type.) */
212
213
214 /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
215 /* or TIME). The type is actually implied by the class, but it */
216 /* will frequently be convenient to look up the type directly. */
217
218
219
220 /* LENIDX is the index of the column's string length value, if the */
221 /* column has character type. A value of IFALSE in this element of */
222 /* the descriptor indicates that the strings have variable length. */
223
224
225 /* SIZIDX is the index of the column's element size value. This */
226 /* descriptor element is meaningful for columns with fixed-size */
227 /* entries. For variable-sized columns, this value is IFALSE. */
228
229
230 /* NAMIDX is the index of the base address of the column's name. */
231
232
233 /* IXTIDX is the data type of the column's index. IXTIDX */
234 /* contains a type value only if the column is indexed. For columns */
235 /* that are not indexed, the location IXTIDX contains the boolean */
236 /* value IFALSE. */
237
238
239 /* IXPIDX is a pointer to the column's index. IXTPDX contains a */
240 /* meaningful value only if the column is indexed. The */
241 /* interpretation of the pointer depends on the data type of the */
242 /* index. */
243
244
245 /* NFLIDX is the index of a flag indicating whether nulls are */
246 /* permitted in the column. The value at location NFLIDX is */
247 /* ITRUE if nulls are permitted and IFALSE otherwise. */
248
249
250 /* ORDIDX is the index of the column's ordinal position in the */
251 /* list of columns belonging to the column's parent segment. */
252
253
254 /* METIDX is the index of the column's integer metadata pointer. */
255 /* This pointer is a DAS integer address. */
256
257
258 /* The last position in the column descriptor is reserved. No */
259 /* parameter is defined to point to this location. */
260
261
262 /* End Include Section: EK Column Descriptor Parameters */
263
264 /* $ Disclaimer */
265
266 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
267 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
268 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
269 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
270 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
271 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
272 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
273 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
274 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
275 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
276
277 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
278 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
279 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
280 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
281 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
282 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
283
284 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
285 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
286 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
287 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
288
289
290 /* Include Section: EK Join Row Set Parameters */
291
292 /* ekjrs.inc Version 1 07-FEB-1995 (NJB) */
293
294
295 /* Maximum number of join row sets in a join row set union: */
296
297
298 /* The layout of a join row set in the EK scratch area is shown */
299 /* below: */
300
301 /* +--------------------------------------------+ */
302 /* | join row set size | 1 element */
303 /* +--------------------------------------------+ */
304 /* | number of row vectors in join row set | 1 element */
305 /* +--------------------------------------------+ */
306 /* | table count (TC) | 1 element */
307 /* +--------------------------------------------+ */
308 /* | segment vector count (SVC) | 1 element */
309 /* +--------------------------------------------+ */
310 /* | segment vector 1 | TC elements */
311 /* +--------------------------------------------+ */
312 /* . */
313 /* . */
314 /* . */
315 /* +--------------------------------------------+ */
316 /* | segment vector SVC | TC elements */
317 /* +--------------------------------------------+ */
318 /* | segment vector 1 row set base address | 1 element */
319 /* +--------------------------------------------+ */
320 /* | segment vector 1 row count (RC_1) | 1 element */
321 /* +--------------------------------------------+ */
322 /* . */
323 /* . */
324 /* . */
325 /* +--------------------------------------------+ */
326 /* | segment vector SVC row set base address | 1 element */
327 /* +--------------------------------------------+ */
328 /* | segment vector SVC row count (RC_SVC) | 1 element */
329 /* +--------------------------------------------+ */
330 /* | Augmented row vectors for segment vector 1 | (TC+1)*RC_1 */
331 /* +--------------------------------------------+ elements */
332 /* . */
333 /* . */
334 /* . */
335 /* +--------------------------------------------+ */
336 /* |Augmented row vectors for segment vector SVC| (TC+1)*RC_SVC1 */
337 /* +--------------------------------------------+ elements */
338
339
340 /* The following parameters indicate positions of elements in the */
341 /* join row set structure: */
342
343
344 /* Base-relative index of join row set size */
345
346
347 /* Index of row vector count */
348
349
350 /* Index of table count */
351
352
353 /* Index of segment vector count */
354
355
356 /* Base address of first segment vector */
357
358
359
360 /* End Include Section: EK Join Row Set Parameters */
361
362 /* $ Disclaimer */
363
364 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
365 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
366 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
367 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
368 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
369 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
370 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
371 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
372 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
373 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
374
375 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
376 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
377 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
378 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
379 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
380 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
381
382 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
383 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
384 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
385 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
386
387
388 /* Include Section: EK Operator Codes */
389
390 /* ekopcd.inc Version 1 30-DEC-1994 (NJB) */
391
392
393 /* Within the EK system, operators used in EK queries are */
394 /* represented by integer codes. The codes and their meanings are */
395 /* listed below. */
396
397 /* Relational expressions in EK queries have the form */
398
399 /* <column name> <operator> <value> */
400
401 /* For columns containing numeric values, the operators */
402
403 /* EQ, GE, GT, LE, LT, NE */
404
405 /* may be used; these operators have the same meanings as their */
406 /* Fortran counterparts. For columns containing character values, */
407 /* the list of allowed operators includes those in the above list, */
408 /* and in addition includes the operators */
409
410 /* LIKE, UNLIKE */
411
412 /* which are used to compare strings to a template. In the character */
413 /* case, the meanings of the parameters */
414
415 /* GE, GT, LE, LT */
416
417 /* match those of the Fortran lexical functions */
418
419 /* LGE, LGT, LLE, LLT */
420
421
422 /* The additional unary operators */
423
424 /* ISNULL, NOTNUL */
425
426 /* are used to test whether a value of any type is null. */
427
428
429
430 /* End Include Section: EK Operator Codes */
431
432 /* $ Disclaimer */
433
434 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
435 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
436 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
437 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
438 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
439 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
440 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
441 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
442 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
443 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
444
445 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
446 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
447 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
448 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
449 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
450 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
451
452 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
453 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
454 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
455 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
456
457
458 /* Include Section: EK Query Limit Parameters */
459
460 /* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */
461
462 /* Parameter MAXCON increased to 1000. */
463
464 /* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */
465
466 /* Updated to support SELECT clause. */
467
468
469 /* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */
470
471
472 /* These limits apply to character string queries input to the */
473 /* EK scanner. This limits are part of the EK system's user */
474 /* interface: the values should be advertised in the EK required */
475 /* reading document. */
476
477
478 /* Maximum length of an input query: MAXQRY. This value is */
479 /* currently set to twenty-five 80-character lines. */
480
481
482 /* Maximum number of columns that may be listed in the */
483 /* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */
484
485
486 /* Maximum number of tables that may be listed in the `FROM */
487 /* clause' of a query: MAXTAB. */
488
489
490 /* Maximum number of relational expressions that may be listed */
491 /* in the `constraint clause' of a query: MAXCON. */
492
493 /* This limit applies to a query when it is represented in */
494 /* `normalized form': that is, the constraints have been */
495 /* expressed as a disjunction of conjunctions of relational */
496 /* expressions. The number of relational expressions in a query */
497 /* that has been expanded in this fashion may be greater than */
498 /* the number of relations in the query as orginally written. */
499 /* For example, the expression */
500
501 /* ( ( A LT 1 ) OR ( B GT 2 ) ) */
502 /* AND */
503 /* ( ( C NE 3 ) OR ( D EQ 4 ) ) */
504
505 /* which contains 4 relational expressions, expands to the */
506 /* equivalent normalized constraint */
507
508 /* ( ( A LT 1 ) AND ( C NE 3 ) ) */
509 /* OR */
510 /* ( ( A LT 1 ) AND ( D EQ 4 ) ) */
511 /* OR */
512 /* ( ( B GT 2 ) AND ( C NE 3 ) ) */
513 /* OR */
514 /* ( ( B GT 2 ) AND ( D EQ 4 ) ) */
515
516 /* which contains eight relational expressions. */
517
518
519
520 /* MXJOIN is the maximum number of tables that can be joined. */
521
522
523 /* MXJCON is the maximum number of join constraints allowed. */
524
525
526 /* Maximum number of order-by columns that may be used in the */
527 /* `order-by clause' of a query: MAXORD. MAXORD = 10. */
528
529
530 /* Maximum number of tokens in a query: 500. Tokens are reserved */
531 /* words, column names, parentheses, and values. Literal strings */
532 /* and time values count as single tokens. */
533
534
535 /* Maximum number of numeric tokens in a query: */
536
537
538 /* Maximum total length of character tokens in a query: */
539
540
541 /* Maximum length of literal string values allowed in queries: */
542 /* MAXSTR. */
543
544
545 /* End Include Section: EK Query Limit Parameters */
546
547 /* $ Disclaimer */
548
549 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
550 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
551 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
552 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
553 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
554 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
555 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
556 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
557 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
558 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
559
560 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
561 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
562 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
563 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
564 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
565 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
566
567 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
568 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
569 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
570 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
571
572
573 /* Include Section: EK Encoded Query Internal Parameters */
574
575 /* ekquery.inc Version 3 16-NOV-1995 (NJB) */
576
577 /* Updated to reflect increased value of MAXCON in */
578 /* ekqlimit.inc. */
579
580 /* ekquery.inc Version 2 03-AUG-1995 (NJB) */
581
582 /* Updated to support representation of the SELECT clause. */
583
584
585 /* ekquery.inc Version 1 12-JAN-1995 (NJB) */
586
587
588 /* An encoded EK query is an abstract data type implemented */
589 /* as an integer cell, along with a double precision cell and */
590 /* a character string. The d.p. cell and string contain numeric */
591 /* and string values from the query string represented by the */
592 /* encoded query. */
593
594 /* The parameters in this file are intended for use only by the */
595 /* EK encoded query access routines. Callers of EK routines should */
596 /* not use these parameters. */
597
598 /* The following parameters are indices of specified elements */
599 /* in the integer portion of the encoded query. */
600
601 /* Encoded query architecture type: */
602
603
604 /* `Name resolution' consists of: */
605
606 /* - Verifying existence of tables: any table names listed */
607 /* in the FROM clause of a query must be loaded. */
608
609 /* - Validating table aliases used to qualify column names. */
610
611 /* - Verifying existence of columns and obtaining data types */
612 /* for columns. */
613
614 /* - Setting data type codes for literal values in the encoded */
615 /* query. */
616
617 /* - Checking consistency of operators and operand data types. */
618
619 /* - Making sure unqualified column names are unambiguous. */
620
621 /* - For constraints, mapping the table names used to qualify */
622 /* column names to the ordinal position in the FROM clause */
623 /* of the corresponding table. */
624
625
626 /* Initialization status---this flag indicates whether the encoded */
627 /* query has been initialized. Values are ITRUE or IFALSE. See the */
628 /* include file ekbool.inc for parameter values. */
629
630
631 /* Parse status---this flag indicates whether the parsing operation */
632 /* that produced an encoded query has been completed. Values are */
633 /* ITRUE or IFALSE. */
634
635
636 /* Name resolution status---this flag indicates whether names */
637 /* have been resolved in an encoded query. Values are ITRUE or */
638 /* IFALSE. */
639
640
641 /* Time resolution status---this flag indicates whether time values */
642 /* have been resolved in an encoded query. Time resolution */
643 /* consists of converting strings representing time values to ET. */
644 /* Values of the status are ITRUE or IFALSE. */
645
646
647 /* Semantic check status---this flag indicates whether semantic */
648 /* checking of constraints has been performed. */
649
650
651 /* Number of tables specified in FROM clause: */
652
653
654 /* Number of constraints in query: */
655
656
657 /* A special value is used to indicate the `maximal' constraint--- */
658 /* one that logically cannot be satisfied. If the constraints */
659 /* are equivalent to the maximal constraint, the location EQNCNS */
660 /* is assigned the value EQMXML */
661
662
663 /* Number of constraint conjunctions: */
664
665
666 /* Number of order-by columns: */
667
668
669 /* Number of SELECT columns: */
670
671
672 /* Size of double precision buffer: */
673
674
675 /* `Free' pointer into double precision buffer: */
676
677
678 /* Size of character string buffer: */
679
680
681 /* `Free' pointer into character string buffer: */
682
683
684 /* The following four base pointers will be valid after a query */
685 /* has been parsed: */
686
687 /* Base pointer for SELECT column descriptors: */
688
689
690 /* Base pointer for constraint descriptors: */
691
692
693 /* Base pointer for conjunction sizes: */
694
695
696 /* Base pointer for order-by column descriptors: */
697
698
699 /* After the quantities named above, the integer array contains */
700 /* series of descriptors for tables, constraints, and order-by */
701 /* columns, as well as a list of `conjunction sizes'---that is, */
702 /* the sizes of the groups of constraints that form conjunctions, */
703 /* after the input query has been re-arranged as a disjunction of */
704 /* conjunctions of constraints. */
705
706
707 /* The offsets of specific elements within descriptors are */
708 /* parameterized. The base addresses of the descriptors themselves */
709 /* must be calculated using the counts and sizes of the items */
710 /* preceding them. */
711
712 /* A diagram of the structure of the variable-size portion of the */
713 /* integer array is shown below: */
714
715
716 /* +-------------------------------------+ */
717 /* | Fixed-size portion of encoded query | */
718 /* +-------------------------------------+ */
719 /* | Encoded FROM clause | */
720 /* +-------------------------------------+ */
721 /* | Encoded constraint clause | */
722 /* +-------------------------------------+ */
723 /* | Conjunction sizes | */
724 /* +-------------------------------------+ */
725 /* | Encoded ORDER BY clause | */
726 /* +-------------------------------------+ */
727 /* | Encoded SELECT clause | */
728 /* +-------------------------------------+ */
729
730
731 /* Value Descriptors */
732 /* ---------------- */
733
734 /* In order to discuss the various descriptors below, we'll make use */
735 /* of sub-structures called `value descriptors'. These descriptors */
736 /* come in two flavors: character and double precision. For */
737 /* strings, a descriptor is a set of begin and end pointers that */
738 /* indicate the location of the string in the character portion of an */
739 /* encoded query, along with the begin and end pointers for the */
740 /* corresponding lexeme in the original query. The pointers are set */
741 /* to zero when they are not in use, for example if they refer to an */
742 /* optional lexeme that did not appear in the input query. */
743
744 /* All value descriptors start with a data type indicator; values */
745 /* are from ektype.inc. Integer and time values are referred to */
746 /* by double precision descriptors. */
747
748 /* Parameters for string value descriptor elements: */
749
750
751 /* Numeric value descriptors are similar to those for string values, */
752 /* the difference being that they have only one pointer to the value */
753 /* they represent. This pointer is the index of the value in the */
754 /* encoded query's numeric buffer. */
755
756
757 /* All value descriptors have the same size. In order to allow */
758 /* table descriptors to have the same size as value descriptors, */
759 /* we include an extra element in the descriptor. */
760
761
762 /* Column Descriptors */
763 /* ----------------- */
764
765 /* Each column descriptor consists of a character descriptor for the */
766 /* name of the column, followed by an index, which gives the ordinal */
767 /* position of the column in the logical table to which the column */
768 /* belongs. The index element is filled in during name resolution. */
769
770
771 /* Table Descriptors */
772 /* ----------------- */
773
774 /* Each table descriptor consists of a character descriptor for the */
775 /* name of the table, followed by an index, which gives the ordinal */
776 /* position of the table in the FROM clause in the original query. */
777 /* The index element is filled in during name resolution. Aliases */
778 /* and table names have identical descriptor structures. */
779
780
781 /* Constraint descriptors */
782 /* ------------------ */
783
784 /* Each constraint is characterized by: */
785
786 /* - A code indicating whether the constraint compares values */
787 /* in two columns or the value in a column and a literal */
788 /* value. The values of this element are EQCOL and EQVAL. */
789
790
791
792 /* - A descriptor for the table used to qualify the */
793 /* column name on the left side of the constraint. */
794
795
796 /* - A character value descriptor for the column name on the left */
797 /* side of the query. */
798
799
800 /* - An operator code indicating the relational operator used */
801 /* in the constraint. */
802
803
804 /* If the constraint compares values from two columns, the */
805 /* next items are table and column name descriptors that apply to */
806 /* the column named on the right side of the relational operator. */
807
808
809 /* If the constraint has a literal value on the right side, the */
810 /* operator code is followed by... */
811
812 /* - a value descriptor. */
813
814
815 /* - Size of a constraint descriptor: */
816
817
818 /* Conjunction sizes */
819 /* ----------------- */
820
821 /* The size of each conjunction of constraints occupies a single */
822 /* integer. */
823
824
825
826
827 /* Order-by Column Descriptors */
828 /* --------------------------- */
829
830 /* Each order-by column descriptor contains descriptors for */
831 /* the table containing the column and for the name of the column */
832 /* itself; one additional element is used to indicate the direction */
833 /* of the ordering (ascending vs descending). */
834
835
836 /* - The last integer in the descriptor indicates whether the */
837 /* order direction is ascending or descending. */
838
839
840 /* - Size of an order-by column descriptor: */
841
842
843 /* Codes indicating sense of ordering (ascending vs descending): */
844
845
846 /* SELECT Column Descriptors */
847 /* --------------------------- */
848
849 /* Each SELECT column descriptor contains descriptors for */
850 /* the table containing the column and for the name of the column */
851 /* itself. */
852
853
854 /* - Size of a SELECT column descriptor: */
855
856
857 /* Miscellaneous parameters: */
858
859
860 /* EQIMIN is the minimum size of the integer portion of */
861 /* an encoded query. EQIMIN depends on the parameters */
862
863 /* MAXTAB */
864 /* MAXCON */
865 /* MAXORD */
866 /* MAXSEL */
867
868 /* all of which are declared in the include file ekqlimit.inc. */
869 /* The functional definition of EQIMIN is: */
870
871 /* INTEGER EQIMIN */
872 /* PARAMETER ( EQIMIN = EQVBAS */
873 /* . + MAXTAB * EQVDSZ * 2 */
874 /* . + MAXCON * EQCDSZ */
875 /* . + MAXCON */
876 /* . + MAXORD * EQODSZ */
877 /* . + MAXSEL * EQSDSZ ) */
878
879
880 /* End Include Section: EK Encoded Query Internal Parameters */
881
882 /* $ Disclaimer */
883
884 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
885 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
886 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
887 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
888 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
889 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
890 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
891 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
892 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
893 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
894
895 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
896 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
897 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
898 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
899 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
900 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
901
902 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
903 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
904 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
905 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
906
907
908 /* Include Section: EK Segment Descriptor Parameters */
909
910 /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
911
912
913 /* All `base addresses' referred to below are the addresses */
914 /* *preceding* the item the base applies to. This convention */
915 /* enables simplied address calculations in many cases. */
916
917 /* Size of segment descriptor. Note: the include file ekcoldsc.inc */
918 /* must be updated if this parameter is changed. The parameter */
919 /* CDOFF in that file should be kept equal to SDSCSZ. */
920
921
922 /* Index of the segment type code: */
923
924
925 /* Index of the segment's number. This number is the segment's */
926 /* index in the list of segments contained in the EK to which */
927 /* the segment belongs. */
928
929
930 /* Index of the DAS integer base address of the segment's integer */
931 /* meta-data: */
932
933
934 /* Index of the DAS character base address of the table name: */
935
936
937 /* Index of the segment's column count: */
938
939
940 /* Index of the segment's record count: */
941
942
943 /* Index of the root page number of the record tree: */
944
945
946 /* Index of the root page number of the character data page tree: */
947
948
949 /* Index of the root page number of the double precision data page */
950 /* tree: */
951
952
953 /* Index of the root page number of the integer data page tree: */
954
955
956 /* Index of the `modified' flag: */
957
958
959 /* Index of the `initialized' flag: */
960
961
962 /* Index of the shadowing flag: */
963
964
965 /* Index of the companion file handle: */
966
967
968 /* Index of the companion segment number: */
969
970
971 /* The next three items are, respectively, the page numbers of the */
972 /* last character, d.p., and integer data pages allocated by the */
973 /* segment: */
974
975
976 /* The next three items are, respectively, the page-relative */
977 /* indices of the last DAS word in use in the segment's */
978 /* last character, d.p., and integer data pages: */
979
980
981 /* Index of the DAS character base address of the column name list: */
982
983
984 /* The last descriptor element is reserved for future use. No */
985 /* parameter is defined to point to this location. */
986
987
988 /* End Include Section: EK Segment Descriptor Parameters */
989
990 /* $ Disclaimer */
991
992 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
993 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
994 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
995 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
996 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
997 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
998 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
999 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
1000 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
1001 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
1002
1003 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
1004 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
1005 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
1006 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
1007 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
1008 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
1009
1010 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
1011 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
1012 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
1013 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
1014
1015
1016 /* Include Section: EK Data Types */
1017
1018 /* ektype.inc Version 1 27-DEC-1994 (NJB) */
1019
1020
1021 /* Within the EK system, data types of EK column contents are */
1022 /* represented by integer codes. The codes and their meanings */
1023 /* are listed below. */
1024
1025 /* Integer codes are also used within the DAS system to indicate */
1026 /* data types; the EK system makes no assumptions about compatibility */
1027 /* between the codes used here and those used in the DAS system. */
1028
1029
1030 /* Character type: */
1031
1032
1033 /* Double precision type: */
1034
1035
1036 /* Integer type: */
1037
1038
1039 /* `Time' type: */
1040
1041 /* Within the EK system, time values are represented as ephemeris */
1042 /* seconds past J2000 (TDB), and double precision numbers are used */
1043 /* to store these values. However, since time values require special */
1044 /* treatment both on input and output, and since the `TIME' column */
1045 /* has a special role in the EK specification and code, time values */
1046 /* are identified as a type distinct from double precision numbers. */
1047
1048
1049 /* End Include Section: EK Data Types */
1050
1051 /* $ Brief_I/O */
1052
1053 /* Variable I/O Description */
1054 /* -------- --- -------------------------------------------------- */
1055 /* NJRS I Number of join row sets in union. */
1056 /* UBASES I Base addresses of join row sets of union. */
1057 /* NORDER I Number of order-by columns. */
1058 /* OTABS I Order-by table indices relative to FROM clause. */
1059 /* OCOLS I Order-by column indices. */
1060 /* OELTS I Order-by element indices. */
1061 /* SENSES I Order directions. */
1062 /* STHAN I Handles of loaded files from segment table. */
1063 /* STSDSC I Array of descriptors of loaded segments. */
1064 /* STDTPT I Array of pointers to column descriptors. */
1065 /* DTPOOL I Column descriptor table pool. */
1066 /* DTDSCS I Column descriptor table. */
1067 /* ORDBAS O Scratch area base address for order vector. */
1068
1069 /* $ Detailed_Input */
1070
1071 /* NJRS, */
1072 /* UBASES are, respectively, the number of join row sets in */
1073 /* the input join row set union, and the base */
1074 /* addresses of those join row sets. */
1075
1076 /* NORDER is the number of order-by columns used to define */
1077 /* the order relation used for sorting. */
1078
1079 /* OTABS is an array of indices identifying the parent */
1080 /* tables of the order-by columns. These indices */
1081 /* are the ordinal positions of the parent tables */
1082 /* in the FROM clause of the query to which the */
1083 /* input joint row set corresponds. */
1084
1085 /* OCOLS is an array of indices identifying the order-by */
1086 /* columns. These indices are the ordinal positions */
1087 /* of the columns in their virtual parent tables. */
1088 /* The order of columns in virtual tables is set */
1089 /* when EKs are loaded by the routine EKLEF. The */
1090 /* Nth element of OCOLS applies to the Nth order-by */
1091 /* column. */
1092
1093 /* OELTS is an array of element indices identifying the */
1094 /* order-by column entry elements to use when making */
1095 /* order comparisons. These indices are ignored for */
1096 /* scalar order-by columns, but must be set properly */
1097 /* for vector-valued order-by columns. For example, */
1098 /* if an order-by column has size 5, one could make */
1099 /* order comparisons using the third elements of */
1100 /* entries in this column. The Nth element of OELTS */
1101 /* applies to the Nth order-by column. */
1102
1103 /* SENSES is an array of parameters indicating the ordering */
1104 /* sense for each order-by column. An ordering sense */
1105 /* can be ascending (the default) or descending. The */
1106 /* values indicating these senses are EQASND and */
1107 /* EQDSND respectively. These parameters are defined */
1108 /* in the include file ekquery.inc. The Nth element */
1109 /* of SENSES applies to the Nth order-by column. */
1110
1111 /* STHAN is an array of EK handles corresponding to loaded */
1112 /* segments. STHAN is expected to be the array of */
1113 /* the same name maintained by EKQMGR. */
1114
1115 /* STSDSC is an array of descriptors of loaded segments. */
1116 /* STSDSC is expected to be the array of the same name */
1117 /* maintained by EKQMGR. */
1118
1119 /* STDTPT is an array of pointers that map segments to lists */
1120 /* of column descriptors in the column descriptor */
1121 /* pool. The Nth element of STDTPT is the head node */
1122 /* number for the column descriptor list of the Nth */
1123 /* loaded segment. The column descriptor list is */
1124 /* indexed by the linked list pool DTPOOL. STDTPT is */
1125 /* expected to be the array of the same name */
1126 /* maintained by EKQMGR. */
1127
1128 /* DTPOOL is a linked list pool used to index the column */
1129 /* descriptor array DTDSCS. DTPOOL is expected to be */
1130 /* the array of the same name maintained by EKQMGR. */
1131
1132 /* DTDSCS is an array of column descriptors for each loaded */
1133 /* column. There is a separate descriptor for each */
1134 /* column in each segment. The Nth node of DTPOOL */
1135 /* is considered to point to the Nth element of */
1136 /* DTDSCS. DTDSCS is expected to be the array of the */
1137 /* same name maintained by EKQMGR. */
1138
1139 /* $ Detailed_Output */
1140
1141 /* ORDBAS is the scratch area base address of the order */
1142 /* vector created by this routine. This address is */
1143 /* the predecessor of the first scratch area address */
1144 /* occupied by the order vector. */
1145
1146 /* The order vector indicates the order of the row */
1147 /* vectors of the input join row set union, where the */
1148 /* order relation is defined by the order-by columns, */
1149 /* column entry element indices, and order senses. */
1150
1151 /* $ Parameters */
1152
1153 /* None. */
1154
1155 /* $ Exceptions */
1156
1157 /* 1) If the number of order-by columns NORDER is non-positive, */
1158 /* the error SPICE(INVALIDCOUNT) is signaled. */
1159
1160 /* 2) If an I/O error occurs while attempting to create an order */
1161 /* vector for the specified row set, the error will be diagnosed */
1162 /* by routines called by this routine. */
1163
1164 /* 3) If the first order-by column descriptor in the list has */
1165 /* an invalid data type code, the error SPICE(INVALIDTYPE) */
1166 /* is signaled. */
1167 /* $ Files */
1168
1169 /* The input join row set is presumed to refer to EK files currently */
1170 /* loaded via EKLEF. */
1171
1172 /* $ Particulars */
1173
1174 /* This routine writes to the EK scratch area an order vector for the */
1175 /* specified join row set union. The order vector is written in */
1176 /* ascending order starting at the location following ORDBAS. The */
1177 /* order relation is defined by the order-by columns, column entry */
1178 /* element indices, and order senses. */
1179
1180 /* $ Examples */
1181
1182 /* See EKGC. */
1183
1184 /* $ Restrictions */
1185
1186 /* 1) This routine modifies the EK scratch area, and therefore */
1187 /* should not be used by routines outside of the EK system. */
1188
1189 /* $ Literature_References */
1190
1191 /* None. */
1192
1193 /* $ Author_and_Institution */
1194
1195 /* N.J. Bachman (JPL) */
1196
1197 /* $ Version */
1198
1199 /* - SPICELIB Version 2.2.0, 07-FEB-2015 (NJB) */
1200
1201 /* Now uses ERRHAN to insert DAS file name into */
1202 /* long error messages. */
1203
1204 /* - SPICELIB Version 2.1.0, 07-AUG-2006 (NJB) */
1205
1206 /* Bug fix: added initialization of variable PRVBAS to support */
1207 /* operation under the Macintosh Intel Fortran */
1208 /* compiler. Note that this bug did not affect */
1209 /* operation of this routine on other platforms. */
1210
1211 /* - SPICELIB Version 2.0.0, 09-SEP-2005 (NJB) */
1212
1213 /* Increased buffer size parameter LIMIT1 from 25K to 250K. */
1214 /* Declared large buffers SAVED to prevent memory errors */
1215 /* under CYGWIN. */
1216
1217 /* - SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */
1218
1219 /* Removed several redundant calls to CHKIN */
1220
1221 /* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */
1222
1223 /* -& */
1224 /* $ Revisions */
1225
1226 /* - SPICELIB Version 2.1.0, 07-AUG-2006 (NJB) */
1227
1228 /* Bug fix: added initialization of variable PRVBAS to support */
1229 /* operation under the Macintosh Intel Fortran */
1230 /* compiler. Note that this bug did not affect */
1231 /* operation of this routine on other platforms. The */
1232 /* statement referencing the uninitialized variable */
1233 /* was: */
1234
1235 /* IF ( ( I .EQ. 1 ) .OR. ( SGVBAS .NE. PRVBAS ) ) THEN */
1236
1237 /* In the previous version of the code, PRVBAS is uninitialized */
1238 /* when the loop counter I is 1. PRVBAS *is* initialized when I */
1239 /* is greater than 1, so the logical value of the IF expression */
1240 /* is not affected by the lack of proper initialization. */
1241
1242 /* However, the Intel Fortran compiler for the Mac flags a runtime */
1243 /* error when the above code is exercised. So PRVBAS is now */
1244 /* initialized prior to the above IF statement. */
1245
1246
1247 /* - SPICELIB Version 2.0.0, 08-SEP-2005 (NJB) */
1248
1249 /* Increased buffer size parameter LIMIT1 from 25K to 250K. */
1250 /* Declared large buffers SAVED to prevent memory errors */
1251 /* under CYGWIN. The saved buffers are */
1252
1253 /* CDAT */
1254 /* DDAT */
1255 /* IDAT */
1256 /* NF */
1257 /* ORDVEC */
1258
1259 /* -& */
1260
1261 /* SPICELIB functions */
1262
1263
1264 /* Other functions */
1265
1266
1267 /* Other local parameters */
1268
1269
1270 /* Local variables */
1271
1272
1273 /* Saved variables */
1274
1275 /* The following variables are saved in order to prevent */
1276 /* memory errors under Cygwin and in shared object libraries */
1277 /* under various Unix systems. */
1278
1279
1280 /* Statement functions */
1281
1282
1283
1284 /* The following functions test whether two column entries */
1285 /* are equal. In the integer and d.p. cases, the test is conclusive. */
1286 /* In the character case, the test indicates whether the initial */
1287 /* substrings consisting of the first INISUB characters of each of */
1288 /* the two entries are equal. */
1289
1290
1291 /* The following functions indicate whether the first of two column */
1292 /* entries is less than or equal to the second. In the integer and */
1293 /* d.p. cases, the test is conclusive. In the character case, the */
1294 /* test indicates whether the initial substring consisting of the */
1295 /* first INISUB characters of the first entry is less than or equal */
1296 /* to the corresponding initial substring of length INISUB of the */
1297 /* second entry. */
1298
1299
1300 /* Standard SPICE error handling. */
1301
1302 if (return_()) {
1303 return 0;
1304 } else {
1305 chkin_("ZZEKJSRT", (ftnlen)8);
1306 }
1307
1308 /* If there are no order-by columns, that's an error. */
1309
1310 if (*norder < 1) {
1311 setmsg_("Number of order-by columns must be positive but was #.", (
1312 ftnlen)54);
1313 errint_("#", norder, (ftnlen)1);
1314 sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
1315 chkout_("ZZEKJSRT", (ftnlen)8);
1316 return 0;
1317 }
1318
1319 /* We split the sorting job up into two cases: */
1320
1321 /* 1) If the number of rows to be sorted is not too large, */
1322 /* we can gain speed by reading data from the primary */
1323 /* order-by column into memory and sorting the row number */
1324 /* array in memory. */
1325
1326 /* 2) If there's too much data for option (1) to handle, */
1327 /* we just read data from the order-by columns as needed. */
1328 /* This algorithm is simple, but very slow, since many */
1329 /* DAS reads of individual column entries are required. */
1330
1331
1332 /* Find out how many rows are in the join row set union. */
1333
1334 nrows = 0;
1335 i__1 = *njrs;
1336 for (i__ = 1; i__ <= i__1; ++i__) {
1337 nrloc = ubases[i__ - 1] + 2;
1338 zzeksrd_(&nrloc, &nrloc, &nr);
1339 nrows += nr;
1340 }
1341
1342 /* Get the number of tables in the cartesian product represented */
1343 /* by the join row set union. The number of tables in the first */
1344 /* join row set suffices. */
1345
1346 tabloc = ubases[0] + 3;
1347 zzeksrd_(&tabloc, &tabloc, &ntab);
1348 svsize = ntab;
1349 rvsize = ntab + 1;
1350
1351 /* We can get the data types of the order-by columns from the */
1352 /* segment vector of the first row vector in the first join row set. */
1353 /* Initialize addressing in the join row set union so we can look up */
1354 /* the locations of these vectors. */
1355
1356 zzekvset_(njrs, ubases);
1357 zzekvcal_(&c__1, &rwvbas, &sgvbas);
1358 i__1 = sgvbas + 1;
1359 i__2 = sgvbas + svsize;
1360 zzeksrd_(&i__1, &i__2, segvec);
1361 tprime = otabs[0];
1362 cprime = ocols[0];
1363 seg = segvec[(i__1 = tprime - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("segv"
1364 "ec", i__1, "zzekjsrt_", (ftnlen)534)];
1365 colptr = stdtpt[seg - 1];
1366 i__1 = cprime;
1367 for (i__ = 2; i__ <= i__1; ++i__) {
1368 colptr = lnknxt_(&colptr, dtpool);
1369 }
1370 dtype = dtdscs[colptr * 11 - 10];
1371 if (nrows <= 250000) {
1372
1373 /* Case 1. */
1374
1375 /* We have a small enough quantity of data that we may be able */
1376 /* to speed up sorting by using memory. Here's the plan: */
1377
1378 /* We'll read data for the primary order-by column into memory. */
1379 /* The `primary' column is the one whose index appears first */
1380 /* in the input list of column indices. We'll also maintain a */
1381 /* null flag array for the primary column. If we can figure out */
1382 /* the order relation between two rows by looking at entries in */
1383 /* the primary order-by column, fine. Otherwise, we let ZZEKVCMP */
1384 /* perform the comparison. */
1385
1386 /* We'll sort the set of row vector numbers of the matching rows */
1387 /* in parallel with our data sort. */
1388
1389 /* Character columns present a special case: their string length */
1390 /* can get pretty big, and it could take a lot of memory to store */
1391 /* their column entries. We compromise here: we store only the */
1392 /* first INISUB chararacters of each character column entry. If */
1393 /* we can't decide the order of two strings based on these initial */
1394 /* substrings, we let ZZEKVCMP handle the matter. */
1395
1396 /* Read the primary column data. Keep track of whether we've */
1397 /* truncated any strings. */
1398
1399 trunc = FALSE_;
1400 prvbas = -1;
1401 i__1 = nrows;
1402 for (i__ = 1; i__ <= i__1; ++i__) {
1403 zzekvcal_(&i__, &rwvbas, &sgvbas);
1404 if (i__ == 1 || sgvbas != prvbas) {
1405 i__2 = sgvbas + 1;
1406 i__3 = sgvbas + svsize;
1407 zzeksrd_(&i__2, &i__3, segvec);
1408 seg = segvec[(i__2 = tprime - 1) < 10 && 0 <= i__2 ? i__2 :
1409 s_rnge("segvec", i__2, "zzekjsrt_", (ftnlen)585)];
1410 handle = sthan[seg - 1];
1411 colptr = stdtpt[seg - 1];
1412 i__2 = cprime;
1413 for (j = 2; j <= i__2; ++j) {
1414 colptr = lnknxt_(&colptr, dtpool);
1415 }
1416 }
1417 i__2 = rwvbas + 1;
1418 i__3 = rwvbas + rvsize;
1419 zzeksrd_(&i__2, &i__3, rowvec);
1420 row = rowvec[(i__2 = tprime - 1) < 11 && 0 <= i__2 ? i__2 :
1421 s_rnge("rowvec", i__2, "zzekjsrt_", (ftnlen)598)];
1422 eltidx = oelts[cprime - 1];
1423 if (dtype == 1) {
1424 zzekrsc_(&handle, &stsdsc[seg * 24 - 24], &dtdscs[colptr * 11
1425 - 11], &row, &eltidx, &cvlen, cdat + (((i__2 = i__ -
1426 1) < 250000 && 0 <= i__2 ? i__2 : s_rnge("cdat", i__2,
1427 "zzekjsrt_", (ftnlen)604)) << 5), &null, &found, (
1428 ftnlen)32);
1429 if (! found) {
1430 setmsg_("EK = #; SEG = #; ROW = #; COLIDX = #; ELT = #; "
1431 "column entry elt was not found.", (ftnlen)78);
1432 errhan_("#", &handle, (ftnlen)1);
1433 errint_("#", &seg, (ftnlen)1);
1434 errint_("#", &row, (ftnlen)1);
1435 errint_("#", &dtdscs[colptr * 11 - 3], (ftnlen)1);
1436 errint_("#", &eltidx, (ftnlen)1);
1437 sigerr_("SPICE(BUG)", (ftnlen)10);
1438 chkout_("ZZEKJSRT", (ftnlen)8);
1439 return 0;
1440 }
1441 trunc = trunc || cvlen > 32;
1442 } else if (dtype == 2 || dtype == 4) {
1443 zzekrsd_(&handle, &stsdsc[seg * 24 - 24], &dtdscs[colptr * 11
1444 - 11], &row, &eltidx, &ddat[(i__2 = i__ - 1) < 250000
1445 && 0 <= i__2 ? i__2 : s_rnge("ddat", i__2, "zzekjsrt_"
1446 , (ftnlen)636)], &null, &found);
1447 if (! found) {
1448 setmsg_("EK = #; SEG = #; ROW = #; COLIDX = #; ELT = #; "
1449 "column entry elt was not found.", (ftnlen)78);
1450 errhan_("#", &handle, (ftnlen)1);
1451 errint_("#", &seg, (ftnlen)1);
1452 errint_("#", &row, (ftnlen)1);
1453 errint_("#", &dtdscs[colptr * 11 - 3], (ftnlen)1);
1454 errint_("#", &eltidx, (ftnlen)1);
1455 sigerr_("SPICE(BUG)", (ftnlen)10);
1456 chkout_("ZZEKJSRT", (ftnlen)8);
1457 return 0;
1458 }
1459 } else if (dtype == 3) {
1460 zzekrsi_(&handle, &stsdsc[seg * 24 - 24], &dtdscs[colptr * 11
1461 - 11], &row, &eltidx, &idat[(i__2 = i__ - 1) < 250000
1462 && 0 <= i__2 ? i__2 : s_rnge("idat", i__2, "zzekjsrt_"
1463 , (ftnlen)666)], &null, &found);
1464 if (! found) {
1465 setmsg_("EK = #; SEG = #; ROW = #; COLIDX = #; ELT = #; "
1466 "column entry elt was not found.", (ftnlen)78);
1467 errhan_("#", &handle, (ftnlen)1);
1468 errint_("#", &seg, (ftnlen)1);
1469 errint_("#", &row, (ftnlen)1);
1470 errint_("#", &dtdscs[colptr * 11 - 3], (ftnlen)1);
1471 errint_("#", &eltidx, (ftnlen)1);
1472 sigerr_("SPICE(BUG)", (ftnlen)10);
1473 chkout_("ZZEKJSRT", (ftnlen)8);
1474 return 0;
1475 }
1476 } else {
1477
1478 /* We must have a bogus column descriptor. */
1479
1480 setmsg_("Unrecognized data type # for first column.", (ftnlen)
1481 42);
1482 errint_("#", &dtype, (ftnlen)1);
1483 sigerr_("SPICE(INVALIDTYPE)", (ftnlen)18);
1484 chkout_("ZZEKJSRT", (ftnlen)8);
1485 return 0;
1486 }
1487
1488 /* Set the character null flag for the current column entry. */
1489
1490 if (null) {
1491 *(unsigned char *)&nf[(i__2 = i__ - 1) < 250000 && 0 <= i__2 ?
1492 i__2 : s_rnge("nf", i__2, "zzekjsrt_", (ftnlen)710)]
1493 = 'T';
1494 } else {
1495 *(unsigned char *)&nf[(i__2 = i__ - 1) < 250000 && 0 <= i__2 ?
1496 i__2 : s_rnge("nf", i__2, "zzekjsrt_", (ftnlen)712)]
1497 = 'F';
1498 }
1499 prvbas = sgvbas;
1500 }
1501
1502 /* Initialize the order vector. */
1503
1504 i__1 = nrows;
1505 for (i__ = 1; i__ <= i__1; ++i__) {
1506 ordvec[(i__2 = i__ - 1) < 250000 && 0 <= i__2 ? i__2 : s_rnge(
1507 "ordvec", i__2, "zzekjsrt_", (ftnlen)724)] = i__;
1508 }
1509
1510 /* At this point, we've read in the data for the primary order-by */
1511 /* column, and also have set the null flag array for the column. */
1512 /* We're ready to proceed with our sort. */
1513
1514 gap = nrows / 2;
1515 while(gap > 0) {
1516 i__1 = nrows;
1517 for (i__ = gap + 1; i__ <= i__1; ++i__) {
1518 j = i__ - gap;
1519 while(j > 0) {
1520 jg = j + gap;
1521
1522 /* Compare the Jth and JGth rows of the row set. The */
1523 /* logical JLE is TRUE when the Jth element is less than */
1524 /* or equal to the JGth. If the Jth and JGth elements */
1525 /* compare equal, and there is more than one order-by */
1526 /* column or if we've truncated string data, we'll have */
1527 /* to go on and make a conclusive test. Otherwise, we */
1528 /* can set JLE based on the data we've read. */
1529
1530 /* Set the data array indices of the Jth and JGth */
1531 /* elements, as indicated by the order vector. */
1532
1533 rj = ordvec[(i__2 = j - 1) < 250000 && 0 <= i__2 ? i__2 :
1534 s_rnge("ordvec", i__2, "zzekjsrt_", (ftnlen)755)];
1535 rjg = ordvec[(i__2 = jg - 1) < 250000 && 0 <= i__2 ? i__2
1536 : s_rnge("ordvec", i__2, "zzekjsrt_", (ftnlen)756)
1537 ];
1538 nfj = *(unsigned char *)&nf[(i__2 = rj - 1) < 250000 && 0
1539 <= i__2 ? i__2 : s_rnge("nf", i__2, "zzekjsrt_", (
1540 ftnlen)758)] == 'T';
1541 nfjg = *(unsigned char *)&nf[(i__2 = rjg - 1) < 250000 &&
1542 0 <= i__2 ? i__2 : s_rnge("nf", i__2, "zzekjsrt_",
1543 (ftnlen)759)] == 'T';
1544
1545 /* Start out hoping for the best: that we won't have */
1546 /* to do a brute-force comparison. */
1547
1548 brute = FALSE_;
1549 if (dtype == 3) {
1550 if (*norder == 1) {
1551
1552 /* We can make a decision based on the data in */
1553 /* memory. */
1554
1555 if (senses[0] == 0) {
1556 jle = nfj || ! (nfj || nfjg) && idat[(i__2 =
1557 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1558 s_rnge("idat", i__2, "zzekjsrt_", (
1559 ftnlen)777)] <= idat[(i__3 = rjg - 1)
1560 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1561 "idat", i__3, "zzekjsrt_", (ftnlen)
1562 777)];
1563 } else {
1564 jle = nfjg || ! (nfj || nfjg) && idat[(i__2 =
1565 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1566 s_rnge("idat", i__2, "zzekjsrt_", (
1567 ftnlen)779)] >= idat[(i__3 = rjg - 1)
1568 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1569 "idat", i__3, "zzekjsrt_", (ftnlen)
1570 779)];
1571 }
1572 } else if (! (nfj && nfjg || ! (nfj || nfjg) && idat[(
1573 i__2 = rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1574 s_rnge("idat", i__2, "zzekjsrt_", (ftnlen)783)
1575 ] == idat[(i__3 = rjg - 1) < 250000 && 0 <=
1576 i__3 ? i__3 : s_rnge("idat", i__3, "zzekjsrt_"
1577 , (ftnlen)783)])) {
1578
1579 /* If the items we're comparing are unequal, we can */
1580 /* still make a decision. */
1581
1582 if (senses[0] == 0) {
1583 jle = nfj || ! (nfj || nfjg) && idat[(i__2 =
1584 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1585 s_rnge("idat", i__2, "zzekjsrt_", (
1586 ftnlen)791)] <= idat[(i__3 = rjg - 1)
1587 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1588 "idat", i__3, "zzekjsrt_", (ftnlen)
1589 791)];
1590 } else {
1591 jle = nfjg || ! (nfj || nfjg) && idat[(i__2 =
1592 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1593 s_rnge("idat", i__2, "zzekjsrt_", (
1594 ftnlen)793)] >= idat[(i__3 = rjg - 1)
1595 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1596 "idat", i__3, "zzekjsrt_", (ftnlen)
1597 793)];
1598 }
1599 } else {
1600
1601 /* Otherwise, we'll have to look at values in the */
1602 /* other order-by columns. Get the segment and */
1603 /* row vectors to be compared. */
1604
1605 brute = TRUE_;
1606 }
1607 } else if (dtype == 2 || dtype == 4) {
1608
1609 /* The D.P. case parallels the integer case. */
1610
1611 if (*norder == 1) {
1612 if (senses[0] == 0) {
1613 jle = nfj || ! (nfj || nfjg) && ddat[(i__2 =
1614 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1615 s_rnge("ddat", i__2, "zzekjsrt_", (
1616 ftnlen)819)] <= ddat[(i__3 = rjg - 1)
1617 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1618 "ddat", i__3, "zzekjsrt_", (ftnlen)
1619 819)];
1620 } else {
1621 jle = nfjg || ! (nfj || nfjg) && ddat[(i__2 =
1622 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1623 s_rnge("ddat", i__2, "zzekjsrt_", (
1624 ftnlen)821)] >= ddat[(i__3 = rjg - 1)
1625 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1626 "ddat", i__3, "zzekjsrt_", (ftnlen)
1627 821)];
1628 }
1629 } else if (! (nfj && nfjg || ! (nfj || nfjg) && ddat[(
1630 i__2 = rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1631 s_rnge("ddat", i__2, "zzekjsrt_", (ftnlen)825)
1632 ] == ddat[(i__3 = rjg - 1) < 250000 && 0 <=
1633 i__3 ? i__3 : s_rnge("ddat", i__3, "zzekjsrt_"
1634 , (ftnlen)825)])) {
1635 if (senses[0] == 0) {
1636 jle = nfj || ! (nfj || nfjg) && ddat[(i__2 =
1637 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1638 s_rnge("ddat", i__2, "zzekjsrt_", (
1639 ftnlen)830)] <= ddat[(i__3 = rjg - 1)
1640 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1641 "ddat", i__3, "zzekjsrt_", (ftnlen)
1642 830)];
1643 } else {
1644 jle = nfjg || ! (nfj || nfjg) && ddat[(i__2 =
1645 rj - 1) < 250000 && 0 <= i__2 ? i__2 :
1646 s_rnge("ddat", i__2, "zzekjsrt_", (
1647 ftnlen)832)] >= ddat[(i__3 = rjg - 1)
1648 < 250000 && 0 <= i__3 ? i__3 : s_rnge(
1649 "ddat", i__3, "zzekjsrt_", (ftnlen)
1650 832)];
1651 }
1652 } else {
1653
1654 /* Otherwise, we'll have to look at values in the */
1655 /* other order-by columns. Get the segment and */
1656 /* row vectors to be compared. */
1657
1658 brute = TRUE_;
1659 }
1660 } else {
1661
1662 /* In the character case where there is one order-by */
1663 /* column, equality is a problem unless no truncation */
1664 /* occurred. */
1665
1666 if (*norder == 1 && ! trunc) {
1667 if (senses[0] == 0) {
1668 s_copy(ch__1, cdat + (((i__2 = rj - 1) <
1669 250000 && 0 <= i__2 ? i__2 : s_rnge(
1670 "cdat", i__2, "zzekjsrt_", (ftnlen)
1671 858)) << 5), (ftnlen)32, (ftnlen)32);
1672 s_copy(ch__2, cdat + (((i__3 = rjg - 1) <
1673 250000 && 0 <= i__3 ? i__3 : s_rnge(
1674 "cdat", i__3, "zzekjsrt_", (ftnlen)
1675 858)) << 5), (ftnlen)32, (ftnlen)32);
1676 jle = nfj || ! (nfj || nfjg) && s_cmp(ch__1,
1677 ch__2, (ftnlen)32, (ftnlen)32) <= 0;
1678 } else {
1679 s_copy(ch__1, cdat + (((i__2 = rj - 1) <
1680 250000 && 0 <= i__2 ? i__2 : s_rnge(
1681 "cdat", i__2, "zzekjsrt_", (ftnlen)
1682 860)) << 5), (ftnlen)32, (ftnlen)32);
1683 s_copy(ch__2, cdat + (((i__3 = rjg - 1) <
1684 250000 && 0 <= i__3 ? i__3 : s_rnge(
1685 "cdat", i__3, "zzekjsrt_", (ftnlen)
1686 860)) << 5), (ftnlen)32, (ftnlen)32);
1687 jle = nfjg || ! (nfj || nfjg) && s_cmp(ch__1,
1688 ch__2, (ftnlen)32, (ftnlen)32) >= 0;
1689 }
1690 } else /* if(complicated condition) */ {
1691 s_copy(ch__1, cdat + (((i__2 = rj - 1) < 250000 &&
1692 0 <= i__2 ? i__2 : s_rnge("cdat", i__2,
1693 "zzekjsrt_", (ftnlen)864)) << 5), (ftnlen)
1694 32, (ftnlen)32);
1695 s_copy(ch__2, cdat + (((i__3 = rjg - 1) < 250000
1696 && 0 <= i__3 ? i__3 : s_rnge("cdat", i__3,
1697 "zzekjsrt_", (ftnlen)864)) << 5), (
1698 ftnlen)32, (ftnlen)32);
1699 if (! (nfj && nfjg || ! (nfj || nfjg) && s_cmp(
1700 ch__1, ch__2, (ftnlen)32, (ftnlen)32) ==
1701 0)) {
1702
1703 /* If the items we're comparing are unequal, we can */
1704 /* still make a decision. */
1705
1706 if (senses[0] == 0) {
1707 s_copy(ch__1, cdat + (((i__2 = rj - 1) <
1708 250000 && 0 <= i__2 ? i__2 :
1709 s_rnge("cdat", i__2, "zzekjsrt_",
1710 (ftnlen)872)) << 5), (ftnlen)32, (
1711 ftnlen)32);
1712 s_copy(ch__2, cdat + (((i__3 = rjg - 1) <
1713 250000 && 0 <= i__3 ? i__3 :
1714 s_rnge("cdat", i__3, "zzekjsrt_",
1715 (ftnlen)872)) << 5), (ftnlen)32, (
1716 ftnlen)32);
1717 jle = nfj || ! (nfj || nfjg) && s_cmp(
1718 ch__1, ch__2, (ftnlen)32, (ftnlen)
1719 32) <= 0;
1720 } else {
1721 s_copy(ch__1, cdat + (((i__2 = rj - 1) <
1722 250000 && 0 <= i__2 ? i__2 :
1723 s_rnge("cdat", i__2, "zzekjsrt_",
1724 (ftnlen)874)) << 5), (ftnlen)32, (
1725 ftnlen)32);
1726 s_copy(ch__2, cdat + (((i__3 = rjg - 1) <
1727 250000 && 0 <= i__3 ? i__3 :
1728 s_rnge("cdat", i__3, "zzekjsrt_",
1729 (ftnlen)874)) << 5), (ftnlen)32, (
1730 ftnlen)32);
1731 jle = nfjg || ! (nfj || nfjg) && s_cmp(
1732 ch__1, ch__2, (ftnlen)32, (ftnlen)
1733 32) >= 0;
1734 }
1735 } else {
1736
1737 /* Otherwise, we'll have to look at values in the */
1738 /* other order-by columns. Get the segment and */
1739 /* row vectors to be compared. */
1740
1741 brute = TRUE_;
1742 }
1743 }
1744 }
1745 if (brute) {
1746 zzekvcal_(&rj, &rwvbas, &sgvbas);
1747 i__2 = sgvbas + 1;
1748 i__3 = sgvbas + svsize;
1749 zzeksrd_(&i__2, &i__3, svecj);
1750 i__2 = rwvbas + 1;
1751 i__3 = rwvbas + rvsize;
1752 zzeksrd_(&i__2, &i__3, rvecj);
1753 zzekvcal_(&rjg, &rwvbas, &sgvbas);
1754 i__2 = sgvbas + 1;
1755 i__3 = sgvbas + svsize;
1756 zzeksrd_(&i__2, &i__3, svecjg);
1757 i__2 = rwvbas + 1;
1758 i__3 = rwvbas + rvsize;
1759 zzeksrd_(&i__2, &i__3, rvecjg);
1760 jle = zzekvcmp_(&c__4, norder, otabs, ocols, oelts,
1761 senses, sthan, stsdsc, stdtpt, dtpool, dtdscs,
1762 svecj, rvecj, svecjg, rvecjg);
1763 }
1764
1765 /* At this point, JLE is set. */
1766
1767 if (jle) {
1768 j = 0;
1769 } else {
1770
1771 /* Swap the Jth and JGth elements of the order vector. */
1772
1773 swapi_(&ordvec[(i__2 = j - 1) < 250000 && 0 <= i__2 ?
1774 i__2 : s_rnge("ordvec", i__2, "zzekjsrt_", (
1775 ftnlen)920)], &ordvec[(i__3 = jg - 1) <
1776 250000 && 0 <= i__3 ? i__3 : s_rnge("ordvec",
1777 i__3, "zzekjsrt_", (ftnlen)920)]);
1778 }
1779 j -= gap;
1780 }
1781 }
1782
1783 /* The following division guarantees loop termination, even */
1784 /* if a DAS error occurs. */
1785
1786 gap /= 2;
1787 }
1788
1789 /* We've sorted the row numbers in Case 1. Push the order vector */
1790 /* onto the scratch area stack. */
1791
1792 zzekstop_(ordbas);
1793 zzekspsh_(&nrows, ordvec);
1794 } else {
1795
1796 /* Case 2. */
1797
1798 /* Well, we really have a lot of data. Don't try to read it into */
1799 /* memory. Build the order vector in the scratch area. */
1800
1801 zzekstop_(ordbas);
1802 i__1 = nrows;
1803 for (i__ = 1; i__ <= i__1; ++i__) {
1804 zzekspsh_(&c__1, &i__);
1805 }
1806
1807 /* Re-order the order vector elements to reflect the order of the */
1808 /* corresponding rows. This uses the Shell Sort algorithm, but */
1809 /* swaps the elements of the order vector instead of the rows */
1810 /* themselves. */
1811
1812 gap = nrows / 2;
1813 while(gap > 0) {
1814 i__1 = nrows;
1815 for (i__ = gap + 1; i__ <= i__1; ++i__) {
1816 j = i__ - gap;
1817 while(j > 0) {
1818 jg = j + gap;
1819
1820 /* Set the indices of the Jth and JGth */
1821 /* row vectors, as indicated by the order vector. */
1822
1823 i__2 = *ordbas + j;
1824 i__3 = *ordbas + j;
1825 zzeksrd_(&i__2, &i__3, &rj);
1826 i__2 = *ordbas + jg;
1827 i__3 = *ordbas + jg;
1828 zzeksrd_(&i__2, &i__3, &rjg);
1829
1830 /* Compare the two row vectors. */
1831
1832 zzekvcal_(&rj, &rwvbas, &sgvbas);
1833 i__2 = sgvbas + 1;
1834 i__3 = sgvbas + svsize;
1835 zzeksrd_(&i__2, &i__3, svecj);
1836 i__2 = rwvbas + 1;
1837 i__3 = rwvbas + rvsize;
1838 zzeksrd_(&i__2, &i__3, rvecj);
1839 zzekvcal_(&rjg, &rwvbas, &sgvbas);
1840 i__2 = sgvbas + 1;
1841 i__3 = sgvbas + svsize;
1842 zzeksrd_(&i__2, &i__3, svecjg);
1843 i__2 = rwvbas + 1;
1844 i__3 = rwvbas + rvsize;
1845 zzeksrd_(&i__2, &i__3, rvecjg);
1846 if (zzekvcmp_(&c__4, norder, otabs, ocols, oelts, senses,
1847 sthan, stsdsc, stdtpt, dtpool, dtdscs, svecj,
1848 rvecj, svecjg, rvecjg)) {
1849 j = 0;
1850 } else {
1851
1852 /* Swap the order vector's Jth and JGth elements. */
1853
1854 addrj = *ordbas + j;
1855 addrjg = *ordbas + jg;
1856 zzeksupd_(&addrj, &addrj, &rjg);
1857 zzeksupd_(&addrjg, &addrjg, &rj);
1858 }
1859 j -= gap;
1860 }
1861 }
1862
1863 /* The following division guarantees loop termination, even */
1864 /* if a DAS error occurs. */
1865
1866 gap /= 2;
1867 }
1868
1869 /* We've sorted the row numbers for case (2). */
1870
1871 }
1872
1873 /* We've sorted the row numbers, no matter how many there were. */
1874
1875 chkout_("ZZEKJSRT", (ftnlen)8);
1876 return 0;
1877 } /* zzekjsrt_ */
1878
1879