1 /* wnfild.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      WNFILD ( Fill small gaps in a DP window ) */
wnfild_(doublereal * small,doublereal * window)9 /* Subroutine */ int wnfild_(doublereal *small, doublereal *window)
10 {
11     integer card, i__, j;
12     extern integer cardd_(doublereal *);
13     extern /* Subroutine */ int chkin_(char *, ftnlen), scardd_(integer *,
14 	    doublereal *), chkout_(char *, ftnlen);
15     extern logical return_(void);
16 
17 /* $ Abstract */
18 
19 /*     Fill small gaps between adjacent intervals of a double precision */
20 /*     window. */
21 
22 /* $ Disclaimer */
23 
24 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
25 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
26 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
27 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
28 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
29 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
30 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
31 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
32 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
33 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
34 
35 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
36 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
37 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
38 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
39 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
40 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
41 
42 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
43 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
44 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
45 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
46 
47 /* $ Required_Reading */
48 
49 /*     WINDOWS */
50 
51 /* $ Keywords */
52 
53 /*     WINDOWS */
54 
55 /* $ Declarations */
56 /* $ Brief_I/O */
57 
58 /*      VARIABLE  I/O  DESCRIPTION */
59 /*      --------  ---  -------------------------------------------------- */
60 /*      SMALL      I   Limiting measure of small gaps. */
61 /*      WINDOW    I,O  Window to be filled. */
62 
63 /* $ Detailed_Input */
64 
65 /*      SMALL       is the limiting measure of the small gaps to be */
66 /*                  filled. Adjacent intervals separated by gaps of */
67 /*                  measure less than or equal to SMALL are merged. */
68 
69 /*      WINDOW      on input, is a window containing zero or more */
70 /*                  intervals. */
71 
72 /* $ Detailed_Output */
73 
74 /*      WINDOW      on output, is the original window, after adjacent */
75 /*                  intervals separated by small gaps have been merged. */
76 
77 /* $ Parameters */
78 
79 /*     None. */
80 
81 /* $ Exceptions */
82 
83 /*     None. */
84 
85 /* $ Files */
86 
87 /*      None. */
88 
89 /* $ Particulars */
90 
91 /*      This routine removes small gaps between adjacent intervals */
92 /*      by merging intervals separated by gaps of measure less than */
93 /*      or equal to the limiting measure (SMALL). */
94 
95 /* $ Examples */
96 
97 /*      Let WINDOW contain the intervals */
98 
99 /*            [ 1, 3 ]  [ 7, 11 ]  [ 23, 27 ]  [ 29, 29 ] */
100 
101 /*      Then the following series of calls */
102 
103 /*            CALL WNFILD (  1, WINDOW )                       (1) */
104 /*            CALL WNFILD (  2, WINDOW )                       (2) */
105 /*            CALL WNFILD (  3, WINDOW )                       (3) */
106 /*            CALL WNFILD ( 12, WINDOW )                       (4) */
107 
108 /*      produces the following series of windows */
109 
110 /*            [ 1,  3 ]  [ 7, 11 ]  [ 23, 27 ]  [ 29, 29 ]     (1) */
111 /*            [ 1,  3 ]  [ 7, 11 ]  [ 23, 29 ]                 (2) */
112 /*            [ 1,  3 ]  [ 7, 11 ]  [ 23, 29 ]                 (3) */
113 /*            [ 1, 29 ]                                        (4) */
114 
115 /* $ Restrictions */
116 
117 /*      None. */
118 
119 /* $ Literature_References */
120 
121 /*      None. */
122 
123 /* $ Author_and_Institution */
124 
125 /*      N.J. Bachman    (JPL) */
126 /*      H.A. Neilan     (JPL) */
127 /*      W.L. Taber      (JPL) */
128 /*      I.M. Underwood  (JPL) */
129 
130 /* $ Version */
131 
132 /* -     SPICELIB Version 1.0.3, 29-JUL-2007 (NJB) */
133 
134 /*         Corrected typo in the previous Version line date string, */
135 /*         "29-JUL-20022" to "29-JUL-2002." */
136 
137 /* -     SPICELIB Version 1.0.2, 29-JUL-2002 (NJB) */
138 
139 /*         Changed gap size from 10 to 12 to correct erroneous example. */
140 
141 
142 /* -     SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
143 
144 /*         Comment section for permuted index source lines was added */
145 /*         following the header. */
146 
147 /* -     SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
148 
149 /* -& */
150 /* $ Index_Entries */
151 
152 /*     fill small gaps in a d.p. window */
153 
154 /* -& */
155 /* $ Revisions */
156 
157 /* -     Beta Version 1.2.0, 24-FEB-1989  (HAN) */
158 
159 /*         Added calls to CHKIN and CHKOUT. */
160 
161 /* -& */
162 
163 /*     SPICELIB functions */
164 
165 
166 /*     Local variables */
167 
168 
169 /*     Standard SPICE error handling. */
170 
171     if (return_()) {
172 	return 0;
173     } else {
174 	chkin_("WNFILD", (ftnlen)6);
175     }
176 
177 /*     Get the cardinality of the window. (The size is not important; */
178 /*     this routine can't create any new intervals.) */
179 
180     card = cardd_(window);
181 
182 /*     Step through the window, looking for the next right endpoint */
183 /*     more than SMALL away from the following left endpoint. This marks */
184 /*     the end of the new first interval, and the beginning of the new */
185 /*     second interval. Keep this up until the last right endpoint has */
186 /*     been reached. This remains the last right endpoint. */
187 
188     if (card > 0) {
189 	i__ = 2;
190 	j = 2;
191 	while(j < card) {
192 	    if (window[j + 5] + *small < window[j + 6]) {
193 		window[i__ + 5] = window[j + 5];
194 		window[i__ + 6] = window[j + 6];
195 		i__ += 2;
196 	    }
197 	    j += 2;
198 	}
199 	window[i__ + 5] = window[j + 5];
200 	scardd_(&i__, window);
201     }
202     chkout_("WNFILD", (ftnlen)6);
203     return 0;
204 } /* wnfild_ */
205 
206