1 /* zzekordi.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 ZZEKORDI ( Order of an integer EK column ) */
zzekordi_(integer * ivals,logical * nullok,logical * nlflgs,integer * nvals,integer * iorder)9 /* Subroutine */ int zzekordi_(integer *ivals, logical *nullok, logical *
10 nlflgs, integer *nvals, integer *iorder)
11 {
12 /* System generated locals */
13 integer i__1;
14
15 /* Local variables */
16 integer i__, j;
17 extern /* Subroutine */ int swapi_(integer *, integer *);
18 integer jg, gap;
19
20 /* $ Abstract */
21
22 /* Determine the order of elements in an integer EK column, using */
23 /* dictionary ordering on integer data values and array indices. */
24
25 /* $ Disclaimer */
26
27 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
28 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
29 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
30 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
31 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
32 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
33 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
34 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
35 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
36 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
37
38 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
39 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
40 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
41 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
42 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
43 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
44
45 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
46 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
47 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
48 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
49
50 /* $ Required_Reading */
51
52 /* EK */
53
54 /* $ Keywords */
55
56 /* EK */
57 /* SORT */
58
59 /* $ Declarations */
60 /* $ Brief_I/O */
61
62 /* VARIABLE I/O DESCRIPTION */
63 /* -------- --- -------------------------------------------------- */
64 /* IVALS I Array of integer column values. */
65 /* NULLOK I Logical flag indicating whether nulls are allowed. */
66 /* NLFLGS I Flags indicating whether column entries are null. */
67 /* NVALS I Dimension of IVALS. */
68 /* IORDER O Order vector for IVALS. */
69
70 /* $ Detailed_Input */
71
72 /* IVALS is an array of integer EK column values, */
73 /* some of which may be null, if null values are */
74 /* permitted. See the description of the input */
75 /* arguments NULLOK and NLFLGS below. */
76
77 /* NULLOK is a logical flag indicating whether column */
78 /* elements may be null. If NULLOK is TRUE, then */
79 /* NLFLGS must be set to indicate the status of each */
80 /* element of IVALS. */
81
82 /* NLFLGS is an array of logical flags that indicate whether */
83 /* the corresponding elements of IVALS are null. */
84 /* NLFLGS is meaningful only when NULLOK is .TRUE. */
85 /* When NULLOK is .TRUE., the Ith element of IVALS is */
86 /* null if and only if the Ith element of NLFLGS */
87 /* is .TRUE. */
88
89 /* When NULLOK is .FALSE., all elements of IVALS are */
90 /* considered to be non-null. */
91
92 /* NVALS is the number of elements in the input array. */
93
94 /* $ Detailed_Output */
95
96 /* IORDER is the order vector for the input array. */
97 /* IORDER(1) is the index of the smallest element */
98 /* of IVALS; IORDER(2) is the index of the next */
99 /* smallest; and so on. Null values, if allowed, are */
100 /* considered to be less than all non-null values. The */
101 /* order relation between equal values is determined */
102 /* by the indices of the values in the input array; */
103 /* values with lower indices are considered to be */
104 /* smaller. */
105
106 /* $ Parameters */
107
108 /* None. */
109
110 /* $ Particulars */
111
112 /* ZZEKORDI creates an order vector for an array of integer */
113 /* column values. Null values are allowed. The order */
114 /* relation used is dictionary ordering on ordered pairs consisting */
115 /* of data values and array indices: if two input data values */
116 /* are equal, the associated array indices determine the order */
117 /* relation of the values, where the smaller index is considered */
118 /* to precede the greater. */
119
120 /* $ Examples */
121
122 /* 1) Sort the following list of values, some of which are */
123 /* null: */
124
125 /* Value Null? */
126 /* -------------- --------------------- */
127 /* IVALS(1) = 3 NLFLGS(1) = .FALSE. */
128 /* IVALS(2) = 1 NLFLGS(2) = .FALSE. */
129 /* IVALS(3) = 4 NLFLGS(3) = .TRUE. */
130 /* IVALS(4) = 5 NLFLGS(4) = .FALSE. */
131 /* IVALS(5) = 2 NLFLGS(5) = .TRUE. */
132
133
134 /* The subroutine call */
135
136 /* CALL ZZEKORDI ( IVALS, .TRUE., NLFLGS, 5, IORDER ) */
137
138 /* generates the output */
139
140 /* IORDER(1) = 3 */
141 /* IORDER(2) = 5 */
142 /* IORDER(3) = 2 */
143 /* IORDER(4) = 1 */
144 /* IORDER(5) = 4 */
145
146 /* Note that the order of the null values is determined by */
147 /* their indices in the input array. */
148
149
150 /* 2) Given the same inputs values of IVALS and NLFLGS, the */
151 /* subroutine call */
152
153 /* CALL ZZEKORDI ( IVALS, .FALSE., NLFLGS, 5, IORDER ) */
154
155 /* generates the output */
156
157 /* IORDER(1) = 2 */
158 /* IORDER(2) = 5 */
159 /* IORDER(3) = 1 */
160 /* IORDER(4) = 3 */
161 /* IORDER(5) = 4 */
162
163 /* $ Restrictions */
164
165 /* None. */
166
167 /* $ Exceptions */
168
169 /* Error free. */
170
171 /* $ Files */
172
173 /* None. */
174
175 /* $ Author_and_Institution */
176
177 /* N.J. Bachman (JPL) */
178 /* I.M. Underwood (JPL) */
179
180 /* $ Literature_References */
181
182 /* None. */
183
184 /* $ Version */
185
186 /* - Beta Version 3.0.0, 26-MAY-1995 (NJB) */
187
188 /* Re-written to use dictionary ordering on values and input */
189 /* array indices. */
190
191 /* - Beta Version 2.0.0, 13-FEB-1995 (NJB) */
192
193 /* Renamed as a private routine. */
194
195 /* - Beta Version 1.0.0, 13-APR-1994 (NJB) (IMU) */
196
197 /* -& */
198
199 /* Local variables */
200
201
202 /* Statement functions */
203
204
205 /* Begin with the initial ordering. */
206
207 i__1 = *nvals;
208 for (i__ = 1; i__ <= i__1; ++i__) {
209 iorder[i__ - 1] = i__;
210 }
211
212 /* Find the smallest element, then the next smallest, and so on. */
213 /* This uses the Shell Sort algorithm, but swaps the elements of */
214 /* the order vector instead of the array itself. */
215
216 gap = *nvals / 2;
217 while(gap > 0) {
218 i__1 = *nvals;
219 for (i__ = gap + 1; i__ <= i__1; ++i__) {
220 j = i__ - gap;
221 while(j > 0) {
222 jg = j + gap;
223 if (! (*nullok) && (ivals[iorder[j - 1] - 1] < ivals[iorder[
224 jg - 1] - 1] || ivals[iorder[j - 1] - 1] == ivals[
225 iorder[jg - 1] - 1] && iorder[j - 1] < iorder[jg - 1])
226 || *nullok && (nlflgs[iorder[j - 1] - 1] && ! nlflgs[
227 iorder[jg - 1] - 1] || nlflgs[iorder[j - 1] - 1] &&
228 nlflgs[iorder[jg - 1] - 1] && iorder[j - 1] < iorder[
229 jg - 1] || ! (nlflgs[iorder[j - 1] - 1] || nlflgs[
230 iorder[jg - 1] - 1]) && (ivals[iorder[j - 1] - 1] <
231 ivals[iorder[jg - 1] - 1] || ivals[iorder[j - 1] - 1]
232 == ivals[iorder[jg - 1] - 1] && iorder[j - 1] <
233 iorder[jg - 1]))) {
234
235 /* Getting here means that */
236
237 /* IVALS(IORDER(J)) .LE. IVALS(IORDER(JG)) */
238
239 /* according to our order relation. */
240
241 j = 0;
242 } else {
243 swapi_(&iorder[j - 1], &iorder[jg - 1]);
244 }
245 j -= gap;
246 }
247 }
248 gap /= 2;
249 }
250 return 0;
251 } /* zzekordi_ */
252
253