1 /* wnreld.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 WNRELD ( Compare two DP windows ) */
wnreld_(doublereal * a,char * op,doublereal * b,ftnlen op_len)9 logical wnreld_(doublereal *a, char *op, doublereal *b, ftnlen op_len)
10 {
11 /* System generated locals */
12 integer i__1;
13 logical ret_val;
14
15 /* Builtin functions */
16 integer s_cmp(char *, char *, ftnlen, ftnlen);
17
18 /* Local variables */
19 integer i__, acard, bcard;
20 extern integer cardd_(doublereal *);
21 extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
22 ftnlen, ftnlen);
23 logical equal;
24 extern logical wnincd_(doublereal *, doublereal *, doublereal *);
25 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
26 ftnlen), setmsg_(char *, ftnlen);
27 logical subset;
28 extern logical return_(void);
29
30 /* $ Abstract */
31
32 /* Compare two double precision windows. */
33
34 /* $ Disclaimer */
35
36 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
37 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
38 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
39 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
40 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
41 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
42 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
43 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
44 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
45 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
46
47 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
48 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
49 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
50 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
51 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
52 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
53
54 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
55 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
56 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
57 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
58
59 /* $ Required_Reading */
60
61 /* WINDOWS */
62
63 /* $ Keywords */
64
65 /* WINDOWS */
66
67 /* $ Declarations */
68 /* $ Brief_I/O */
69
70 /* VARIABLE I/O DESCRIPTION */
71 /* -------- --- -------------------------------------------------- */
72 /* A I First window. */
73 /* OP I Comparison operator. */
74 /* B I Second window. */
75
76 /* The function returns the result of comparison: A (OP) B. */
77
78 /* $ Detailed_Input */
79
80 /* A, */
81 /* B are windows, each of which contains zero or more */
82 /* intervals. */
83
84 /* OP is a comparison operator, indicating the way in */
85 /* which the input sets are to be compared. OP may */
86 /* be any of the following: */
87
88 /* Operator Meaning */
89 /* -------- ------------------------------------- */
90 /* '=' A = B is true if A and B are equal */
91 /* (contain the same intervals). */
92
93 /* '<>' A <> B is true if A and B are not */
94 /* equal. */
95
96 /* '<=' A <= B is true if A is a subset of B. */
97
98 /* '<' A < B is true is A is a proper subset */
99 /* of B. */
100
101 /* '>=' A >= B is true if B is a subset of A. */
102
103 /* '>' A > B is true if B is a proper subset */
104 /* of A. */
105
106 /* $ Detailed_Output */
107
108 /* The function returns the result of the comparison. */
109
110 /* $ Parameters */
111
112 /* None. */
113
114 /* $ Particulars */
115
116 /* This function is true whenever the specified relationship */
117 /* between the input windows, A and B, is satisfied. For example, */
118 /* the expression */
119
120 /* WNRELD ( NEEDED, '<=', AVAIL ) */
121
122 /* is true whenever the window NEEDED is a subset of the window */
123 /* AVAIL. One window is a subset of another window if each of */
124 /* the intervals in the first window is included in one of the */
125 /* intervals in the second window. In addition, the first window */
126 /* is a proper subset of the second if the second window contains */
127 /* at least one point not contained in the first window. (Thus, */
128 /* '<' implies '<=', and '>' implies '>='.) */
129
130 /* The following pairs of expressions are equivalent. */
131
132 /* WNRELD ( A, '>', B ) */
133 /* WNRELD ( B, '<', A ) */
134
135 /* WNRELD ( A, '>=', B ) */
136 /* WNRELD ( B, '<=', A ) */
137
138 /* $ Examples */
139
140 /* Let A contain the intervals */
141
142 /* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */
143
144 /* Let B and C contain the intervals */
145
146 /* [ 1, 2 ] [ 9, 9 ] [ 24, 27 ] */
147
148 /* Let D contain the intervals */
149
150 /* [ 5, 10 ] [ 15, 25 ] */
151
152 /* Finally, let E and F be empty windows (containing no intervals). */
153
154 /* Because B and C contain the same intervals, */
155
156 /* WNRELD ( B, '=', C ) */
157 /* WNRELD ( B, '<=', C ) */
158 /* WNRELD ( B, '>=', C ) */
159
160 /* are all true, while */
161
162 /* WNRELD ( B, '<>', C ) */
163
164 /* is false. Because neither B nor C contains any points not also */
165 /* contained by the other, neither is a proper subset of the other. */
166 /* Thus, */
167
168 /* WNRELD ( B, '<', C ) */
169 /* WNRELD ( B, '>', C ) */
170
171 /* are both false. */
172
173 /* Every point contained in B and C is also contained in A. Thus, */
174
175 /* WNRELD ( B, '<=', A ) */
176 /* WNRELD ( A, '>=', C ) */
177
178 /* are both true. In addition, A contains points not contained in */
179 /* B and C. (That is, the differences A-B and A-C are not empty.) */
180 /* Thus, B and C are peoper subsets of A as well, and */
181
182 /* WNRELD ( B, '<', A ) */
183 /* WNRELD ( A, '>', B ) */
184
185 /* are both true. */
186
187 /* Although A and D have points in common, neither contains the */
188 /* other. Thus */
189
190 /* WNRELD ( A, '=', D ) */
191 /* WNRELD ( A, '<=', D ) */
192 /* WNRELD ( A, '>=', D ) */
193
194 /* are all false. */
195
196 /* In addition, any window is equal to itself, a subset of itself, */
197 /* and a superset of itself. Thus, */
198
199 /* WNRELD ( A, '=', A ) */
200 /* WNRELD ( A, '<=', A ) */
201 /* WNRELD ( A, '>=', A ) */
202
203 /* are always true. However, no window is a proper subset or a */
204 /* proper superset of itself. Thus, */
205
206 /* WNRELD ( A, '<', A ) */
207 /* WNRELD ( A, '>', A ) */
208
209 /* are always false. */
210
211 /* Finally, an empty window is a a proper subset of any window */
212 /* except another empty window. Thus, */
213
214 /* WNRELD ( E, '<', A ) */
215
216 /* is true, but */
217
218 /* WNRELD ( E, '<', F ) */
219
220 /* is false. */
221
222 /* $ Exceptions */
223
224 /* If the relational operator is not recognized, the error */
225 /* SPICE(INVALIDOPERATION) is signalled. */
226
227 /* $ Files */
228
229 /* None. */
230
231 /* $ Restrictions */
232
233 /* None. */
234
235 /* $ Literature_References */
236
237 /* None. */
238
239 /* $ Author_and_Institution */
240
241 /* H.A. Neilan (JPL) */
242 /* W.L. Taber (JPL) */
243 /* I.M. Underwood (JPL) */
244
245 /* $ Version */
246
247 /* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */
248
249 /* Set the default function value to either 0, 0.0D0, .FALSE., */
250 /* or blank depending on the type of the function. */
251
252 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
253
254 /* Comment section for permuted index source lines was added */
255 /* following the header. */
256
257 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
258
259 /* -& */
260 /* $ Index_Entries */
261
262 /* compare two d.p. windows */
263
264 /* -& */
265 /* $ Revisions */
266
267 /* - Beta Version 2.0.0, 2-FEB-1989 (HAN) */
268
269 /* If the relational operator is not recognized, an error is */
270 /* signalled. The previous version returned .FALSE. as the */
271 /* function value, and no error was signalled. */
272
273 /* Also, the Required_Reading section has been changed to */
274 /* include WINDOWS as the required reading for the module. */
275
276 /* -& */
277
278 /* SPICELIB functions */
279
280
281 /* Local variables */
282
283
284 /* Standard SPICE error handling. */
285
286 if (return_()) {
287 ret_val = FALSE_;
288 return ret_val;
289 } else {
290 chkin_("WNRELD", (ftnlen)6);
291 ret_val = FALSE_;
292 }
293
294 /* Find the cardinality of the input windows. */
295
296 acard = cardd_(a);
297 bcard = cardd_(b);
298
299 /* A and B are equal if they contain exactly the same intervals. */
300 /* We need to know this for nearly every relationship, so find out */
301 /* before going any further. */
302
303 if (acard != bcard) {
304 equal = FALSE_;
305 } else {
306 equal = TRUE_;
307 i__1 = acard;
308 for (i__ = 1; i__ <= i__1; ++i__) {
309 equal = equal && a[i__ + 5] == b[i__ + 5];
310 }
311 }
312
313 /* Simple equality and inequality are trivial at this point. */
314
315 if (s_cmp(op, "=", op_len, (ftnlen)1) == 0) {
316 ret_val = equal;
317 } else if (s_cmp(op, "<>", op_len, (ftnlen)2) == 0) {
318 ret_val = ! equal;
319
320 /* Subsets are a little trickier. A is a subset of B if every */
321 /* interval in A is included in B. In addition, A is a proper */
322 /* subset if A and B are not equal. */
323
324 } else if (s_cmp(op, "<=", op_len, (ftnlen)2) == 0 || s_cmp(op, "<",
325 op_len, (ftnlen)1) == 0) {
326 subset = TRUE_;
327 i__1 = acard;
328 for (i__ = 1; i__ <= i__1; i__ += 2) {
329 subset = subset && wnincd_(&a[i__ + 5], &a[i__ + 6], b);
330 }
331 if (s_cmp(op, "<=", op_len, (ftnlen)2) == 0) {
332 ret_val = subset;
333 } else {
334 ret_val = subset && ! equal;
335 }
336
337 /* A and B change places here... */
338
339 } else if (s_cmp(op, ">=", op_len, (ftnlen)2) == 0 || s_cmp(op, ">",
340 op_len, (ftnlen)1) == 0) {
341 subset = TRUE_;
342 i__1 = bcard;
343 for (i__ = 1; i__ <= i__1; i__ += 2) {
344 subset = subset && wnincd_(&b[i__ + 5], &b[i__ + 6], a);
345 }
346 if (s_cmp(op, ">=", op_len, (ftnlen)2) == 0) {
347 ret_val = subset;
348 } else {
349 ret_val = subset && ! equal;
350 }
351
352 /* An unrecognized operator always fails. */
353
354 } else {
355 setmsg_("Relational operator, *, is not recognized.", (ftnlen)42);
356 errch_("*", op, (ftnlen)1, op_len);
357 sigerr_("SPICE(INVALIDOPERATION)", (ftnlen)23);
358 chkout_("WNRELD", (ftnlen)6);
359 return ret_val;
360 }
361 chkout_("WNRELD", (ftnlen)6);
362 return ret_val;
363 } /* wnreld_ */
364
365