1 /* zzwninsd.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__3 = 3;
11
12 /* $Procedure ZZWNINSD ( Insert an interval into a DP window ) */
zzwninsd_(doublereal * left,doublereal * right,char * context,doublereal * window,ftnlen context_len)13 /* Subroutine */ int zzwninsd_(doublereal *left, doublereal *right, char *
14 context, doublereal *window, ftnlen context_len)
15 {
16 /* System generated locals */
17 address a__1[3];
18 integer i__1[3], i__2;
19 doublereal d__1, d__2;
20
21 /* Builtin functions */
22 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
23 char **, integer *, integer *, ftnlen);
24
25 /* Local variables */
26 integer card, size, i__, j;
27 extern integer cardd_(doublereal *);
28 extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
29 doublereal *, ftnlen);
30 extern integer sized_(doublereal *);
31 extern /* Subroutine */ int scardd_(integer *, doublereal *);
32 extern integer lastnb_(char *, ftnlen);
33 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
34 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
35 ftnlen);
36 extern logical return_(void);
37 char msg[1840];
38
39 /* $ Abstract */
40
41 /* Insert an interval into a double precision window. */
42
43 /* $ Disclaimer */
44
45 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
46 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
47 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
48 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
49 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
50 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
51 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
52 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
53 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
54 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
55
56 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
57 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
58 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
59 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
60 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
61 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
62
63 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
64 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
65 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
66 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
67
68 /* $ Required_Reading */
69
70 /* WINDOWS */
71
72 /* $ Keywords */
73
74 /* WINDOWS */
75
76 /* $ Declarations */
77 /* $ Disclaimer */
78
79 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
80 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
81 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
82 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
83 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
84 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
85 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
86 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
87 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
88 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
89
90 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
91 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
92 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
93 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
94 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
95 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
96
97 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
98 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
99 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
100 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
101
102
103 /* Include File: SPICELIB Error Handling Parameters */
104
105 /* errhnd.inc Version 2 18-JUN-1997 (WLT) */
106
107 /* The size of the long error message was */
108 /* reduced from 25*80 to 23*80 so that it */
109 /* will be accepted by the Microsoft Power Station */
110 /* FORTRAN compiler which has an upper bound */
111 /* of 1900 for the length of a character string. */
112
113 /* errhnd.inc Version 1 29-JUL-1997 (NJB) */
114
115
116
117 /* Maximum length of the long error message: */
118
119
120 /* Maximum length of the short error message: */
121
122
123 /* End Include File: SPICELIB Error Handling Parameters */
124
125 /* $ Brief_I/O */
126
127 /* VARIABLE I/O DESCRIPTION */
128 /* -------- --- -------------------------------------------------- */
129 /* LEFT, */
130 /* RIGHT I Left, right endpoints of new interval. */
131 /* CONTEXT I A call explanation string. */
132 /* WINDOW I,O Input, output window. */
133
134 /* $ Detailed_Input */
135
136 /* LEFT, */
137 /* RIGHT are the left and right endpoints of the interval */
138 /* to be inserted. */
139
140 /* CONTEXT a context/explaination string to append to the */
141 /* long error message if an error signals. The caller */
142 /* need not include a message. A single blank, ' ', */
143 /* represents no message. */
144
145 /* WINDOW on input, is a window containing zero or more */
146 /* intervals. */
147
148 /* $ Detailed_Output */
149
150 /* WINDOW on output, is the original window following the */
151 /* insertion of the interval from LEFT to RIGHT. */
152
153 /* $ Parameters */
154
155 /* None. */
156
157 /* $ Exceptions */
158
159 /* 1) If LEFT is greater than RIGHT, the error SPICE(BADENDPOINTS) is */
160 /* signalled. */
161
162 /* 2) If the insertion of the interval causes an excess of elements, */
163 /* the error SPICE(WINDOWEXCESS) is signalled. */
164
165 /* $ Files */
166
167 /* None. */
168
169 /* $ Particulars */
170
171 /* This routine inserts the interval from LEFT to RIGHT into the */
172 /* input window. If the new interval overlaps any of the intervals */
173 /* in the window, the intervals are merged. Thus, the cardinality */
174 /* of the input window can actually decrease as the result of an */
175 /* insertion. However, because inserting an interval that is */
176 /* disjoint from the other intervals in the window can increase the */
177 /* cardinality of the window, the routine signals an error. */
178
179 /* This is the only unary routine to signal an error. No */
180 /* other unary routine can increase the number of intervals in */
181 /* the input window. */
182
183 /* If a non-blank CONTEXT string passes from the caller, any error */
184 /* signal will return the long error message with the CONTEXT */
185 /* string appended to that message. */
186
187 /* $ Examples */
188
189 /* Let WINDOW contain the intervals */
190
191 /* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */
192
193 /* Then the following series of calls */
194
195 /* CALL ZZWNINSD ( 5, 5, CONTEXT, WINDOW) (1) */
196 /* CALL ZZWNINSD ( 4, 8, CONTEXT, WINDOW) (2) */
197 /* CALL ZZWNINSD ( 0, 30, CONTEXT, WINDOW) (3) */
198
199 /* produces the following series of windows */
200
201 /* [ 1, 3 ] [ 5, 5 ] [ 7, 11 ] [ 23, 27 ] (1) */
202 /* [ 1, 3 ] [ 4, 11 ] [ 23, 27 ] (2) */
203 /* [ 0, 30 ] (3) */
204
205 /* $ Restrictions */
206
207 /* None. */
208
209 /* $ Literature_References */
210
211 /* None. */
212
213 /* $ Author_and_Institution */
214
215 /* K.R. Gehringer (JPL) */
216 /* N.J. Bachman (JPL) */
217 /* H.A. Neilan (JPL) */
218 /* W.L. Taber (JPL) */
219 /* I.M. Underwood (JPL) */
220
221 /* $ Version */
222
223 /* - SPICELIB Version 1.0.0, 03-MAR-2009 (EDW) */
224
225 /* This routine is a copy of the SPICELIB WNINSD routine */
226 /* changed only by the addition of the CONTEXT string. */
227
228 /* -& */
229 /* $ Index_Entries */
230
231 /* insert an interval into a d.p. window, optional context string */
232
233 /* -& */
234
235 /* SPICELIB functions */
236
237
238 /* Local Variables */
239
240
241 /* Local paramters */
242
243
244 /* Standard SPICE error handling. */
245
246 if (return_()) {
247 return 0;
248 } else {
249 chkin_("ZZWNINSD", (ftnlen)8);
250 }
251
252 /* Get the size and cardinality of the window. */
253
254 size = sized_(window);
255 card = cardd_(window);
256
257 /* Let's try the easy cases first. No input interval? No change. */
258 /* Signal that an error has occurred and set the error message. */
259
260 if (*left > *right) {
261 s_copy(msg, "Left endpoint greather-than right. Left endpoint was #1"
262 ". Right endpoint was #2.", (ftnlen)1840, (ftnlen)79);
263 /* Writing concatenation */
264 i__1[0] = lastnb_(msg, (ftnlen)1840), a__1[0] = msg;
265 i__1[1] = 1, a__1[1] = " ";
266 i__1[2] = lastnb_(context, context_len), a__1[2] = context;
267 s_cat(msg, a__1, i__1, &c__3, (ftnlen)1840);
268 setmsg_(msg, (ftnlen)1840);
269 errdp_("#1", left, (ftnlen)2);
270 errdp_("#2", right, (ftnlen)2);
271 sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19);
272 chkout_("ZZWNINSD", (ftnlen)8);
273 return 0;
274 } else if (card == 0 || *left > window[card + 5]) {
275
276 /* Empty window? Input interval later than the end of the window? */
277 /* Just insert the interval, if there's room. */
278
279 if (size >= card + 2) {
280 i__2 = card + 2;
281 scardd_(&i__2, window);
282 window[card + 6] = *left;
283 window[card + 7] = *right;
284 } else {
285 s_copy(msg, "Window has size, #1, cardinality #2. Cannot insert "
286 "an additional interval into the window.", (ftnlen)1840, (
287 ftnlen)90);
288 /* Writing concatenation */
289 i__1[0] = lastnb_(msg, (ftnlen)1840), a__1[0] = msg;
290 i__1[1] = 1, a__1[1] = " ";
291 i__1[2] = lastnb_(context, context_len), a__1[2] = context;
292 s_cat(msg, a__1, i__1, &c__3, (ftnlen)1840);
293 setmsg_(msg, (ftnlen)1840);
294 errint_("#1", &size, (ftnlen)2);
295 errint_("#2", &card, (ftnlen)2);
296 sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19);
297 }
298 chkout_("ZZWNINSD", (ftnlen)8);
299 return 0;
300 }
301
302 /* Now on to the tougher cases. */
303
304 /* Skip intervals which lie completely to the left of the input */
305 /* interval. (The index I will always point to the right endpoint */
306 /* of an interval). */
307
308 i__ = 2;
309 while(i__ <= card && window[i__ + 5] < *left) {
310 i__ += 2;
311 }
312
313 /* There are three ways this can go. The new interval can: */
314
315 /* 1) lie entirely between the previous interval and the next. */
316
317 /* 2) overlap the next interval, but no others. */
318
319 /* 3) overlap more than one interval. */
320
321 /* Only the first case can possibly cause an overflow, since the */
322 /* other two cases require existing intervals to be merged. */
323
324
325 /* Case (1). If there's room, move succeeding intervals back and */
326 /* insert the new one. If there isn't room, signal an error. */
327
328 if (*right < window[i__ + 4]) {
329 if (size >= card + 2) {
330 i__2 = i__ - 1;
331 for (j = card; j >= i__2; --j) {
332 window[j + 7] = window[j + 5];
333 }
334 i__2 = card + 2;
335 scardd_(&i__2, window);
336 window[i__ + 4] = *left;
337 window[i__ + 5] = *right;
338 } else {
339 s_copy(msg, "Window has size, #1, cardinality #2. Cannot insert "
340 "an additional interval into the window. The new interval"
341 " lies entirely between the previous interval and thenext."
342 , (ftnlen)1840, (ftnlen)164);
343 /* Writing concatenation */
344 i__1[0] = lastnb_(msg, (ftnlen)1840), a__1[0] = msg;
345 i__1[1] = 1, a__1[1] = " ";
346 i__1[2] = lastnb_(context, context_len), a__1[2] = context;
347 s_cat(msg, a__1, i__1, &c__3, (ftnlen)1840);
348 setmsg_(msg, (ftnlen)1840);
349 errint_("#1", &size, (ftnlen)2);
350 errint_("#2", &card, (ftnlen)2);
351 sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19);
352 chkout_("ZZWNINSD", (ftnlen)8);
353 return 0;
354 }
355
356 /* Cases (2) and (3). */
357
358 } else {
359
360 /* The left and right endpoints of the new interval may or */
361 /* may not replace the left and right endpoints of the existing */
362 /* interval. */
363
364 /* Computing MIN */
365 d__1 = *left, d__2 = window[i__ + 4];
366 window[i__ + 4] = min(d__1,d__2);
367 /* Computing MAX */
368 d__1 = *right, d__2 = window[i__ + 5];
369 window[i__ + 5] = max(d__1,d__2);
370
371 /* Skip any intervals contained in the one we modified. */
372 /* (Like I, J always points to the right endpoint of an */
373 /* interval.) */
374
375 j = i__ + 2;
376 while(j <= card && window[j + 5] <= window[i__ + 5]) {
377 j += 2;
378 }
379
380 /* If the modified interval extends into the next interval, */
381 /* merge the two. (The modified interval grows to the right.) */
382
383 if (j <= card && window[i__ + 5] >= window[j + 4]) {
384 window[i__ + 5] = window[j + 5];
385 j += 2;
386 }
387
388 /* Move the rest of the intervals forward to take up the */
389 /* spaces left by the absorbed intervals. */
390
391 while(j <= card) {
392 i__ += 2;
393 window[i__ + 4] = window[j + 4];
394 window[i__ + 5] = window[j + 5];
395 j += 2;
396 }
397 scardd_(&i__, window);
398 }
399 chkout_("ZZWNINSD", (ftnlen)8);
400 return 0;
401 } /* zzwninsd_ */
402
403