1 /* zzekjoin.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__100 = 100;
11 static integer c__9 = 9;
12 static integer c__10 = 10;
13 static integer c__1 = 1;
14 static integer c__0 = 0;
15 
16 /* $Procedure  ZZEKJOIN  ( Perform join on two join row sets ) */
zzekjoin_(integer * jbase1,integer * jbase2,integer * njcnst,logical * active,integer * cpidx1,integer * clidx1,integer * elts1,integer * ops,integer * cpidx2,integer * clidx2,integer * elts2,integer * sthan,integer * stsdsc,integer * stdtpt,integer * dtpool,integer * dtdscs,integer * jbase3,integer * nrows)17 /* Subroutine */ int zzekjoin_(integer *jbase1, integer *jbase2, integer *
18 	njcnst, logical *active, integer *cpidx1, integer *clidx1, integer *
19 	elts1, integer *ops, integer *cpidx2, integer *clidx2, integer *elts2,
20 	 integer *sthan, integer *stsdsc, integer *stdtpt, integer *dtpool,
21 	integer *dtdscs, integer *jbase3, integer *nrows)
22 {
23     /* System generated locals */
24     integer i__1, i__2, i__3, i__4, i__5;
25 
26     /* Builtin functions */
27     integer s_rnge(char *, integer, char *, integer);
28 
29     /* Local variables */
30     extern /* Subroutine */ int zzeksupd_(integer *, integer *, integer *),
31 	    zzekjprp_(integer *, integer *, integer *, integer *, integer *,
32 	    integer *, integer *, integer *, integer *, integer *, logical *,
33 	    integer *, integer *, integer *, integer *, integer *, integer *,
34 	    integer *, integer *, integer *, integer *, integer *, integer *),
35 	     zzekspsh_(integer *, integer *), zzekjnxt_(logical *, integer *),
36 	     zzekstop_(integer *);
37     integer i__;
38     extern /* Subroutine */ int chkin_(char *, ftnlen);
39     logical found;
40     integer nresv, s1, s2, s3, segvec[10], offset, nr1, nr2, nr3, nt1, nt2,
41 	    nt3, rb1, rb2, rb3, rowvec[11], sgvbas;
42     extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
43 	    integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
44 	    ftnlen);
45     integer top;
46     extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *);
47     integer nsv1, nsv2, nsv3;
48 
49 /* $ Abstract */
50 
51 /*     Perform join of two EK join row sets, subject to a specified set */
52 /*     of EK join constraints, yielding an EK join row set. */
53 
54 /* $ Disclaimer */
55 
56 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
57 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
58 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
59 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
60 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
61 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
62 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
63 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
64 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
65 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
66 
67 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
68 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
69 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
70 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
71 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
72 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
73 
74 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
75 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
76 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
77 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
78 
79 /* $ Required_Reading */
80 
81 /*     EK */
82 
83 /* $ Keywords */
84 
85 /*     EK */
86 /*     PRIVATE */
87 
88 /* $ Declarations */
89 /* $ Disclaimer */
90 
91 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
92 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
93 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
94 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
95 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
96 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
97 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
98 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
99 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
100 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
101 
102 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
103 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
104 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
105 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
106 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
107 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
108 
109 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
110 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
111 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
112 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
113 
114 
115 /*     Include Section:  EK Column Descriptor Parameters */
116 
117 /*        ekcoldsc.inc Version 6    23-AUG-1995 (NJB) */
118 
119 
120 /*     Note:  The column descriptor size parameter CDSCSZ  is */
121 /*     declared separately in the include section CDSIZE$INC.FOR. */
122 
123 /*     Offset of column descriptors, relative to start of segment */
124 /*     integer address range.  This number, when added to the last */
125 /*     integer address preceding the segment, yields the DAS integer */
126 /*     base address of the first column descriptor.  Currently, this */
127 /*     offset is exactly the size of a segment descriptor.  The */
128 /*     parameter SDSCSZ, which defines the size of a segment descriptor, */
129 /*     is declared in the include file eksegdsc.inc. */
130 
131 
132 /*     Size of column descriptor */
133 
134 
135 /*     Indices of various pieces of column descriptors: */
136 
137 
138 /*     CLSIDX is the index of the column's class code.  (We use the */
139 /*     word `class' to distinguish this item from the column's data */
140 /*     type.) */
141 
142 
143 /*     TYPIDX is the index of the column's data type code (CHR, INT, DP, */
144 /*     or TIME).  The type is actually implied by the class, but it */
145 /*     will frequently be convenient to look up the type directly. */
146 
147 
148 
149 /*     LENIDX is the index of the column's string length value, if the */
150 /*     column has character type.  A value of IFALSE in this element of */
151 /*     the descriptor indicates that the strings have variable length. */
152 
153 
154 /*     SIZIDX is the index of the column's element size value.  This */
155 /*     descriptor element is meaningful for columns with fixed-size */
156 /*     entries.  For variable-sized columns, this value is IFALSE. */
157 
158 
159 /*     NAMIDX is the index of the base address of the column's name. */
160 
161 
162 /*     IXTIDX is the data type of the column's index.  IXTIDX */
163 /*     contains a type value only if the column is indexed. For columns */
164 /*     that are not indexed, the location IXTIDX contains the boolean */
165 /*     value IFALSE. */
166 
167 
168 /*     IXPIDX is a pointer to the column's index.  IXTPDX contains a */
169 /*     meaningful value only if the column is indexed.  The */
170 /*     interpretation of the pointer depends on the data type of the */
171 /*     index. */
172 
173 
174 /*     NFLIDX is the index of a flag indicating whether nulls are */
175 /*     permitted in the column.  The value at location NFLIDX is */
176 /*     ITRUE if nulls are permitted and IFALSE otherwise. */
177 
178 
179 /*     ORDIDX is the index of the column's ordinal position in the */
180 /*     list of columns belonging to the column's parent segment. */
181 
182 
183 /*     METIDX is the index of the column's integer metadata pointer. */
184 /*     This pointer is a DAS integer address. */
185 
186 
187 /*     The last position in the column descriptor is reserved.  No */
188 /*     parameter is defined to point to this location. */
189 
190 
191 /*     End Include Section:  EK Column Descriptor Parameters */
192 
193 /* $ Disclaimer */
194 
195 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
196 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
197 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
198 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
199 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
200 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
201 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
202 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
203 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
204 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
205 
206 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
207 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
208 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
209 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
210 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
211 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
212 
213 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
214 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
215 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
216 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
217 
218 
219 /*     Include Section:  EK Join Row Set Parameters */
220 
221 /*        ekjrs.inc  Version 1    07-FEB-1995 (NJB) */
222 
223 
224 /*     Maximum number of join row sets in a join row set union: */
225 
226 
227 /*     The layout of a join row set in the EK scratch area is shown */
228 /*     below: */
229 
230 /*        +--------------------------------------------+ */
231 /*        |              join row set size             |  1 element */
232 /*        +--------------------------------------------+ */
233 /*        |    number of row vectors in join row set   |  1 element */
234 /*        +--------------------------------------------+ */
235 /*        |               table count (TC)             |  1 element */
236 /*        +--------------------------------------------+ */
237 /*        |          segment vector count (SVC)        |  1 element */
238 /*        +--------------------------------------------+ */
239 /*        |               segment vector 1             |  TC elements */
240 /*        +--------------------------------------------+ */
241 /*                              . */
242 /*                              . */
243 /*                              . */
244 /*        +--------------------------------------------+ */
245 /*        |               segment vector SVC           |  TC elements */
246 /*        +--------------------------------------------+ */
247 /*        |   segment vector 1 row set base address    |  1 element */
248 /*        +--------------------------------------------+ */
249 /*        |      segment vector 1 row count (RC_1)     |  1 element */
250 /*        +--------------------------------------------+ */
251 /*                              . */
252 /*                              . */
253 /*                              . */
254 /*        +--------------------------------------------+ */
255 /*        |  segment vector SVC row set base address   |  1 element */
256 /*        +--------------------------------------------+ */
257 /*        |   segment vector SVC row count (RC_SVC)    |  1 element */
258 /*        +--------------------------------------------+ */
259 /*        | Augmented row vectors for segment vector 1 |  (TC+1)*RC_1 */
260 /*        +--------------------------------------------+  elements */
261 /*                              . */
262 /*                              . */
263 /*                              . */
264 /*        +--------------------------------------------+ */
265 /*        |Augmented row vectors for segment vector SVC|  (TC+1)*RC_SVC1 */
266 /*        +--------------------------------------------+  elements */
267 
268 
269 /*     The following parameters indicate positions of elements in the */
270 /*     join row set structure: */
271 
272 
273 /*     Base-relative index of join row set size */
274 
275 
276 /*     Index of row vector count */
277 
278 
279 /*     Index of table count */
280 
281 
282 /*     Index of segment vector count */
283 
284 
285 /*     Base address of first segment vector */
286 
287 
288 
289 /*     End Include Section:  EK Join Row Set Parameters */
290 
291 /* $ Disclaimer */
292 
293 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
294 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
295 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
296 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
297 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
298 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
299 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
300 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
301 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
302 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
303 
304 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
305 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
306 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
307 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
308 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
309 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
310 
311 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
312 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
313 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
314 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
315 
316 
317 /*     Include Section:  EK Query Limit Parameters */
318 
319 /*        ekqlimit.inc  Version 3    16-NOV-1995 (NJB) */
320 
321 /*           Parameter MAXCON increased to 1000. */
322 
323 /*        ekqlimit.inc  Version 2    01-AUG-1995 (NJB) */
324 
325 /*           Updated to support SELECT clause. */
326 
327 
328 /*        ekqlimit.inc  Version 1    07-FEB-1995 (NJB) */
329 
330 
331 /*     These limits apply to character string queries input to the */
332 /*     EK scanner.  This limits are part of the EK system's user */
333 /*     interface:  the values should be advertised in the EK required */
334 /*     reading document. */
335 
336 
337 /*     Maximum length of an input query:  MAXQRY.  This value is */
338 /*     currently set to twenty-five 80-character lines. */
339 
340 
341 /*     Maximum number of columns that may be listed in the */
342 /*     `order-by clause' of a query:  MAXSEL.  MAXSEL = 50. */
343 
344 
345 /*     Maximum number of tables that may be listed in the `FROM */
346 /*     clause' of a query: MAXTAB. */
347 
348 
349 /*     Maximum number of relational expressions that may be listed */
350 /*     in the `constraint clause' of a query: MAXCON. */
351 
352 /*     This limit applies to a query when it is represented in */
353 /*     `normalized form': that is, the constraints have been */
354 /*     expressed as a disjunction of conjunctions of relational */
355 /*     expressions. The number of relational expressions in a query */
356 /*     that has been expanded in this fashion may be greater than */
357 /*     the number of relations in the query as orginally written. */
358 /*     For example, the expression */
359 
360 /*             ( ( A LT 1 ) OR ( B GT 2 ) ) */
361 /*        AND */
362 /*             ( ( C NE 3 ) OR ( D EQ 4 ) ) */
363 
364 /*     which contains 4 relational expressions, expands to the */
365 /*     equivalent normalized constraint */
366 
367 /*             (  ( A LT 1 ) AND ( C NE 3 )  ) */
368 /*        OR */
369 /*             (  ( A LT 1 ) AND ( D EQ 4 )  ) */
370 /*        OR */
371 /*             (  ( B GT 2 ) AND ( C NE 3 )  ) */
372 /*        OR */
373 /*             (  ( B GT 2 ) AND ( D EQ 4 )  ) */
374 
375 /*     which contains eight relational expressions. */
376 
377 
378 
379 /*     MXJOIN is the maximum number of tables that can be joined. */
380 
381 
382 /*     MXJCON is the maximum number of join constraints allowed. */
383 
384 
385 /*     Maximum number of order-by columns that may be used in the */
386 /*     `order-by clause' of a query: MAXORD. MAXORD = 10. */
387 
388 
389 /*     Maximum number of tokens in a query: 500. Tokens are reserved */
390 /*     words, column names, parentheses, and values. Literal strings */
391 /*     and time values count as single tokens. */
392 
393 
394 /*     Maximum number of numeric tokens in a query: */
395 
396 
397 /*     Maximum total length of character tokens in a query: */
398 
399 
400 /*     Maximum length of literal string values allowed in queries: */
401 /*     MAXSTR. */
402 
403 
404 /*     End Include Section:  EK Query Limit Parameters */
405 
406 /* $ Disclaimer */
407 
408 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
409 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
410 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
411 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
412 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
413 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
414 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
415 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
416 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
417 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
418 
419 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
420 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
421 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
422 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
423 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
424 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
425 
426 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
427 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
428 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
429 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
430 
431 
432 /*     Include Section:  EK Segment Descriptor Parameters */
433 
434 /*        eksegdsc.inc  Version 8  06-NOV-1995 (NJB) */
435 
436 
437 /*     All `base addresses' referred to below are the addresses */
438 /*     *preceding* the item the base applies to.  This convention */
439 /*     enables simplied address calculations in many cases. */
440 
441 /*     Size of segment descriptor.  Note:  the include file ekcoldsc.inc */
442 /*     must be updated if this parameter is changed.  The parameter */
443 /*     CDOFF in that file should be kept equal to SDSCSZ. */
444 
445 
446 /*     Index of the segment type code: */
447 
448 
449 /*     Index of the segment's number.  This number is the segment's */
450 /*     index in the list of segments contained in the EK to which */
451 /*     the segment belongs. */
452 
453 
454 /*     Index of the DAS integer base address of the segment's integer */
455 /*     meta-data: */
456 
457 
458 /*     Index of the DAS character base address of the table name: */
459 
460 
461 /*     Index of the segment's column count: */
462 
463 
464 /*     Index of the segment's record count: */
465 
466 
467 /*     Index of the root page number of the record tree: */
468 
469 
470 /*     Index of the root page number of the character data page tree: */
471 
472 
473 /*     Index of the root page number of the double precision data page */
474 /*     tree: */
475 
476 
477 /*     Index of the root page number of the integer data page tree: */
478 
479 
480 /*     Index of the `modified' flag: */
481 
482 
483 /*     Index of the `initialized' flag: */
484 
485 
486 /*     Index of the shadowing flag: */
487 
488 
489 /*     Index of the companion file handle: */
490 
491 
492 /*     Index of the companion segment number: */
493 
494 
495 /*     The next three items are, respectively, the page numbers of the */
496 /*     last character, d.p., and integer data pages allocated by the */
497 /*     segment: */
498 
499 
500 /*     The next three items are, respectively, the page-relative */
501 /*     indices of the last DAS word in use in the segment's */
502 /*     last character, d.p., and integer data pages: */
503 
504 
505 /*     Index of the DAS character base address of the column name list: */
506 
507 
508 /*     The last descriptor element is reserved for future use.  No */
509 /*     parameter is defined to point to this location. */
510 
511 
512 /*     End Include Section:  EK Segment Descriptor Parameters */
513 
514 /* $ Brief_I/O */
515 
516 /*     Variable  I/O  Description */
517 /*     --------  ---  -------------------------------------------------- */
518 /*     JBASE1     I   Scratch area base address of first join row set. */
519 /*     JBASE2     I   Scratch area base address of second join row set. */
520 /*     NJCNST     I   Number of join constraints. */
521 /*     ACTIVE     I   Array of flags indicating applicable constraints. */
522 /*     CPIDX1     I   Cross product indices for LHS's of constraints. */
523 /*     CLIDX1     I   Column indices for LHS's of constraints. */
524 /*     ELTS1      I   Column entry elt. indices for LHS'of constraints. */
525 /*     OPS        I   Operator codes for constraints. */
526 /*     CPIDX2     I   Cross product indices for RHS's of constraints. */
527 /*     CLIDX2     I   Column indices for RHS's of constraints. */
528 /*     ELTS2      I   Column entry elt. indices for RHS'of constraints. */
529 /*     STHAN      I   Array of EK handles corresponding to segments. */
530 /*     STSDSC     I   Array of segment descriptors. */
531 /*     STDTPT     I   Array of set table column descriptor pointers. */
532 /*     DTPOOL     I   Linked list pool for column descriptors. */
533 /*     DTDSCS     I   Array of column descriptors. */
534 /*     JBASE3     O   Scratch area base address of output join row set. */
535 /*     NROWS      O   Number of rows in output join row set. */
536 /*     CDSCSZ     P   Size of column descriptor. */
537 
538 /* $ Detailed_Input */
539 
540 /*     JBASE1         is the EK scratch area base address of the first */
541 /*                    input join row set.  This address is one less than */
542 /*                    the first address occupied by the join row set. */
543 /*                    See the $Particulars section for a description of */
544 /*                    join row sets. */
545 
546 /*     JBASE2         is the EK scratch area base address of the second */
547 /*                    input join row set.  This address is one less than */
548 /*                    the first address occupied by the join row set. */
549 
550 /*     NJCNST         is the number of join constraints that must be */
551 /*                    satisfied by the output join row set.  Each of the */
552 /*                    input arrays CPIDX1, CLIDX1, OPS, CPIDX2, and */
553 /*                    CLIDX2 contains NJCNST elements. */
554 
555 /*     ACTIVE         is an array of logical flags indicating which */
556 /*                    constraints are currently applicable.  The Nth */
557 /*                    element of ACTIVE indicates whether or not to apply */
558 /*                    the Nth constraint:  if ACTIVE(N) is .TRUE., the */
559 /*                    constraint is applicable, otherwise it isn't. */
560 
561 /*                    The elements of the other input arguments that */
562 /*                    define constraints are defined when the */
563 /*                    corresponding element of ACTIVE is .TRUE.  For */
564 /*                    example, when the second constraint is not active, */
565 /*                    the second column descriptor in DTDSCS may not be */
566 /*                    defined. */
567 
568 /*     CPIDX1, */
569 /*     CLIDX1         are, respectively, a set of cross product indices */
570 /*                    and column indices that define the columns on the */
571 /*                    left-hand sides of the input constraints.  If the */
572 /*                    first input join row set contains rows from NT1 */
573 /*                    tables and the second input join row set contains */
574 /*                    rows from NT2 tables, then there are (NT1+NT2) */
575 /*                    components in the cross product of the tables */
576 /*                    specified by the input join row sets.  We'll index */
577 /*                    these from 1 to (NT1+NT2), with table 1 being the */
578 /*                    first table of the first input join row set, table */
579 /*                    2 being the second table of the first input join */
580 /*                    row set, table (NT1+1) being the first table of the */
581 /*                    second input join row set, and so on.  Each element */
582 /*                    of the argument CPIDX1 designates a table by this */
583 /*                    counting scheme.  The corresponding element of the */
584 /*                    argument CLIDX1 is the index of a column in the */
585 /*                    specified table.  The index is the ordinal position */
586 /*                    of the column's attributes in the column attribute */
587 /*                    list for the table containing the column. */
588 
589 /*     ELTS1          is an array of column entry element indices.  These */
590 /*                    indices specify the elements of the LHS column */
591 /*                    entries to be used in testing the join constraints. */
592 /*                    For scalar columns, the corresponding values of */
593 /*                    ELTS1 are ignored. */
594 
595 /*     OPS            is an array of relational operator codes.  The */
596 /*                    Ith code applies to the Ith join constraint. */
597 
598 /*     CPIDX2, */
599 /*     CLIDX2         are, respectively, a set of cross product indices */
600 /*                    and column indices that define the columns on the */
601 /*                    right-hand sides of the input constraints.  The */
602 /*                    meanings of these arrays are analogous to those */
603 /*                    of CPIDX1 and CLIDX1. */
604 
605 /*     ELTS2          is an array of column entry element indices.  These */
606 /*                    indices specify the elements of the LHS column */
607 /*                    entries to be used in testing the join constraints. */
608 /*                    For scalar columns, the corresponding values of */
609 /*                    ELTS2 are ignored. */
610 
611 /*     STHAN          is an array of EK file handles.  The Ith element */
612 /*                    of STHAN is the handle of the EK containing the */
613 /*                    Ith loaded segment. */
614 
615 /*     STSDSC         is an array of segment descriptors for all of the */
616 /*                    loaded segments. */
617 
618 /*     STDTPT         is an array of descriptor table pointers all of */
619 /*                    the loaded segments.  For the Ith loaded segment, */
620 
621 /*                       STDTPT(I) */
622 
623 /*                    contains the node number of the descriptor entry */
624 /*                    of the first column in the Ith segment, where the */
625 /*                    order of columns is determined by the order in */
626 /*                    which the columns appear in the parent table's */
627 /*                    column attribute list. */
628 
629 /*     DTPOOL, */
630 /*     DTDSCS         are, respectively, the linked list pool for */
631 /*                    the column descriptor array and the column */
632 /*                    descriptor array itself.  The latter contains */
633 /*                    a descriptor for each loaded column. */
634 
635 /* $ Detailed_Output */
636 
637 /*     JBASE3         is the EK scratch area base address of the output */
638 /*                    join row set.  This join row set represents that */
639 /*                    subset of the Cartesian product of the input */
640 /*                    join row sets which satisfies all of the input */
641 /*                    join constraints. */
642 
643 /*     NROWS          is the number of `rows' in the output join row set. */
644 /*                    Each such row is actually a vector of rows, one */
645 /*                    belonging to each table in the Cartesian product */
646 /*                    of tables specified by the join operation. */
647 
648 /* $ Parameters */
649 
650 /*     See the include files. */
651 
652 /* $ Exceptions */
653 
654 /*     1)  If the number of constaints NCNSTR is out of range, the */
655 /*         error SPICE(INVALIDCOUNT) is signalled. */
656 
657 /*     2)  If the table count in either input join row set is out of */
658 /*         range, the error SPICE(INVALIDCOUNT) is signalled. */
659 
660 /*     3)  If the sum of the table counts of the input join row sets is */
661 /*         too large, the error SPICE(INVALIDCOUNT) is signalled. */
662 
663 /*     4)  If either of cross product table indices for the input */
664 /*         constraints is out of range, the error SPICE(INVALIDINDEX) is */
665 /*         signalled. */
666 
667 /* $ Files */
668 
669 /*     1)  This routine uses the EK scratch area, which employs a scratch */
670 /*         DAS file. */
671 
672 /* $ Particulars */
673 
674 /*     The purpose of this routine is to compute the set of rows */
675 /*     resulting from joining two `join row sets'.  A join row set */
676 /*     is a structure in the EK scratch area that represents the */
677 /*     result of a table join, subject to constraints.  A join of */
678 /*     n tables, subject to constraints, may be computed by joining */
679 /*     the join of the first n-1 tables with the nth table; such a */
680 /*     procedure is the typical application evisioned for this routine. */
681 
682 /*     Since all EK rows belong to segments, the set of rows formed by */
683 /*     taking the Cartesian product of two tables is actually the union */
684 /*     of the sets of rows belonging to the Cartesian products of the */
685 /*     possible pairs of segments, where the segments are taken from */
686 /*     the two tables being crossed.  Therefore, each join row set is */
687 /*     characterized by a list of n-tuples of segments, and by a list of */
688 /*     sets of n-tuples of row numbers, one row number set per segment */
689 /*     n-tuple.  The segments are identified by a vector of segment */
690 /*     list indices, which is called a `segment vector'.  The n-tuples */
691 /*     of rows are called `row vectors'.  Each segment vector has a */
692 /*     pointer and count that allow addressing the corresponding row */
693 /*     vectors. */
694 
695 /*     Each join row set consists of: */
696 
697 /*         - a base address in the scratch area */
698 /*         - a table count */
699 /*         - a segment vector count */
700 /*         - a set of segment vectors */
701 /*         - a set of segment vector row vector base addresses */
702 /*           (these are relative to the base of the join row set) */
703 /*         - a set of segment vector row vector counts */
704 /*         - a set of row vectors, augmented by offsets of their */
705 /*           parent segment vectors (these offsets are at the */
706 /*           end of each row vector) */
707 
708 
709 /*     The layout of a join row set in the EK scratch area is shown */
710 /*     in the include file for the join row set parameters. */
711 
712 /* $ Examples */
713 
714 /*     See EKSRCH. */
715 
716 /* $ Restrictions */
717 
718 /*     1)  Relies on the EK scratch area. */
719 
720 /* $ Literature_References */
721 
722 /*     None. */
723 
724 /* $ Author_and_Institution */
725 
726 /*     N.J. Bachman   (JPL) */
727 
728 /* $ Version */
729 
730 /* -    SPICELIB Version 1.0.1, 20-JUL-1998 (NJB) */
731 
732 /*        Deleted comment about squeezing out segment vectors without */
733 /*        corresponding row vectors; also deleted comment containing */
734 /*        a call to ZZEKJSQZ. */
735 
736 /* -    Beta Version 1.0.0, 10-OCT-1995 (NJB) */
737 
738 /* -& */
739 
740 /*     Local variables */
741 
742 
743 /*     For speed, we use discovery check-in.  We don't check */
744 /*     RETURN at all. */
745 
746 
747 /*     Validate constraint count. */
748 
749     if (*njcnst < 0 || *njcnst > 100) {
750 	chkin_("ZZEKJOIN", (ftnlen)8);
751 	setmsg_("Number of join constraints was #; valid range is 0:#", (
752 		ftnlen)52);
753 	errint_("#", njcnst, (ftnlen)1);
754 	errint_("#", &c__100, (ftnlen)1);
755 	sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
756 	chkout_("ZZEKJOIN", (ftnlen)8);
757 	return 0;
758     }
759 
760 /*     Get the table count and segment vector count for each input join */
761 /*     row set. */
762 
763     i__1 = *jbase1 + 3;
764     i__2 = *jbase1 + 3;
765     zzeksrd_(&i__1, &i__2, &nt1);
766     i__1 = *jbase1 + 4;
767     i__2 = *jbase1 + 4;
768     zzeksrd_(&i__1, &i__2, &nsv1);
769     i__1 = *jbase2 + 3;
770     i__2 = *jbase2 + 3;
771     zzeksrd_(&i__1, &i__2, &nt2);
772     i__1 = *jbase2 + 4;
773     i__2 = *jbase2 + 4;
774     zzeksrd_(&i__1, &i__2, &nsv2);
775 
776 /*     Set the table count and segment vector count for the output join */
777 /*     row set. */
778 
779     nt3 = nt1 + nt2;
780     nsv3 = nsv1 * nsv2;
781     if (nt1 < 1 || nt2 > 9) {
782 	chkin_("ZZEKJOIN", (ftnlen)8);
783 	setmsg_("Number tables in first join row set was #; valid range is 1"
784 		":#", (ftnlen)61);
785 	errint_("#", &nt1, (ftnlen)1);
786 	errint_("#", &c__9, (ftnlen)1);
787 	sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
788 	chkout_("ZZEKJOIN", (ftnlen)8);
789 	return 0;
790     } else if (nt2 < 1 || nt2 > 9) {
791 	chkin_("ZZEKJOIN", (ftnlen)8);
792 	setmsg_("Number tables in second join row set was #; valid range is "
793 		"1:#", (ftnlen)62);
794 	errint_("#", &nt2, (ftnlen)1);
795 	errint_("#", &c__9, (ftnlen)1);
796 	sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
797 	chkout_("ZZEKJOIN", (ftnlen)8);
798 	return 0;
799     } else if (nt3 > 10) {
800 	chkin_("ZZEKJOIN", (ftnlen)8);
801 	setmsg_("Number of crossed tables was #; valid range is 0:#", (ftnlen)
802 		50);
803 	errint_("#", &nt3, (ftnlen)1);
804 	errint_("#", &c__10, (ftnlen)1);
805 	sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
806 	chkout_("ZZEKJOIN", (ftnlen)8);
807 	return 0;
808     }
809 
810 /*     Validate cross product indices.  The column indices don't lend */
811 /*     themselves to such a convenient check; we'll check those as we */
812 /*     use them. */
813 
814     i__1 = *njcnst;
815     for (i__ = 1; i__ <= i__1; ++i__) {
816 	if (active[i__ - 1]) {
817 	    if (cpidx1[i__ - 1] < 1 || cpidx1[i__ - 1] > nt3) {
818 		chkin_("ZZEKJOIN", (ftnlen)8);
819 		setmsg_("Cross product table index for left hand side of con"
820 			"straint # was #; valid range is 1:#", (ftnlen)86);
821 		errint_("#", &i__, (ftnlen)1);
822 		errint_("#", &cpidx1[i__ - 1], (ftnlen)1);
823 		errint_("#", &nt3, (ftnlen)1);
824 		sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
825 		chkout_("ZZEKJOIN", (ftnlen)8);
826 		return 0;
827 	    } else if (cpidx2[i__ - 1] < 1 || cpidx2[i__ - 1] > nt3) {
828 		chkin_("ZZEKJOIN", (ftnlen)8);
829 		setmsg_("Cross product table index for right hand side of co"
830 			"nstraint # was #; valid range is 1:#", (ftnlen)87);
831 		errint_("#", &i__, (ftnlen)1);
832 		errint_("#", &cpidx2[i__ - 1], (ftnlen)1);
833 		errint_("#", &nt3, (ftnlen)1);
834 		sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
835 		chkout_("ZZEKJOIN", (ftnlen)8);
836 		return 0;
837 	    }
838 	}
839     }
840 
841 /*     Form the joint row set control area for output join row set. */
842 
843 /*     The current stack top is the base address of the output join row */
844 /*     set. */
845 
846     zzekstop_(jbase3);
847 
848 /*     Save room for the size and row vector count */
849 
850     for (i__ = 1; i__ <= 2; ++i__) {
851 	zzekspsh_(&c__1, &c__0);
852     }
853 
854 /*     The table count and segment vector count come next. */
855 
856     zzekspsh_(&c__1, &nt3);
857     zzekspsh_(&c__1, &nsv3);
858 
859 /*     Just reserve room for the segment vectors and the segment vector */
860 /*     row set base addresses and counts. */
861 
862     nresv = nsv3 * (nt3 + 2);
863     i__1 = nresv;
864     for (i__ = 1; i__ <= i__1; ++i__) {
865 	zzekspsh_(&c__1, &c__0);
866     }
867 
868 /*     Initialize the output segment vector count and the total row */
869 /*     count. */
870 
871     s3 = 0;
872     *nrows = 0;
873 
874 /*     For every segment vector in the first join row set, */
875 
876     i__1 = nsv1;
877     for (s1 = 1; s1 <= i__1; ++s1) {
878 
879 /*        Fill in the first NT1 elements of our composite segment vector */
880 /*        with the current segment vector from the first join row set. */
881 
882 	offset = (s1 - 1) * nt1 + 4;
883 	i__2 = *jbase1 + offset + 1;
884 	i__3 = *jbase1 + offset + nt1;
885 	zzeksrd_(&i__2, &i__3, segvec);
886 
887 /*        Get the row set base address and count for this segment vector. */
888 
889 	offset = nsv1 * nt1 + 4 + (s1 - 1 << 1) + 1;
890 	i__2 = *jbase1 + offset;
891 	i__3 = *jbase1 + offset;
892 	zzeksrd_(&i__2, &i__3, &rb1);
893 	i__2 = *jbase1 + offset + 1;
894 	i__3 = *jbase1 + offset + 1;
895 	zzeksrd_(&i__2, &i__3, &nr1);
896 
897 /*        For every segment vector in the second join row set, */
898 
899 	i__2 = nsv2;
900 	for (s2 = 1; s2 <= i__2; ++s2) {
901 
902 /*           Fill in the last NT2 elements of our composite segment */
903 /*           vector with the current segment vector from the second join */
904 /*           row set. */
905 
906 	    offset = (s2 - 1) * nt2 + 4;
907 	    i__4 = *jbase2 + offset + 1;
908 	    i__5 = *jbase2 + offset + nt2;
909 	    zzeksrd_(&i__4, &i__5, &segvec[(i__3 = nt1) < 10 && 0 <= i__3 ?
910 		    i__3 : s_rnge("segvec", i__3, "zzekjoin_", (ftnlen)516)]);
911 
912 /*           Write this segment vector to the output join row set. */
913 
914 	    ++s3;
915 	    sgvbas = (s3 - 1) * nt3 + 4;
916 	    i__3 = *jbase3 + sgvbas + 1;
917 	    i__4 = *jbase3 + sgvbas + nt3;
918 	    zzeksupd_(&i__3, &i__4, segvec);
919 
920 /*           Get the row set base address and count for this segment */
921 /*           vector. */
922 
923 	    offset = nsv2 * nt2 + 4 + (s2 - 1 << 1) + 1;
924 	    i__3 = *jbase2 + offset;
925 	    i__4 = *jbase2 + offset;
926 	    zzeksrd_(&i__3, &i__4, &rb2);
927 	    i__3 = *jbase2 + offset + 1;
928 	    i__4 = *jbase2 + offset + 1;
929 	    zzeksrd_(&i__3, &i__4, &nr2);
930 
931 /*           It's time to decide which row vectors corresponding to */
932 /*           our two segment vectors satisfy the join constraints. */
933 /*           We pass off the job of determining which row vectors to */
934 /*           consider to the subroutine pair ZZEKJPRP (join preparation) */
935 /*           and ZZEKJNXT (get next joined row vector). */
936 
937 /*           We defer establishing the base address of the output */
938 /*           row vector set until the join reduction is done, since */
939 /*           the join operation will use the scratch area. */
940 
941 	    zzekjprp_(segvec, jbase1, &nt1, &rb1, &nr1, jbase2, &nt2, &rb2, &
942 		    nr2, njcnst, active, cpidx1, clidx1, elts1, ops, cpidx2,
943 		    clidx2, elts2, sthan, stsdsc, stdtpt, dtpool, dtdscs);
944 
945 /*           Initialize the row count for the current output segment */
946 /*           vector.  Also set the segment vector row set base address. */
947 
948 	    nr3 = 0;
949 	    zzekstop_(&top);
950 	    rb3 = top - *jbase3;
951 	    offset = nsv3 * nt3 + 4 + (s3 - 1 << 1) + 1;
952 	    i__3 = *jbase3 + offset;
953 	    i__4 = *jbase3 + offset;
954 	    zzeksupd_(&i__3, &i__4, &rb3);
955 
956 /*           Fetch the row vectors that satisfy the join constraints. */
957 
958 	    nr3 = 0;
959 	    zzekjnxt_(&found, rowvec);
960 	    while(found) {
961 
962 /*              Append the base offset of the parent segment vector */
963 /*              to the row vector.  The base offset is one less than */
964 /*              the base-relative address of the segment vector. */
965 
966 		++nr3;
967 		rowvec[(i__3 = nt3) < 11 && 0 <= i__3 ? i__3 : s_rnge("rowvec"
968 			, i__3, "zzekjoin_", (ftnlen)584)] = sgvbas;
969 
970 /*              Add this vector to the output join row set.  Get the */
971 /*              next row vector. */
972 
973 		i__3 = nt3 + 1;
974 		zzekspsh_(&i__3, rowvec);
975 		zzekjnxt_(&found, rowvec);
976 	    }
977 
978 /*           At this point, we've tested every row corresponding to the */
979 /*           current segment vector.  Update the row count for this */
980 /*           segment vector. */
981 
982 	    offset = nsv3 * nt3 + 4 + (s3 - 1 << 1) + 2;
983 	    i__3 = *jbase3 + offset;
984 	    i__4 = *jbase3 + offset;
985 	    zzeksupd_(&i__3, &i__4, &nr3);
986 
987 /*           Keep the overall row total up to date. */
988 
989 	    *nrows += nr3;
990 	}
991     }
992 
993 /*     Fill in the row count and size values in the output join row */
994 /*     set. */
995 
996     zzekstop_(&top);
997     i__1 = *jbase3 + 1;
998     i__2 = *jbase3 + 1;
999     i__3 = top - *jbase3;
1000     zzeksupd_(&i__1, &i__2, &i__3);
1001     i__1 = *jbase3 + 2;
1002     i__2 = *jbase3 + 2;
1003     zzeksupd_(&i__1, &i__2, nrows);
1004 
1005 /*     We've constructed the output join row set resulting from */
1006 /*     joining the input row sets. */
1007 
1008     return 0;
1009 } /* zzekjoin_ */
1010 
1011