1 /* zzekecmp.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 /* $Procedure ZZEKECMP ( EK, column entry element comparison ) */
zzekecmp_(integer * hans,integer * sgdscs,integer * cldscs,integer * rows,integer * elts)9 integer zzekecmp_(integer *hans, integer *sgdscs, integer *cldscs, integer *
10 rows, integer *elts)
11 {
12 /* System generated locals */
13 integer ret_val, i__1, i__2, i__3;
14
15 /* Builtin functions */
16 integer s_rnge(char *, integer, char *, integer);
17 logical l_lt(char *, char *, ftnlen, ftnlen), l_gt(char *, char *, ftnlen,
18 ftnlen);
19
20 /* Local variables */
21 char cval[1024*2];
22 doublereal dval[2];
23 integer ival[2];
24 logical null[2];
25 integer i__;
26 extern /* Subroutine */ int chkin_(char *, ftnlen);
27 integer cvlen[2];
28 logical found;
29 integer cmplen[2], lhstyp, rhstyp;
30 extern /* Subroutine */ int setmsg_(char *, ftnlen), errhan_(char *,
31 integer *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(
32 char *, ftnlen), chkout_(char *, ftnlen), zzekrsc_(integer *,
33 integer *, integer *, integer *, integer *, integer *, char *,
34 logical *, logical *, ftnlen), zzekrsd_(integer *, integer *,
35 integer *, integer *, integer *, doublereal *, logical *, logical
36 *), zzekrsi_(integer *, integer *, integer *, integer *, integer *
37 , integer *, logical *, logical *);
38
39 /* $ Abstract */
40
41 /* Compare two column entry elements, and return the relation of the */
42 /* first to the second: LT, EQ, or GT. */
43
44 /* $ Disclaimer */
45
46 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
47 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
48 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
49 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
50 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
51 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
52 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
53 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
54 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
55 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
56
57 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
58 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
59 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
60 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
61 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
62 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
63
64 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
65 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
66 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
67 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
68
69 /* $ Required_Reading */
70
71 /* EK */
72
73 /* $ Keywords */
74
75 /* COMPARE */
76 /* EK */
77 /* UTILITY */
78
79 /* $ Declarations */
80 /* $ Disclaimer */
81
82 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
83 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
84 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
85 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
86 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
87 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
88 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
89 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
90 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
91 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
92
93 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
94 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
95 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
96 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
97 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
98 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
99
100 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
101 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
102 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
103 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
104
105
106 /* Include Section: EK Column Descriptor Parameters */
107
108 /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
109
110
111 /* Note: The column descriptor size parameter CDSCSZ is */
112 /* declared separately in the include section CDSIZE$INC.FOR. */
113
114 /* Offset of column descriptors, relative to start of segment */
115 /* integer address range. This number, when added to the last */
116 /* integer address preceding the segment, yields the DAS integer */
117 /* base address of the first column descriptor. Currently, this */
118 /* offset is exactly the size of a segment descriptor. The */
119 /* parameter SDSCSZ, which defines the size of a segment descriptor, */
120 /* is declared in the include file eksegdsc.inc. */
121
122
123 /* Size of column descriptor */
124
125
126 /* Indices of various pieces of column descriptors: */
127
128
129 /* CLSIDX is the index of the column's class code. (We use the */
130 /* word `class' to distinguish this item from the column's data */
131 /* type.) */
132
133
134 /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
135 /* or TIME). The type is actually implied by the class, but it */
136 /* will frequently be convenient to look up the type directly. */
137
138
139
140 /* LENIDX is the index of the column's string length value, if the */
141 /* column has character type. A value of IFALSE in this element of */
142 /* the descriptor indicates that the strings have variable length. */
143
144
145 /* SIZIDX is the index of the column's element size value. This */
146 /* descriptor element is meaningful for columns with fixed-size */
147 /* entries. For variable-sized columns, this value is IFALSE. */
148
149
150 /* NAMIDX is the index of the base address of the column's name. */
151
152
153 /* IXTIDX is the data type of the column's index. IXTIDX */
154 /* contains a type value only if the column is indexed. For columns */
155 /* that are not indexed, the location IXTIDX contains the boolean */
156 /* value IFALSE. */
157
158
159 /* IXPIDX is a pointer to the column's index. IXTPDX contains a */
160 /* meaningful value only if the column is indexed. The */
161 /* interpretation of the pointer depends on the data type of the */
162 /* index. */
163
164
165 /* NFLIDX is the index of a flag indicating whether nulls are */
166 /* permitted in the column. The value at location NFLIDX is */
167 /* ITRUE if nulls are permitted and IFALSE otherwise. */
168
169
170 /* ORDIDX is the index of the column's ordinal position in the */
171 /* list of columns belonging to the column's parent segment. */
172
173
174 /* METIDX is the index of the column's integer metadata pointer. */
175 /* This pointer is a DAS integer address. */
176
177
178 /* The last position in the column descriptor is reserved. No */
179 /* parameter is defined to point to this location. */
180
181
182 /* End Include Section: EK Column Descriptor Parameters */
183
184 /* $ Disclaimer */
185
186 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
187 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
188 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
189 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
190 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
191 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
192 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
193 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
194 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
195 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
196
197 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
198 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
199 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
200 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
201 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
202 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
203
204 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
205 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
206 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
207 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
208
209
210 /* Include Section: EK Operator Codes */
211
212 /* ekopcd.inc Version 1 30-DEC-1994 (NJB) */
213
214
215 /* Within the EK system, operators used in EK queries are */
216 /* represented by integer codes. The codes and their meanings are */
217 /* listed below. */
218
219 /* Relational expressions in EK queries have the form */
220
221 /* <column name> <operator> <value> */
222
223 /* For columns containing numeric values, the operators */
224
225 /* EQ, GE, GT, LE, LT, NE */
226
227 /* may be used; these operators have the same meanings as their */
228 /* Fortran counterparts. For columns containing character values, */
229 /* the list of allowed operators includes those in the above list, */
230 /* and in addition includes the operators */
231
232 /* LIKE, UNLIKE */
233
234 /* which are used to compare strings to a template. In the character */
235 /* case, the meanings of the parameters */
236
237 /* GE, GT, LE, LT */
238
239 /* match those of the Fortran lexical functions */
240
241 /* LGE, LGT, LLE, LLT */
242
243
244 /* The additional unary operators */
245
246 /* ISNULL, NOTNUL */
247
248 /* are used to test whether a value of any type is null. */
249
250
251
252 /* End Include Section: EK Operator Codes */
253
254 /* $ Disclaimer */
255
256 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
257 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
258 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
259 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
260 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
261 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
262 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
263 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
264 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
265 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
266
267 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
268 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
269 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
270 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
271 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
272 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
273
274 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
275 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
276 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
277 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
278
279
280 /* Include Section: EK Query Limit Parameters */
281
282 /* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */
283
284 /* Parameter MAXCON increased to 1000. */
285
286 /* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */
287
288 /* Updated to support SELECT clause. */
289
290
291 /* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */
292
293
294 /* These limits apply to character string queries input to the */
295 /* EK scanner. This limits are part of the EK system's user */
296 /* interface: the values should be advertised in the EK required */
297 /* reading document. */
298
299
300 /* Maximum length of an input query: MAXQRY. This value is */
301 /* currently set to twenty-five 80-character lines. */
302
303
304 /* Maximum number of columns that may be listed in the */
305 /* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */
306
307
308 /* Maximum number of tables that may be listed in the `FROM */
309 /* clause' of a query: MAXTAB. */
310
311
312 /* Maximum number of relational expressions that may be listed */
313 /* in the `constraint clause' of a query: MAXCON. */
314
315 /* This limit applies to a query when it is represented in */
316 /* `normalized form': that is, the constraints have been */
317 /* expressed as a disjunction of conjunctions of relational */
318 /* expressions. The number of relational expressions in a query */
319 /* that has been expanded in this fashion may be greater than */
320 /* the number of relations in the query as orginally written. */
321 /* For example, the expression */
322
323 /* ( ( A LT 1 ) OR ( B GT 2 ) ) */
324 /* AND */
325 /* ( ( C NE 3 ) OR ( D EQ 4 ) ) */
326
327 /* which contains 4 relational expressions, expands to the */
328 /* equivalent normalized constraint */
329
330 /* ( ( A LT 1 ) AND ( C NE 3 ) ) */
331 /* OR */
332 /* ( ( A LT 1 ) AND ( D EQ 4 ) ) */
333 /* OR */
334 /* ( ( B GT 2 ) AND ( C NE 3 ) ) */
335 /* OR */
336 /* ( ( B GT 2 ) AND ( D EQ 4 ) ) */
337
338 /* which contains eight relational expressions. */
339
340
341
342 /* MXJOIN is the maximum number of tables that can be joined. */
343
344
345 /* MXJCON is the maximum number of join constraints allowed. */
346
347
348 /* Maximum number of order-by columns that may be used in the */
349 /* `order-by clause' of a query: MAXORD. MAXORD = 10. */
350
351
352 /* Maximum number of tokens in a query: 500. Tokens are reserved */
353 /* words, column names, parentheses, and values. Literal strings */
354 /* and time values count as single tokens. */
355
356
357 /* Maximum number of numeric tokens in a query: */
358
359
360 /* Maximum total length of character tokens in a query: */
361
362
363 /* Maximum length of literal string values allowed in queries: */
364 /* MAXSTR. */
365
366
367 /* End Include Section: EK Query Limit Parameters */
368
369 /* $ Disclaimer */
370
371 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
372 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
373 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
374 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
375 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
376 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
377 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
378 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
379 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
380 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
381
382 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
383 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
384 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
385 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
386 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
387 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
388
389 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
390 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
391 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
392 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
393
394
395 /* Include Section: EK Segment Descriptor Parameters */
396
397 /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
398
399
400 /* All `base addresses' referred to below are the addresses */
401 /* *preceding* the item the base applies to. This convention */
402 /* enables simplied address calculations in many cases. */
403
404 /* Size of segment descriptor. Note: the include file ekcoldsc.inc */
405 /* must be updated if this parameter is changed. The parameter */
406 /* CDOFF in that file should be kept equal to SDSCSZ. */
407
408
409 /* Index of the segment type code: */
410
411
412 /* Index of the segment's number. This number is the segment's */
413 /* index in the list of segments contained in the EK to which */
414 /* the segment belongs. */
415
416
417 /* Index of the DAS integer base address of the segment's integer */
418 /* meta-data: */
419
420
421 /* Index of the DAS character base address of the table name: */
422
423
424 /* Index of the segment's column count: */
425
426
427 /* Index of the segment's record count: */
428
429
430 /* Index of the root page number of the record tree: */
431
432
433 /* Index of the root page number of the character data page tree: */
434
435
436 /* Index of the root page number of the double precision data page */
437 /* tree: */
438
439
440 /* Index of the root page number of the integer data page tree: */
441
442
443 /* Index of the `modified' flag: */
444
445
446 /* Index of the `initialized' flag: */
447
448
449 /* Index of the shadowing flag: */
450
451
452 /* Index of the companion file handle: */
453
454
455 /* Index of the companion segment number: */
456
457
458 /* The next three items are, respectively, the page numbers of the */
459 /* last character, d.p., and integer data pages allocated by the */
460 /* segment: */
461
462
463 /* The next three items are, respectively, the page-relative */
464 /* indices of the last DAS word in use in the segment's */
465 /* last character, d.p., and integer data pages: */
466
467
468 /* Index of the DAS character base address of the column name list: */
469
470
471 /* The last descriptor element is reserved for future use. No */
472 /* parameter is defined to point to this location. */
473
474
475 /* End Include Section: EK Segment Descriptor Parameters */
476
477 /* $ Disclaimer */
478
479 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
480 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
481 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
482 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
483 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
484 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
485 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
486 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
487 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
488 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
489
490 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
491 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
492 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
493 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
494 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
495 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
496
497 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
498 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
499 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
500 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
501
502
503 /* Include Section: EK Data Types */
504
505 /* ektype.inc Version 1 27-DEC-1994 (NJB) */
506
507
508 /* Within the EK system, data types of EK column contents are */
509 /* represented by integer codes. The codes and their meanings */
510 /* are listed below. */
511
512 /* Integer codes are also used within the DAS system to indicate */
513 /* data types; the EK system makes no assumptions about compatibility */
514 /* between the codes used here and those used in the DAS system. */
515
516
517 /* Character type: */
518
519
520 /* Double precision type: */
521
522
523 /* Integer type: */
524
525
526 /* `Time' type: */
527
528 /* Within the EK system, time values are represented as ephemeris */
529 /* seconds past J2000 (TDB), and double precision numbers are used */
530 /* to store these values. However, since time values require special */
531 /* treatment both on input and output, and since the `TIME' column */
532 /* has a special role in the EK specification and code, time values */
533 /* are identified as a type distinct from double precision numbers. */
534
535
536 /* End Include Section: EK Data Types */
537
538 /* $ Brief_I/O */
539
540 /* Variable I/O Description */
541 /* -------- --- -------------------------------------------------- */
542 /* HANS I EK handles. */
543 /* SGDSCS I Segment descriptors. */
544 /* CLDSCS I Column descriptors. */
545 /* ROWS I Row numbers. */
546 /* ELTS I Element indices. */
547
548 /* The function returns a parameter indicating the order relation */
549 /* satisfied by the input arguments. Possible values are LT, EQ, */
550 /* and GT. */
551
552 /* $ Detailed_Input */
553
554 /* HANS is an array containing file handles of two EKs */
555 /* containing column entry elements to be compared. */
556
557 /* SGDSCS is an array containing segment descriptors of */
558 /* the segments that contain the elements to be */
559 /* compared. */
560
561 /* CLDSCS is an array containing column descriptors for the */
562 /* columns containing the elements to be compared. */
563
564 /* ROWS is an array containing row numbers of the */
565 /* elements to be compared. */
566
567 /* ELTS is an array containing element indices of the */
568 /* elements to be compared. These indices locate */
569 /* an element within the column entry it belongs to. */
570
571 /* $ Detailed_Output */
572
573 /* The function returns a parameter indicating the order relation */
574 /* satisfied by the input arguments. Possible values are LT, EQ, */
575 /* and GT. If OP is the returned value, the scalar values */
576 /* specified by the input arguments satisfy the relation */
577
578 /* <row 1> OP <row 2> */
579
580 /* $ Parameters */
581
582 /* See the include file ekopcd.inc. */
583
584 /* $ Exceptions */
585
586 /* 1) If the either of input file handles is invalid, the error */
587 /* will be diagnosed by routines called by this routine. */
588 /* The function value is EQ in this case. */
589
590 /* 2) If an I/O error occurs while attempting to look up */
591 /* the specified column entry elements, the error will */
592 /* be diagnosed by routines called by this routine. The */
593 /* function value is EQ in this case. */
594
595 /* 3) If any of the input segment descriptors, column descriptors, */
596 /* or row numbers are invalid, this routine may fail in */
597 /* unpredictable, but possibly spectacular, ways. Except */
598 /* as described in this header section, no attempt is made to */
599 /* handle these errors. */
600
601 /* 4) If the data type code in the input column descriptor is not */
602 /* recognized, the error SPICE(INVALIDDATATYPE) is signaled. */
603 /* The function value is EQ in this case. */
604
605 /* $ Files */
606
607 /* See the descriptions of the arguments HAN(1) and HAN(2) in */
608 /* $Detailed_Input. */
609
610 /* $ Particulars */
611
612 /* This routine is an EK utility intended to centralize a frequently */
613 /* performed comparison operation. */
614
615 /* $ Examples */
616
617 /* See ZZEKRCMP, ZZEKVCMP, ZZEKVMCH. */
618
619 /* $ Restrictions */
620
621 /* 1) This routine must execute quickly. Therefore, it checks in */
622 /* only if it detects an error. If an error is signaled by a */
623 /* routine called by this routine, this routine will not appear */
624 /* in the SPICELIB traceback display. Also, in the interest */
625 /* of speed, this routine does not test the value of the SPICELIB */
626 /* function RETURN upon entry. */
627
628 /* 2) This routine depends on the requested comparison to have */
629 /* been semantically checked. Semantically invalid comparisons */
630 /* are treated as bugs. */
631
632 /* 3) Only the first MAXSTR characters of character strings are */
633 /* used in comparisons. */
634
635 /* $ Literature_References */
636
637 /* None. */
638
639 /* $ Author_and_Institution */
640
641 /* N.J. Bachman (JPL) */
642
643 /* $ Version */
644
645 /* - SPICELIB Version 1.2.0, 07-FEB-2015 (NJB) */
646
647 /* Now uses ERRHAN to insert DAS file name into */
648 /* long error messages. */
649
650 /* - SPICELIB Version 1.1.0, 26-MAY-2010 (NJB) */
651
652 /* Bug fix: subscript out of range error caused by */
653 /* column entry strings longer than MAXLEN has been */
654 /* corrected. Also updated Restrictions header section. */
655
656 /* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */
657
658 /* -& */
659
660 /* Local variables */
661
662
663 /* Use discovery check-in for speed. */
664
665
666 /* The function value defaults to `equal'. */
667
668 ret_val = 1;
669 lhstyp = cldscs[1];
670 rhstyp = cldscs[12];
671 if (lhstyp == 3) {
672
673 /* The entities we're comparing are supposed to be */
674 /* scalar. The left hand side has integer type. Either */
675 /* integer or double precision types are acceptable on */
676 /* the right hand side. */
677
678 zzekrsi_(hans, sgdscs, cldscs, rows, elts, ival, null, &found);
679 if (! found) {
680 chkin_("ZZEKECMP", (ftnlen)8);
681 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. Column entry e"
682 "lement was not found.", (ftnlen)76);
683 errhan_("#", hans, (ftnlen)1);
684 errint_("#", &cldscs[8], (ftnlen)1);
685 errint_("#", rows, (ftnlen)1);
686 errint_("#", elts, (ftnlen)1);
687 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
688 chkout_("ZZEKECMP", (ftnlen)8);
689 return ret_val;
690 }
691 if (rhstyp == 3) {
692 zzekrsi_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, &
693 ival[1], &null[1], &found);
694 if (! found) {
695 chkin_("ZZEKECMP", (ftnlen)8);
696 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent"
697 "ry element was not found.", (ftnlen)76);
698 errhan_("#", &hans[1], (ftnlen)1);
699 errint_("#", &cldscs[19], (ftnlen)1);
700 errint_("#", &rows[1], (ftnlen)1);
701 errint_("#", &elts[1], (ftnlen)1);
702 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
703 chkout_("ZZEKECMP", (ftnlen)8);
704 return ret_val;
705 }
706
707 /* Null values precede all others. */
708
709 if (null[0] || null[1]) {
710 if (! null[1]) {
711 ret_val = 5;
712 } else if (! null[0]) {
713 ret_val = 3;
714 }
715 } else {
716 if (ival[0] < ival[1]) {
717 ret_val = 5;
718 } else if (ival[0] > ival[1]) {
719 ret_val = 3;
720 }
721 }
722 } else if (rhstyp == 2) {
723 zzekrsd_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, &
724 dval[1], &null[1], &found);
725 if (! found) {
726 chkin_("ZZEKECMP", (ftnlen)8);
727 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent"
728 "ry element was not found.", (ftnlen)76);
729 errhan_("#", &hans[1], (ftnlen)1);
730 errint_("#", &cldscs[19], (ftnlen)1);
731 errint_("#", &rows[1], (ftnlen)1);
732 errint_("#", &elts[1], (ftnlen)1);
733 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
734 chkout_("ZZEKECMP", (ftnlen)8);
735 return ret_val;
736 }
737 if (null[0] || null[1]) {
738 if (! null[1]) {
739 ret_val = 5;
740 } else if (! null[0]) {
741 ret_val = 3;
742 }
743 } else {
744 if ((doublereal) ival[0] < dval[1]) {
745 ret_val = 5;
746 } else if ((doublereal) ival[0] > dval[1]) {
747 ret_val = 3;
748 }
749 }
750 } else {
751
752 /* This is a big-time semantic error. We should */
753 /* never arrive here. */
754
755 chkin_("ZZEKECMP", (ftnlen)8);
756 setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32);
757 errint_("#", &lhstyp, (ftnlen)1);
758 errint_("#", &rhstyp, (ftnlen)1);
759 sigerr_("SPICE(BUG)", (ftnlen)10);
760 chkout_("ZZEKECMP", (ftnlen)8);
761 return ret_val;
762 }
763 } else if (lhstyp == 2) {
764
765 /* This is a mirror image of the INT case. */
766
767 zzekrsd_(hans, sgdscs, cldscs, rows, elts, dval, null, &found);
768 if (! found) {
769 chkin_("ZZEKECMP", (ftnlen)8);
770 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. Column entry e"
771 "lement was not found.", (ftnlen)76);
772 errhan_("#", hans, (ftnlen)1);
773 errint_("#", &cldscs[8], (ftnlen)1);
774 errint_("#", rows, (ftnlen)1);
775 errint_("#", elts, (ftnlen)1);
776 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
777 chkout_("ZZEKECMP", (ftnlen)8);
778 return ret_val;
779 }
780 if (rhstyp == 3) {
781 zzekrsi_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, &
782 ival[1], &null[1], &found);
783 if (! found) {
784 chkin_("ZZEKECMP", (ftnlen)8);
785 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent"
786 "ry element was not found.", (ftnlen)76);
787 errhan_("#", &hans[1], (ftnlen)1);
788 errint_("#", &cldscs[19], (ftnlen)1);
789 errint_("#", &rows[1], (ftnlen)1);
790 errint_("#", &elts[1], (ftnlen)1);
791 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
792 chkout_("ZZEKECMP", (ftnlen)8);
793 return ret_val;
794 }
795
796 /* Null values precede all others. */
797
798 if (null[0] || null[1]) {
799 if (! null[1]) {
800 ret_val = 5;
801 } else if (! null[0]) {
802 ret_val = 3;
803 }
804 } else {
805 if (dval[0] < (doublereal) ival[1]) {
806 ret_val = 5;
807 } else if (dval[0] > (doublereal) ival[1]) {
808 ret_val = 3;
809 }
810 }
811 } else if (rhstyp == 2) {
812 zzekrsd_(&hans[1], &sgdscs[24], &cldscs[11], &rows[1], elts, &
813 dval[1], &null[1], &found);
814 if (! found) {
815 chkin_("ZZEKECMP", (ftnlen)8);
816 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent"
817 "ry element was not found.", (ftnlen)76);
818 errhan_("#", &hans[1], (ftnlen)1);
819 errint_("#", &cldscs[19], (ftnlen)1);
820 errint_("#", &rows[1], (ftnlen)1);
821 errint_("#", &elts[1], (ftnlen)1);
822 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
823 chkout_("ZZEKECMP", (ftnlen)8);
824 return ret_val;
825 }
826 if (null[0] || null[1]) {
827 if (! null[1]) {
828 ret_val = 5;
829 } else if (! null[0]) {
830 ret_val = 3;
831 }
832 } else {
833 if (dval[0] < dval[1]) {
834 ret_val = 5;
835 } else if (dval[0] > dval[1]) {
836 ret_val = 3;
837 }
838 }
839 } else {
840
841 /* This is a big-time semantic error. We should */
842 /* never arrive here. */
843
844 chkin_("ZZEKECMP", (ftnlen)8);
845 setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32);
846 errint_("#", &lhstyp, (ftnlen)1);
847 errint_("#", &rhstyp, (ftnlen)1);
848 sigerr_("SPICE(BUG)", (ftnlen)10);
849 chkout_("ZZEKECMP", (ftnlen)8);
850 return ret_val;
851 }
852 } else if (lhstyp == 4) {
853
854 /* The entities we're comparing are supposed to be time values. */
855
856 if (rhstyp != 4) {
857
858 /* This is a big-time semantic error. We should */
859 /* never arrive here. */
860
861 chkin_("ZZEKECMP", (ftnlen)8);
862 setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32);
863 errint_("#", &lhstyp, (ftnlen)1);
864 errint_("#", &rhstyp, (ftnlen)1);
865 sigerr_("SPICE(BUG)", (ftnlen)10);
866 chkout_("ZZEKECMP", (ftnlen)8);
867 return ret_val;
868 }
869 for (i__ = 1; i__ <= 2; ++i__) {
870 zzekrsd_(&hans[i__ - 1], &sgdscs[i__ * 24 - 24], &cldscs[i__ * 11
871 - 11], &rows[i__ - 1], &elts[i__ - 1], &dval[(i__1 = i__
872 - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("dval", i__1, "zze"
873 "kecmp_", (ftnlen)486)], &null[(i__2 = i__ - 1) < 2 && 0 <=
874 i__2 ? i__2 : s_rnge("null", i__2, "zzekecmp_", (ftnlen)
875 486)], &found);
876 if (! found) {
877 chkin_("ZZEKECMP", (ftnlen)8);
878 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent"
879 "ry element was not found.", (ftnlen)76);
880 errhan_("#", &hans[i__ - 1], (ftnlen)1);
881 errint_("#", &cldscs[i__ * 11 - 3], (ftnlen)1);
882 errint_("#", &rows[i__ - 1], (ftnlen)1);
883 errint_("#", &elts[i__ - 1], (ftnlen)1);
884 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
885 chkout_("ZZEKECMP", (ftnlen)8);
886 return ret_val;
887 }
888 }
889 if (null[0] || null[1]) {
890 if (! null[1]) {
891 ret_val = 5;
892 } else if (! null[0]) {
893 ret_val = 3;
894 }
895 } else {
896 if (dval[0] < dval[1]) {
897 ret_val = 5;
898 } else if (dval[0] > dval[1]) {
899 ret_val = 3;
900 }
901 }
902 } else if (lhstyp == 1) {
903
904 /* The entities we're comparing are supposed to be scalar. */
905
906 if (rhstyp != 1) {
907
908 /* You know what kind of semantic error this is. */
909
910 chkin_("ZZEKECMP", (ftnlen)8);
911 setmsg_("LHS data type is #; RHSTYP is #.", (ftnlen)32);
912 errint_("#", &lhstyp, (ftnlen)1);
913 errint_("#", &rhstyp, (ftnlen)1);
914 sigerr_("SPICE(BUG)", (ftnlen)10);
915 chkout_("ZZEKECMP", (ftnlen)8);
916 return ret_val;
917 }
918 for (i__ = 1; i__ <= 2; ++i__) {
919 zzekrsc_(&hans[i__ - 1], &sgdscs[i__ * 24 - 24], &cldscs[i__ * 11
920 - 11], &rows[i__ - 1], &elts[i__ - 1], &cvlen[(i__1 = i__
921 - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cvlen", i__1,
922 "zzekecmp_", (ftnlen)548)], cval + (((i__2 = i__ - 1) < 2
923 && 0 <= i__2 ? i__2 : s_rnge("cval", i__2, "zzekecmp_", (
924 ftnlen)548)) << 10), &null[(i__3 = i__ - 1) < 2 && 0 <=
925 i__3 ? i__3 : s_rnge("null", i__3, "zzekecmp_", (ftnlen)
926 548)], &found, (ftnlen)1024);
927 if (! found) {
928 chkin_("ZZEKECMP", (ftnlen)8);
929 setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #.Column ent"
930 "ry element was not found.", (ftnlen)76);
931 errhan_("#", &hans[i__ - 1], (ftnlen)1);
932 errint_("#", &cldscs[i__ * 11 - 3], (ftnlen)1);
933 errint_("#", &rows[i__ - 1], (ftnlen)1);
934 errint_("#", &elts[i__ - 1], (ftnlen)1);
935 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
936 chkout_("ZZEKECMP", (ftnlen)8);
937 return ret_val;
938 }
939
940 /* Let CMPLEN(I) be the string length to use in comparisons. */
941
942 /* Computing MIN */
943 i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge(
944 "cvlen", i__2, "zzekecmp_", (ftnlen)577)];
945 cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cmplen",
946 i__1, "zzekecmp_", (ftnlen)577)] = min(i__3,1024);
947 }
948 if (null[0] || null[1]) {
949 if (! null[1]) {
950 ret_val = 5;
951 } else if (! null[0]) {
952 ret_val = 3;
953 }
954 } else {
955 if (l_lt(cval, cval + 1024, cmplen[0], cmplen[1])) {
956 ret_val = 5;
957 } else if (l_gt(cval, cval + 1024, cmplen[0], cmplen[1])) {
958 ret_val = 3;
959 } else {
960 ret_val = 1;
961 }
962 }
963 } else {
964
965 /* Something untoward has happened in our descriptor. */
966
967 chkin_("ZZEKECMP", (ftnlen)8);
968 setmsg_("The data type code # was not recognized.", (ftnlen)40);
969 errint_("#", &lhstyp, (ftnlen)1);
970 sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22);
971 chkout_("ZZEKECMP", (ftnlen)8);
972 return ret_val;
973 }
974 return ret_val;
975 } /* zzekecmp_ */
976
977