1 /* wnsumd.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 WNSUMD ( Summary of a double precision window ) */
wnsumd_(doublereal * window,doublereal * meas,doublereal * avg,doublereal * stddev,integer * short__,integer * long__)9 /* Subroutine */ int wnsumd_(doublereal *window, doublereal *meas, doublereal
10 *avg, doublereal *stddev, integer *short__, integer *long__)
11 {
12 /* System generated locals */
13 integer i__1;
14
15 /* Builtin functions */
16 double sqrt(doublereal);
17
18 /* Local variables */
19 integer card;
20 extern logical even_(integer *);
21 integer i__;
22 extern integer cardd_(doublereal *);
23 doublereal m;
24 extern /* Subroutine */ int chkin_(char *, ftnlen);
25 doublereal mlong;
26 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
27 ftnlen), setmsg_(char *, ftnlen);
28 doublereal mshort;
29 extern logical return_(void);
30 doublereal sumsqr, sum;
31
32 /* $ Abstract */
33
34 /* Summarize the contents of a double precision window. */
35
36 /* $ Disclaimer */
37
38 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
39 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
40 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
41 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
42 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
43 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
44 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
45 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
46 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
47 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
48
49 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
50 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
51 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
52 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
53 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
54 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
55
56 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
57 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
58 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
59 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
60
61 /* $ Required_Reading */
62
63 /* WINDOWS */
64
65 /* $ Keywords */
66
67 /* WINDOWS */
68
69 /* $ Declarations */
70 /* $ Brief_I/O */
71
72 /* VARIABLE I/O DESCRIPTION */
73 /* -------- --- -------------------------------------------------- */
74 /* WINDOW I Window to be summarized. */
75 /* MEAS O Total measure of intervals in WINDOW. */
76 /* AVG O Average measure. */
77 /* STDDEV O Standard deviation. */
78 /* SHORT, */
79 /* LONG O Locations of shortest, longest intervals. */
80
81 /* $ Detailed_Input */
82
83 /* WINDOW is a window containing zero or more intervals. */
84
85 /* $ Detailed_Output */
86
87 /* MEAS is the total measure of the intervals in the input */
88 /* window. This is just the sum of the measures of the */
89 /* individual intervals. */
90
91 /* AVG is the average of the measures of the intervals in */
92 /* the input window. */
93
94 /* STDDEV is the standard deviation of the measures of the */
95 /* intervals in the input window. */
96
97 /* SHORT, */
98 /* LONG are the locations of the shortest and longest */
99 /* intervals in the input window. The shortest interval */
100 /* is */
101
102 /* [ WINDOW(SHORT), WINDOW(SHORT+1) ] */
103
104 /* and the longest is */
105
106 /* [ WINDOW(LONG), WINDOW(LONG+1) ] */
107
108 /* SHORT and LONG are both zero if the input window */
109 /* contains no intervals. */
110
111 /* $ Parameters */
112
113 /* None. */
114
115 /* $ Exceptions */
116
117 /* 1) The error SPICE(INVALIDCARDINALITY) signals if WINDOW has odd */
118 /* cardinality. */
119
120 /* $ Files */
121
122 /* None. */
123
124 /* $ Particulars */
125
126 /* This routine provides a summary of the input window, consisting */
127 /* of the following items: */
128
129 /* - The measure of the window. */
130
131 /* - The average and standard deviation of the measures */
132 /* of the individual intervals in the window. */
133
134 /* - The indices of the left endpoints of the shortest */
135 /* and longest intervals in the window. */
136
137 /* All of these quantities are zero if the window contains no */
138 /* intervals. */
139
140 /* $ Examples */
141
142 /* Let A contain the intervals */
143
144 /* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */
145
146 /* Let B contain the singleton intervals */
147
148 /* [ 2, 2 ] [ 9, 9 ] [ 27, 27 ] */
149
150 /* The measures of A and B are */
151
152 /* (3-1) + (11-7) + (27-23) = 10 */
153
154 /* and */
155
156 /* (2-2) + (9-9) + (27-27) = 0 */
157
158 /* respectively. Each window has three intervals; thus, the average */
159 /* measures of the windows are 10/3 and 0. The standard deviations */
160 /* are */
161
162 /* ---------------------------------------------- */
163 /* | 2 2 2 */
164 /* | (3-1) + (11-7) + (27-23) 2 1/2 */
165 /* | --------------------------- - (10/3) = (8/9) */
166 /* | 3 */
167 /* \ | */
168 /* \| */
169
170 /* and 0. Neither window has one "shortest" interval or "longest" */
171 /* interval; so the first ones found are returned: SHORT and LONG */
172 /* are 1 and 3 for A, 1 and 1 for B. */
173
174 /* $ Restrictions */
175
176 /* None. */
177
178 /* $ Literature_References */
179
180 /* None. */
181
182 /* $ Author_and_Institution */
183
184 /* N.J. Bachman (JPL) */
185 /* H.A. Neilan (JPL) */
186 /* W.L. Taber (JPL) */
187 /* I.M. Underwood (JPL) */
188
189 /* $ Version */
190
191 /* - SPICELIB Version 1.1.0, 25-FEB-2009 (EDW) */
192
193 /* Added error test to confirm input window has even cardinality. */
194 /* Corrected section order to match NAIF standard. */
195
196 /* - SPICELIB Version 1.0.2, 29-JUL-2002 (NJB) */
197
198 /* Corrected error in example section: changed claimed value */
199 /* of longest interval for window A from 2 to 3. */
200
201 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
202
203 /* Comment section for permuted index source lines was added */
204 /* following the header. */
205
206 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
207
208 /* -& */
209 /* $ Index_Entries */
210
211 /* summary of a d.p. window */
212
213 /* -& */
214 /* $ Revisions */
215
216 /* - Beta Version 1.2.0, 24-FEB-1989 (HAN) */
217
218 /* Added calls to CHKIN and CHKOUT. */
219
220 /* -& */
221
222 /* SPICELIB functions */
223
224
225 /* Local variables */
226
227
228 /* Standard SPICE error handling. */
229
230 if (return_()) {
231 return 0;
232 }
233
234 /* Get the cardinality (number of endpoints) of the window. */
235
236 card = cardd_(window);
237
238 /* Confirm evenness of CARD. */
239
240 if (! even_(&card)) {
241 chkin_("WNSUMD", (ftnlen)6);
242 setmsg_("Input window has odd cardinality. A valid SPICE window must"
243 " have even element cardinality.", (ftnlen)90);
244 sigerr_("SPICE(INVALIDCARDINALITY)", (ftnlen)25);
245 chkout_("WNSUMD", (ftnlen)6);
246 return 0;
247 }
248
249 /* Trivial case: no intervals. Return all zeros. */
250
251 if (card == 0) {
252 *meas = 0.;
253 *avg = 0.;
254 *stddev = 0.;
255 *short__ = 0;
256 *long__ = 0;
257
258 /* Collect the sum of the measures and the squares of the measures */
259 /* for each of the intervals in the window. At the same time, keep */
260 /* track of the shortest and longest intervals encountered. */
261
262 } else {
263 sum = 0.;
264 sumsqr = 0.;
265 *short__ = 1;
266 mshort = window[7] - window[6];
267 *long__ = 1;
268 mlong = window[7] - window[6];
269 i__1 = card;
270 for (i__ = 1; i__ <= i__1; i__ += 2) {
271 m = window[i__ + 6] - window[i__ + 5];
272 sum += m;
273 sumsqr += m * m;
274 if (m < mshort) {
275 *short__ = i__;
276 mshort = m;
277 }
278 if (m > mlong) {
279 *long__ = i__;
280 mlong = m;
281 }
282 }
283
284 /* The envelope please? */
285
286 *meas = sum;
287 *avg = *meas * 2. / (doublereal) card;
288 *stddev = sqrt(sumsqr * 2. / (doublereal) card - *avg * *avg);
289 }
290 return 0;
291 } /* wnsumd_ */
292
293