1 /* isordv.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 ISORDV ( Is it an order vector ) */
isordv_(integer * array,integer * n)9 logical isordv_(integer *array, integer *n)
10 {
11 /* System generated locals */
12 integer i__1, i__2;
13 logical ret_val;
14
15 /* Local variables */
16 integer i__, j;
17
18 /* $ Abstract */
19
20 /* Determine whether an array of N items contains the integers */
21 /* 1 through N. */
22
23 /* $ Disclaimer */
24
25 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
26 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
27 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
28 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
29 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
30 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
31 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
32 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
33 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
34 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
35
36 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
37 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
38 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
39 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
40 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
41 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
42
43 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
44 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
45 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
46 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
47
48 /* $ Required_Reading */
49
50 /* None. */
51
52 /* $ Keywords */
53
54 /* SEARCH */
55 /* SORT */
56 /* UTILITY */
57
58 /* $ Declarations */
59 /* $ Brief_I/O */
60
61 /* Variable I/O Description */
62 /* -------- --- -------------------------------------------------- */
63 /* ARRAY I Array of integers. */
64 /* N I Number of integers in ARRAY. */
65
66 /* The function returns TRUE if the array contains the integers */
67 /* 1 through N, otherwise it returns FALSE. */
68
69 /* $ Detailed_Input */
70
71 /* ARRAY is an array of integers. Often this will be an array */
72 /* that is a candidate order vector to be passed to */
73 /* a routine for re-ordering some parallel array. */
74
75 /* N is the number of elements in ARRAY. */
76
77 /* $ Detailed_Output */
78
79 /* The function returns TRUE if the array contains the integers */
80 /* 1 through N. Otherwise it returns FALSE. */
81
82 /* $ Parameters */
83
84 /* None. */
85
86 /* $ Exceptions */
87
88 /* Error free. */
89
90 /* 1) If N < 1, the function returns .FALSE. */
91
92 /* $ Files */
93
94 /* None. */
95
96 /* $ Particulars */
97
98 /* This function provides a simple means of determining whether */
99 /* or not an array of N integers contains exactly the integers */
100 /* 1 through N. */
101
102 /* $ Examples */
103
104 /* 1) Suppose you wished to reorder an array of strings based upon */
105 /* a ranking array supplied by a user. If the ranking array */
106 /* contains any duplicates or refers to indices that are out */
107 /* of the range of valid indices for the array of strings, */
108 /* the attempt to reorder the array of strings cannot succeed. */
109 /* Its usually better to detect such a possibility before */
110 /* you begin trying to reorder the array of strings. This routine */
111 /* will detect the error. */
112
113 /* The block of code below illustrates this idea. */
114
115
116 /* IF ( ISORDV ( ORDVEC, N ) ) THEN */
117
118 /* ...reorder the input array of strings */
119
120 /* CALL REORDC ( ORDVEC, N, STRNGS ) */
121
122 /* ELSE */
123
124 /* ...state the problem and let the user decide what */
125 /* to do about it. */
126 /* . */
127 /* . */
128 /* . */
129
130 /* END IF */
131
132
133 /* 2) This routine can also be used to determine whether or not an */
134 /* array contains every integer between K and N (where K < N ). */
135
136
137 /* First subtract K-1 from each integer */
138
139 /* DO I = 1, N-K+1 */
140 /* ARRAY(I) = ARRAY(I) - K + 1 */
141 /* END DO */
142
143 /* See if the modified array is an order vector */
144
145 /* OK = ISORDV ( ARRAY, N-K ) */
146
147 /* Return the array to its original state. */
148
149 /* DO I = 1, N-K+1 */
150 /* ARRAY(I) = ARRAY(I) + K - 1 */
151 /* END DO */
152
153
154 /* $ Restrictions */
155
156 /* None. */
157
158 /* $ Literature_References */
159
160 /* None. */
161
162 /* $ Author_and_Institution */
163
164 /* N.J. Bachman (JPL) */
165 /* W.L. Taber (JPL) */
166 /* I.M. Underwood (JPL) */
167
168 /* $ Version */
169
170 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
171
172 /* Comment section for permuted index source lines was added */
173 /* following the header. */
174
175 /* - SPICELIB Version 1.0.0, 6-MAR-1991 (NJB) (WLT) (IMU) */
176
177 /* -& */
178 /* $ Index_Entries */
179
180 /* test whether an integer array is an order vector */
181
182 /* -& */
183
184 /* Local variables */
185
186
187 /* Let's take care of the goofy case first. */
188
189 if (*n < 1) {
190 ret_val = FALSE_;
191 return ret_val;
192 } else if (*n == 1) {
193 ret_val = array[0] == 1;
194 return ret_val;
195 }
196
197 /* Make an initial pass through the array to be sure we */
198 /* have legitimate values. */
199
200 i__1 = *n;
201 for (i__ = 1; i__ <= i__1; ++i__) {
202 if (array[i__ - 1] < 1 || array[i__ - 1] > *n) {
203 ret_val = FALSE_;
204 return ret_val;
205 }
206 }
207
208 /* Ok. All of the values are in range. We just need to check */
209 /* that this array could actually be used as an order vector. */
210
211 /* For each I between 1 and N, ARRAY(I) is some integer between 1 */
212 /* and N. The only question remaining is whether the set */
213 /* { ARRAY(I), I=1,N } contains every integer between 1 and N. */
214
215 /* Suppose for a moment we could allocate a logical array called HITS */
216
217 /* LOGICAL HITS(N) */
218
219 /* Then the following scheme could be used to determine whether or */
220 /* not { ARRAY(I), I=1,N } contains every integer between 1 and N. */
221
222 /* Initialize every entry of HITS to .FALSE. */
223
224 /* DO I = 1, N */
225 /* HITS(I) = .FALSE. */
226 /* END DO */
227
228 /* Then for each I set HITS(ARRAY(I)) to .TRUE. */
229
230 /* DO I = 1, N */
231 /* HITS(ARRAY(I)) = .TRUE. */
232 /* END DO */
233
234 /* What can be said about HITS at this point? If for any entry J, */
235 /* HITS(J) is true then some ARRAY(I) is equal to J. */
236
237 /* If all HITS are .TRUE. then {ARRAY(I), I=1,N} is in fact the */
238 /* set of integers 1 to N. Otherwise those J such that */
239 /* HITS(J) = .FALSE. are the integers between 1 and N that are */
240 /* missed by ARRAY. */
241
242 /* It turns out we don't need to allocate an array of logicals; */
243 /* we can use just use part of the input array, ARRAY. */
244
245 /* The storage locations ARRAY(1) through ARRAY(N) can be viewed */
246 /* as two parallel arrays: SIGN_BIT and UNSIGNED */
247
248 /* SIGN */
249 /* BIT UNSIGNED PORTION */
250 /* +----+-----------------+ */
251 /* 1 | | | */
252 /* +----+-----------------+ */
253 /* 2 | | | */
254 /* +----+-----------------+ */
255 /* 3 | | | */
256 /* +----+-----------------+ */
257
258 /* . */
259 /* . */
260 /* . */
261
262 /* +----+-----------------+ */
263 /* N-1 | | | */
264 /* +----+-----------------+ */
265 /* N | | | */
266 /* +----+-----------------+ */
267
268
269 /* Since we know the value of all of the sign bits (it's '+') we can */
270 /* alter them and then reset them once we are done. */
271
272 /* We will choose for our array of HITS the SIGN_BITS of ARRAY. */
273 /* We regard '+' as FALSE and '-' as TRUE. */
274
275 /* DO I = 1, N */
276 /* SIGN_BIT ( UNSIGNED(I) ) = '-' */
277 /* END DO */
278
279 /* Then check to make sure that all of the sign bits are '-'. */
280
281 i__1 = *n;
282 for (i__ = 1; i__ <= i__1; ++i__) {
283 j = (i__2 = array[i__ - 1], abs(i__2));
284 array[j - 1] = -array[j - 1];
285 }
286
287 /* Check each item to see if it's been hit. */
288
289 ret_val = TRUE_;
290 i__1 = *n;
291 for (i__ = 1; i__ <= i__1; ++i__) {
292 ret_val = ret_val && array[i__ - 1] < 0;
293 array[i__ - 1] = (i__2 = array[i__ - 1], abs(i__2));
294 }
295 return ret_val;
296 } /* isordv_ */
297
298